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

implemented TDBRadioGroup

Browse Source 
git-svn-id: trunk@4630 -
This commit is contained in:
mattias 2003-09-15 22:02:02 +00:00
parent aeda9b5f9d
commit ae92ebc5f5
4 changed files with 223 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -808,6 +808,7 @@ lcl/include/customstatictext.inc svneol=native#text/pascal
lcl/include/customupdown.inc svneol=native#text/pascal
lcl/include/dbedit.inc svneol=native#text/pascal
lcl/include/dblistbox.inc svneol=native#text/pascal
lcl/include/dbradiogroup.inc svneol=native#text/pascal
lcl/include/dbtext.inc svneol=native#text/pascal
lcl/include/defaultbitbtnimages.inc svneol=native#text/pascal
lcl/include/docktree.inc svneol=native#text/pascal

70
lcl/dbctrls.pp
View File

@ -41,6 +41,7 @@ uses
Type
{ TFieldDataLink }
TFieldDataLink = class(TDataLink)
private
FField: TField;
@ -103,7 +104,9 @@ Type
property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange;
end;
{ TDBEdit }
{ TDBEdit }
TDBEdit = class(TCustomMaskEdit)
private
FDataLink: TFieldDataLink;
@ -146,7 +149,9 @@ Type
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
end;
{ TDBText }
TDBText = class(TLabel)
private
FDataLink: TFieldDataLink;
@ -172,7 +177,9 @@ Type
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;
{ TDBListBox }
TDBListBox = class(TCustomListBox)
FDataLink: TFieldDataLink;
@ -219,6 +226,63 @@ Type
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
end;
{ TDBRadioGroup }
TDBRadioGroup = class(TCustomRadioGroup)
private
FDataLink: TFieldDataLink;
FOnChange: TNotifyEvent;
FValue: string;
FInSetValue: boolean;
FValues: TStrings;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const AValue: string);
procedure SetDataSource(const AValue: TDataSource);
procedure SetItems(const AValue: TStrings);
procedure SetReadOnly(const AValue: Boolean);
procedure SetValue(const AValue: string);
procedure SetValues(const AValue: TStrings);
protected
procedure Change; virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
property DataLink: TFieldDataLink read FDataLink;
function GetButtonValue(Index: Integer): string;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
property ItemIndex;
property Value: string read FValue write SetValue;
published
property Align;
property Anchors;
property Caption;
property Columns;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property Enabled;
property Items write SetItems;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChangeBounds;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseuP;
property OnResize;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property Values: TStrings read FValues write SetValues;
property Visible;
end;
implementation
{TFieldDataLink Private Methods}
@ -530,12 +594,16 @@ end;
{$Include dbedit.inc}
{$Include dbtext.inc}
{$Include dblistbox.inc}
{$Include dbradiogroup.inc}
end.
{ =============================================================================
$Log$
Revision 1.3 2003/09/15 22:02:02 mattias
implemented TDBRadioGroup
Revision 1.2 2003/09/15 01:56:48 ajgenius
Added TDBListBox. needs more work for ReadOnly

5
lcl/extctrls.pp
View File

@ -458,7 +458,7 @@ type
TRadioGroup = class(TCustomRadioGroup)
public
constructor Create (AOwner : TComponent); override;
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
@ -756,6 +756,9 @@ end.
{
$Log$
Revision 1.72 2003/09/15 22:02:02 mattias
implemented TDBRadioGroup
Revision 1.71 2003/09/04 11:10:18 mattias
added csClickEvents to TImage

149
lcl/include/dbradiogroup.inc Normal file
View File

@ -0,0 +1,149 @@
// 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. *
* *
*****************************************************************************
}
{ TDBRadioGroup }
function TDBRadioGroup.GetDataField: string;
begin
Result:=FDataLink.FieldName;
end;
function TDBRadioGroup.GetDataSource: TDataSource;
begin
Result:=FDataLink.DataSource;
end;
function TDBRadioGroup.GetField: TField;
begin
Result:=FDataLink.Field;
end;
function TDBRadioGroup.GetReadOnly: Boolean;
begin
Result:=FDataLink.ReadOnly;
end;
procedure TDBRadioGroup.SetDataField(const AValue: string);
begin
FDataLink.FieldName:=AValue;
end;
procedure TDBRadioGroup.SetDataSource(const AValue: TDataSource);
var
NewDataSource: TDataSource;
begin
if DataSource=AValue then exit;
FDataLink.DataSource:=AValue;
NewDataSource:=DataSource;
if NewDataSource<>nil then NewDataSource.FreeNotification(Self);
end;
procedure TDBRadioGroup.SetItems(const AValue: TStrings);
begin
if Items=AValue then exit;
Items.Assign(AValue);
DataChange(Self);
end;
procedure TDBRadioGroup.SetReadOnly(const AValue: Boolean);
begin
FDataLink.ReadOnly := AValue;
end;
procedure TDBRadioGroup.SetValue(const AValue: string);
var
i: Integer;
begin
if FValue=AValue then exit;
FInSetValue := True;
try
i:=Items.Count-1;
while (i>=0) and (AValue<>GetButtonValue(i)) do dec(i);
ItemIndex:=i;
finally
FInSetValue := False;
end;
FValue:=AValue;
Change;
end;
procedure TDBRadioGroup.SetValues(const AValue: TStrings);
begin
if (FValues=AValue) then exit;
FValues.Assign(AValue);
DataChange(Self);
end;
procedure TDBRadioGroup.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TDBRadioGroup.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 TDBRadioGroup.DataChange(Sender: TObject);
begin
if FDataLink.Field<>nil then
Value:=FDataLink.Field.Text
else
Value:='';
end;
procedure TDBRadioGroup.UpdateData(Sender: TObject);
begin
if FDataLink.Field<>nil then
FDataLink.Field.Text:=Value;
end;
function TDBRadioGroup.GetButtonValue(Index: Integer): string;
begin
if (Index<FValues.Count) and (FValues[Index]<>'') then
Result:=FValues[Index]
else if Index<Items.Count then
Result:=Items[Index]
else
Result:='';
end;
constructor TDBRadioGroup.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FValues := TStringList.Create;
end;
destructor TDBRadioGroup.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FValues.Free;
FValues:=nil;
inherited Destroy;
end;
// included by dbctrls.pas