summaryrefslogtreecommitdiff
path: root/src/gui/db/fpgui_db.pas
blob: a3530ca791d62d736890322b564fbc80a0d7de84 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
{
    fpGUI  -  Free Pascal GUI Toolkit

    Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

    See the file COPYING.modifiedLGPL, included in this distribution,
    for details about redistributing fpGUI.

    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.

    Description:
      Database support classes. This serves as an example of how someone
      could implement DB aware components for fpGUI.
}

unit fpgui_db;

{$mode objfpc}{$H+}

// If enabled it outputs debug information for this unit
{.$Define DEBUG}

interface

uses
  Classes,
  db,
  fpg_widget,
  fpg_label{, fpg_edit};
  
type

  TfpgFieldDataLink = class(TDataLink)
  private
    FWidget: TfpgWidget;
    FField: TField;
    FFieldName: string;
    FOnDataChange: TNotifyEvent;
    function    GetCanModify: Boolean;
    procedure   SetFieldName(const AFieldName: string);
    procedure   UpdateField;
  protected
    procedure   ActiveChanged; override;
    procedure   RecordChanged(AField: TField); override;
  public
    constructor Create(AWidget: TfpgWidget);
    property    CanModify: Boolean read GetCanModify;
    property    Field: TField read FField;
    property    FieldName: string read FFieldName write SetFieldName;
    property    Widget: TfpgWidget read FWidget write FWidget;
    property    OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
  end;
  
  
  TfpgDBLabel = class(TfpgCustomLabel)
  private
    FDataLink: TfpgFieldDataLink;
    function    GetDataField: String;
    function    GetField: TField;
    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;
    property    Field: TField read GetField;
  published
    property    AutoSize;
    property    BackgroundColor;
    property    DataField: string read GetDataField write SetDataField;
    property    DataSource: TDataSource read GetDataSource write SetDataSource;
    property    Enabled;
    property    FontDesc;
    property    Text;
    property    TextColor;
  end;

{
  // TfpgEdit needs to be refactor some more first!!
  TfpgDBEdit = class(TfpgCustomEdit)
  private
    FDataLink: TfpgFieldDataLink;
    function    GetDataField: string;
    function    GetDataSource: TDataSource;
    function    GetField: TField;
    function    GetReadOnly: Boolean;
    procedure   SetDataField(const ADataField: string);
    procedure   SetDataSource(const ADataSource: TDataSource);
    procedure   DataChange(Sender: TObject);
    procedure   SetReadOnly(const AValue: Boolean);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property    Field: TField read GetField;
  published
    property    DataField: string read GetDataField write SetDataField;
    property    DataSource: TDataSource read GetDataSource write SetDataSource;
    property    Enabled;
    property    BackgroundColor;
    property    Color;
    property    FontDesc;
    property    Text;
    property    ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;
}


implementation


{ TfpgFieldDataLink }

function TfpgFieldDataLink.GetCanModify: Boolean;
begin
  Result := not ReadOnly and (Field <> nil) and Field.CanModify;
end;

procedure TfpgFieldDataLink.SetFieldName(const AFieldName: string);
begin
  if AFieldName <> FieldName then
  begin
    FFieldName := AFieldName;
    UpdateField;
  end;
end;

procedure TfpgFieldDataLink.UpdateField;
begin
  {$IFDEF DEBUG} WriteLn('## UpdateField. DataSet: ', DataSource.DataSet.ClassName); {$ENDIF}
  FField := DataSource.DataSet.FindField(FieldName);
  if Assigned(OnDataChange) then
    OnDataChange(Self);
end;

procedure TfpgFieldDataLink.ActiveChanged;
begin
  inherited ActiveChanged;
  UpdateField;
end;

procedure TfpgFieldDataLink.RecordChanged(AField: TField);
begin
  inherited RecordChanged(AField);
  if Assigned(OnDataChange) then
    OnDataChange(Self);
end;

constructor TfpgFieldDataLink.Create(AWidget: TfpgWidget);
begin
  inherited Create;
  FWidget := AWidget;
end;


{ TfpgDBLabel }

function TfpgDBLabel.GetDataField: String;
begin
  Result := FDataLink.FieldName;
end;

function TfpgDBLabel.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TfpgDBLabel.SetDataField(const ADataField: String);
begin
  FDataLink.FieldName := ADataField;
end;

function TfpgDBLabel.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TfpgDBLabel.SetDataSource(ADataSource: TDataSource);
begin
  FDataLink.DataSource := ADataSource;
end;

procedure TfpgDBLabel.DataChange(Sender: TObject);
begin
  {$IFDEF DEBUG} Write(Classname + '.DataChange'); {$ENDIF}
  if Assigned(FDataLink.Field) then
  begin
    Text := FDataLink.Field.DisplayText;
    {$IFDEF DEBUG} WriteLn(' new text: "', Text, '"'); {$ENDIF}
  end
  else
  begin
    Text := '';
    {$IFDEF DEBUG} WriteLn('DataLink has no data'); {$ENDIF}
  end;
end;

constructor TfpgDBLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TfpgFieldDataLink.Create(Self);
  FDataLink.OnDataChange := @DataChange;
end;

destructor TfpgDBLabel.Destroy;
begin
  FDataLink.Free;
  inherited Destroy;
end;

end.