paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 07:29:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

started TDBImage

Browse Source 
git-svn-id: trunk@4647 -
This commit is contained in:
mattias 2003-09-18 21:01:18 +00:00
parent 49cc280de5
commit 62eb6ced1e
5 changed files with 209 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -796,6 +796,7 @@ lcl/include/customedit.inc svneol=native#text/pascal
lcl/include/customform.inc svneol=native#text/pascal
lcl/include/customframe.inc svneol=native#text/pascal
lcl/include/customgroupbox.inc svneol=native#text/pascal
lcl/include/customimage.inc svneol=native#text/pascal
lcl/include/customlabel.inc svneol=native#text/pascal
lcl/include/customlabelededit.inc svneol=native#text/pascal
lcl/include/customlistbox.inc svneol=native#text/pascal
@ -811,6 +812,7 @@ lcl/include/dbcheckbox.inc svneol=native#text/pascal
lcl/include/dbcombobox.inc svneol=native#text/pascal
lcl/include/dbedit.inc svneol=native#text/pascal
lcl/include/dbgroupbox.inc svneol=native#text/pascal
lcl/include/dbimage.inc svneol=native#text/pascal
lcl/include/dblistbox.inc svneol=native#text/pascal
lcl/include/dbmemo.inc svneol=native#text/pascal
lcl/include/dbradiogroup.inc svneol=native#text/pascal
@ -830,7 +832,6 @@ lcl/include/graphicsobject.inc svneol=native#text/pascal
lcl/include/hintwindow.inc svneol=native#text/pascal
lcl/include/hkeys.inc svneol=native#text/pascal
lcl/include/idletimer.inc svneol=native#text/pascal
lcl/include/image.inc svneol=native#text/pascal
lcl/include/imglist.inc svneol=native#text/pascal
lcl/include/inputdialog.inc svneol=native#text/pascal
lcl/include/interfacebase.inc svneol=native#text/pascal

52
lcl/dbctrls.pp
View File

