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...
+
+}