diff options
Diffstat (limited to 'gui/db/fpgui_db.pas')
-rw-r--r-- | gui/db/fpgui_db.pas | 167 |
1 files changed, 167 insertions, 0 deletions
diff --git a/gui/db/fpgui_db.pas b/gui/db/fpgui_db.pas new file mode 100644 index 00000000..10f0e5a6 --- /dev/null +++ b/gui/db/fpgui_db.pas @@ -0,0 +1,167 @@ +{ + fpGUI - Free Pascal Graphical User Interface + Copyright (C) 2000 - 2001 by + Areca Systems GmbH / Sebastian Guenther + Copyright (C) 2006 by Graeme Geldenhuys + member of the fpGUI development team. + + fgGUI database support + + See the file COPYING.fpGUI, 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. + + **********************************************************************} + + +unit fpGUI_DB; + +{$IFDEF Debug} +{$ASSERTIONS On} +{$ENDIF} + +interface + +uses Classes, fpGUI, DB; + +type + TFieldDataLink = class(TDataLink) + private + FWidget: TWidget; + FField: TField; + FFieldName: String; + FOnDataChange: TNotifyEvent; + procedure SetFieldName(const AFieldName: String); + procedure UpdateField; + protected + procedure ActiveChanged; override; + procedure RecordChanged(AField: TField); override; + public + constructor Create(AWidget: TWidget); + property Field: TField read FField; + property FieldName: String read FFieldName write SetFieldName; + property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange; + end; + + TDBText = class(TCustomLabel) + private + FDataLink: TFieldDataLink; + function GetDataField: String; + procedure SetDataField(const ADataField: String); + function GetDataSource: TDataSource; + procedure SetDataSource(ADataSource: TDataSource); + procedure DataChange(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Text; + property DataField: String read GetDataField write SetDataField; + property DataSource: TDataSource read GetDataSource write SetDataSource; + end; + + +// =================================================================== +// =================================================================== + +implementation + + +constructor TFieldDataLink.Create(AWidget: TWidget); +begin + inherited Create; + FWidget := AWidget; +end; + +procedure TFieldDataLink.ActiveChanged; +begin + UpdateField; +end; + +procedure TFieldDataLink.RecordChanged(AField: TField); +begin + if Assigned(OnDataChange) then + OnDataChange(Self); +end; + +procedure TFieldDataLink.SetFieldName(const AFieldName: String); +begin + if AFieldName <> FieldName then + begin + FFieldName := AFieldName; + UpdateField; + end; +end; + +procedure TFieldDataLink.UpdateField; +begin +WriteLn('##############UpdateField. DataSet: ', DataSource.DataSet.ClassName); + FField := DataSource.DataSet.FindField(FieldName); + if Assigned(OnDataChange) then + OnDataChange(Self); +end; + + +constructor TDBText.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FDataLink := TFieldDataLink.Create(Self); + FDataLink.OnDataChange := @DataChange; +end; + +destructor TDBText.Destroy; +begin + FDataLink.Free; + inherited Destroy; +end; + +function TDBText.GetDataField: String; +begin + Result := FDataLink.FieldName; +end; + +procedure TDBText.SetDataField(const ADataField: String); +begin + FDataLink.FieldName := ADataField; +end; + +function TDBText.GetDataSource: TDataSource; +begin + Result := FDataLink.DataSource; +end; + +procedure TDBText.SetDataSource(ADataSource: TDataSource); +begin + FDataLink.DataSource := ADataSource; +end; + +procedure TDBText.DataChange(Sender: TObject); +begin +Write('TDBText.DataChange'); + if Assigned(FDataLink.Field) then + begin + Text := FDataLink.Field.DisplayText; + WriteLn(' new text: "', Text, '"'); + end else + begin + Text := ''; + WriteLn('DataLink has no data'); + end; +end; + + +end. + + +{ + $Log: fpgui_db.pp,v $ + Revision 1.2 2001/01/17 21:36:26 sg + * Updating fixes + + Revision 1.1 2000/12/23 23:20:16 sg + * First public CVS version... + +} |