@ -607,6 +607,54 @@ Type
end;
{ TDBImage }
TDBImage = class(TCustomImage)
private
FAutoDisplay: Boolean;
FDataLink: TFieldDataLink;
FQuickDraw: Boolean;
FPictureLoaded: boolean;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetAutoDisplay(const AValue: Boolean);
procedure SetDataField(const AValue: string);
procedure SetDataSource(const AValue: TDataSource);
procedure SetReadOnly(const AValue: Boolean);
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure DataChange(Sender: TObject); virtual;
procedure UpdateData(Sender: TObject); virtual;
procedure LoadPicture; virtual;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
published
property Align;
property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
property AutoSize;
property Center;
property Constraints;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Picture;
property Proportional;
property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property Stretch;
property Transparent;
property Visible;
end;
{ TDBCalender }
TDBCalendar = class(TCalendar)
@ -1010,6 +1058,7 @@ end;
{$Include dbcombobox.inc}
{$Include dbmemo.inc}
{$Include dbgroupbox.inc}
{$Include dbimage.inc}
{$Include dbcalendar.inc}
end.
@ -1017,6 +1066,9 @@ end.
{ =============================================================================
$Log$
Revision 1.11 2003/09/18 21:01:18 mattias
started TDBImage
Revision 1.10 2003/09/18 15:27:07 ajgenius
added initial TDBCalendar

33
lcl/extctrls.pp
View File

@ -343,9 +343,9 @@ type
end;
{ TImage }
TImage = class(TGraphicControl)
{ TCustomImage }
TCustomImage = class(TGraphicControl)
private
FPicture: TPicture;
FCenter: Boolean;
@ -365,7 +365,7 @@ type
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
published
public
Property Align;
property AutoSize;
property Center : Boolean read FCenter write SetCenter;
@ -382,6 +382,26 @@ type
end;
{ TImage }
TImage = class(TCustomImage)
published
property Align;
property AutoSize;
property Center;
property Constraints;
property Picture;
property Visible;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Stretch;
property Transparent;
property Proportional;
end;
{ TBevel }
TBevelStyle = (bsLowered, bsRaised);
@ -749,12 +769,15 @@ end;
{$I custompanel.inc}
{$I radiogroup.inc}
{$I bevel.inc}
{$I image.inc}
{$I customimage.inc}
end.
{
$Log$
Revision 1.76 2003/09/18 21:01:18 mattias
started TDBImage
Revision 1.75 2003/09/18 09:21:03 mattias
renamed LCLLinux to LCLIntf

24
lcl/include/image.inc → lcl/include/customimage.inc
View File

@ -1,6 +1,6 @@
// included by extctrls.pp
{ TImage
{ TCustomImage
*****************************************************************************
* *
@ -16,7 +16,7 @@
*****************************************************************************
}
constructor TImage.Create(TheOwner: TComponent);
constructor TCustomImage.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FCompStyle := csImage;
@ -30,7 +30,7 @@ begin
SetInitialBounds(0,0,100,100);
end;
destructor TImage.Destroy;
destructor TCustomImage.Destroy;
begin
FPicture.OnChange := nil;
FPicture.Graphic := nil;
@ -38,13 +38,13 @@ begin
inherited;
end;
procedure TImage.SetPicture(const AValue: TPicture);
procedure TCustomImage.SetPicture(const AValue: TPicture);
begin
if FPicture=AValue then exit;
FPicture.Assign(AValue); //the onchange of the picture gets called and notifies that something changed.
end;
procedure TImage.DoAutoSize;
procedure TCustomImage.DoAutoSize;
var
ModifyWidth,
ModifyHeight : Boolean;
@ -62,35 +62,35 @@ begin
end;
end;
procedure TImage.SetStretch(Value : Boolean);
procedure TCustomImage.SetStretch(Value : Boolean);
begin
if FStretch=Value then exit;
FStretch := Value;
PictureChanged(Self);
end;
procedure TImage.SetTransparent(Value : Boolean);
procedure TCustomImage.SetTransparent(Value : Boolean);
begin
if FTransparent=Value then exit;
FTransparent := Value;
PictureChanged(Self);
end;
procedure TImage.SetCenter(Value : Boolean);
procedure TCustomImage.SetCenter(Value : Boolean);
begin
if FCenter=Value then exit;
FCenter := Value;
PictureChanged(Self);
end;
procedure TImage.SetProportional(const AValue: Boolean);
procedure TCustomImage.SetProportional(const AValue: Boolean);
begin
if FProportional=AValue then exit;
FProportional:=AValue;
PictureChanged(Self);
end;
Procedure TImage.PictureChanged(Sender : TObject);
Procedure TCustomImage.PictureChanged(Sender : TObject);
begin
If AutoSize then begin
SetAutoSize(False);
@ -99,7 +99,7 @@ begin
Invalidate;
end;
function TImage.DestRect: TRect;
function TCustomImage.DestRect: TRect;
var
PicWidth: Integer;
PicHeight: Integer;
@ -136,7 +136,7 @@ begin
OffsetRect(Result,(ImgWidth-PicWidth) div 2,(ImgHeight-PicHeight) div 2);
end;
Procedure TImage.Paint;
Procedure TCustomImage.Paint;
Procedure DrawFrame;
begin

115
lcl/include/dbimage.inc Normal file
View File

@ -0,0 +1,115 @@
// included by dbctrls.pas
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{ TDBImage }
function TDBImage.GetDataField: string;
begin
Result:=FDataLink.FieldName;
end;
function TDBImage.GetDataSource: TDataSource;
begin
Result:=FDataLink.DataSource;
end;
function TDBImage.GetField: TField;
begin
Result:=FDataLink.Field;
end;
function TDBImage.GetReadOnly: Boolean;
begin
Result:=FDataLink.ReadOnly;
end;
procedure TDBImage.SetAutoDisplay(const AValue: Boolean);
begin
if FAutoDisplay=AValue then exit;
FAutoDisplay:=AValue;
if FAutoDisplay then LoadPicture;
end;
procedure TDBImage.SetDataField(const AValue: string);
begin
FDataLink.FieldName:=AValue;
end;
procedure TDBImage.SetDataSource(const AValue: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource:=AValue;
if AValue <> nil then
AValue.FreeNotification(Self);
end;
procedure TDBImage.SetReadOnly(const AValue: Boolean);
begin
FDataLink.ReadOnly:=AValue;
end;
procedure TDBImage.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) then begin
if (FDataLink<>nil) and (AComponent=DataSource) then
DataSource:=nil;
end;
end;
procedure TDBImage.DataChange(Sender: TObject);
begin
Picture.Graphic:=nil;
FPictureLoaded:=False;
if AutoDisplay then LoadPicture;
end;
procedure TDBImage.UpdateData(Sender: TObject);
begin
if Picture.Graphic is TBitmap then
FDataLink.Field.Assign(Picture.Graphic)
else
FDataLink.Field.Clear;
end;
procedure TDBImage.LoadPicture;
begin
if not FPictureLoaded
and (not Assigned(FDataLink.Field) or FDataLink.Field.IsBlob) then
Picture.Assign(FDataLink.Field);
end;
constructor TDBImage.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle:=ControlStyle+[csReplicatable];
FAutoDisplay:=True;
FQuickDraw:=true;
FDataLink:=TFieldDataLink.Create;
FDataLink.Control:=Self;
FDataLink.OnDataChange:=@DataChange;
FDataLink.OnUpdateData:=@UpdateData;
end;
destructor TDBImage.Destroy;
begin
FDataLink.Free;
FDataLink:=nil;
inherited Destroy;
end;
// included by dbctrls.pas