ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/dbFieldLinkPropEditor.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 9649 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# Content
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2011 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26
27 unit dbFieldLinkPropEditor;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35 ExtCtrls, PropEdits, DB;
36
37 type
38 {TFieldLinkProperty}
39
40 TFieldLinkProperty = class(TStringProperty)
41 private
42 FDataSet: TDataSet;
43 protected
44 function GetDataSet: TDataSet;
45 function GetIndexDefs: TIndexDefs; virtual;
46 function GetIndexFieldNames: string; virtual; abstract;
47 function GetMasterFields: string; virtual; abstract;
48 procedure SetIndexFieldNames(const Value: string); virtual; abstract;
49 procedure SetMasterFields(const Value: string); virtual; abstract;
50 public
51 procedure Edit; override;
52 function GetAttributes: TPropertyAttributes; override;
53 property DataSet: TDataSet read GetDataSet;
54 property IndexDefs: TIndexDefs read GetIndexDefs;
55 property DetailIndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
56 property MasterIndexFieldNames: string read GetMasterFields write SetMasterFields;
57 end;
58
59 { TFieldLinkEditor }
60
61 TFieldLinkEditor = class(TForm)
62 Bevel1: TBevel;
63 Button1: TButton;
64 OKButton: TButton;
65 JoinButton: TButton;
66 DeleteButton: TButton;
67 JoinHint: TLabel;
68 Label2: TLabel;
69 Label3: TLabel;
70 Label4: TLabel;
71 DetailedFieldListBox: TListBox;
72 JoinedFields: TListBox;
73 MasterFieldListBox: TListBox;
74 procedure DeleteButtonClick(Sender: TObject);
75 procedure DetailedFieldListBoxSelectionChange(Sender: TObject; User: boolean);
76 procedure FormShow(Sender: TObject);
77 procedure JoinButtonClick(Sender: TObject);
78 procedure JoinedFieldsClick(Sender: TObject);
79 procedure MasterFieldListBoxSelectionChange(Sender: TObject; User: boolean);
80 private
81 { private declarations }
82 FDetailedFieldsList: TStringList;
83 FMasterFieldsList: TStringList;
84 FChanged: boolean;
85 procedure ClearJoinList;
86 procedure ExtractNames(List: TStringList; Names: string);
87 procedure LoadDetailedFields;
88 procedure LoadJoinedFields;
89 procedure LoadMasterFields;
90 procedure SetButtonState;
91 procedure ShowJoins;
92 public
93 { public declarations }
94 DetailIndexDefs: TIndexDefs;
95 DetailIndexFieldNames: string;
96 MasterIndexFieldNames: string;
97 Master: TDataset;
98 IndexDefs: TIndexDefs;
99 constructor Create(TheOwner: TComponent); override;
100 destructor Destroy; override;
101 end;
102
103 var
104 FieldLinkEditor: TFieldLinkEditor;
105
106 function EditFieldLink(aMaster: TDataSet; aIndexDefs: TIndexDefs;
107 var aDetailIndexFieldNames: string;
108 var aMasterIndexFieldNames: string): boolean;
109
110 implementation
111
112 function EditFieldLink(aMaster: TDataSet; aIndexDefs: TIndexDefs;
113 var aDetailIndexFieldNames: string; var aMasterIndexFieldNames: string
114 ): boolean;
115 begin
116 with TFieldLinkEditor.Create(Application) do
117 try
118 Master := aMaster;
119 IndexDefs := aIndexDefs;
120 DetailIndexFieldNames := aDetailIndexFieldNames;
121 MasterIndexFieldNames := aMasterIndexFieldNames;
122 Result := ShowModal = mrOK;
123 if Result then
124 begin
125 aDetailIndexFieldNames := DetailIndexFieldNames;
126 aMasterIndexFieldNames := MasterIndexFieldNames
127 end;
128 finally
129 Free
130 end;
131
132 end;
133
134 {$R *.lfm}
135
136 { TFieldLinkProperty }
137
138 function TFieldLinkProperty.GetIndexDefs: TIndexDefs;
139 begin
140 Result := nil
141 end;
142
143 function TFieldLinkProperty.GetDataSet: TDataSet;
144 begin
145 if FDataSet = nil then
146 FDataSet := TDataSet(GetComponent(0));
147 Result := FDataSet;
148 end;
149
150 procedure TFieldLinkProperty.Edit;
151 var detailedFields, masterFields: string;
152 begin
153 if not assigned(DataSet.DataSource) or not assigned(DataSet.DataSource.DataSet) then
154 raise Exception.Create('No Master Dataset');
155
156 detailedFields := DetailIndexFieldNames;
157 masterFields := MasterIndexFieldNames;
158 if EditFieldLink(DataSet.DataSource.DataSet,IndexDefs,detailedFields,masterFields) then
159 Begin
160 DetailIndexFieldNames := detailedFields;
161 MasterIndexFieldNames := masterFields;
162 Modified
163 end;
164 end;
165
166 function TFieldLinkProperty.GetAttributes: TPropertyAttributes;
167 begin
168 Result := [paDialog];
169 end;
170
171 { TFieldLinkEditor }
172
173 procedure TFieldLinkEditor.DeleteButtonClick(Sender: TObject);
174 begin
175 if (JoinedFields.Items.Count = 0) or
176 (DetailIndexFieldNames = '') or
177 (MessageDlg('Delete the current Field Bindings?',mtConfirmation,[mbYes,mbNo],0) = mrYes) then
178 begin
179 ClearJoinList;
180 if DetailedFieldListBox.ItemIndex > -1 then
181 DetailIndexFieldNames := DetailedFieldListBox.Items[DetailedFieldListBox.ItemIndex]
182 else
183 DetailIndexFieldNames := '';
184 MasterIndexFieldNames := '';
185 LoadMasterFields;
186 LoadJoinedFields;
187 FChanged := true;
188 SetButtonState
189 end;
190 end;
191
192 procedure TFieldLinkEditor.DetailedFieldListBoxSelectionChange(Sender: TObject;
193 User: boolean);
194 begin
195 if (DetailedFieldListBox.ItemIndex > -1) and
196 (DetailedFieldListBox.Items[DetailedFieldListBox.ItemIndex] <> DetailIndexFieldNames) then
197 DeleteButtonClick(nil)
198 end;
199
200 procedure TFieldLinkEditor.FormShow(Sender: TObject);
201 begin
202 JoinHint.Caption := '';
203 LoadDetailedFields;
204 LoadMasterFields;
205 LoadJoinedFields;
206 FChanged := false;
207 SetButtonState
208 end;
209
210 procedure TFieldLinkEditor.JoinButtonClick(Sender: TObject);
211 begin
212 FMasterFieldsList.Add(MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]);
213 if FMasterFieldsList.Count = FDetailedFieldsList.Count then
214 MasterIndexFieldNames := FMasterFieldsList.DelimitedText;
215 FChanged := true;
216 ShowJoins;
217 SetButtonState
218 end;
219
220 procedure TFieldLinkEditor.JoinedFieldsClick(Sender: TObject);
221 begin
222 SetButtonState
223 end;
224
225 procedure TFieldLinkEditor.MasterFieldListBoxSelectionChange(Sender: TObject;
226 User: boolean);
227 begin
228 SetButtonState
229 end;
230
231 procedure TFieldLinkEditor.ClearJoinList;
232 begin
233 FDetailedFieldsList.Clear;
234 FMasterFieldsList.Clear;
235 JoinedFields.Items.Clear;
236 end;
237
238 procedure TFieldLinkEditor.ExtractNames(List: TStringList; Names: string);
239 var idx: integer;
240 begin
241 idx := 1;
242 List.Clear;
243 while idx <= Length(Names) do
244 List.Add(ExtractFieldName(Names,idx));
245 end;
246
247 procedure TFieldLinkEditor.LoadDetailedFields;
248 var
249 I: integer;
250 begin
251 DetailedFieldListBox.Clear;
252 IndexDefs.Update;
253 for I := 0 to IndexDefs.Count - 1 do
254 with IndexDefs[I] do
255 if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
256 DetailedFieldListBox.Items.Add(Fields);
257 DetailedFieldListBox.ItemIndex := DetailedFieldListBox.Items.IndexOf(DetailIndexFieldNames)
258 end;
259
260 procedure TFieldLinkEditor.LoadJoinedFields;
261 begin
262 ClearJoinList;
263 ExtractNames(FDetailedFieldsList,DetailIndexFieldNames);
264 ExtractNames(FMasterFieldsList,MasterIndexFieldNames);
265 while FDetailedFieldsList.Count < FMasterFieldsList.Count do
266 FMasterFieldsList.Delete(FMasterFieldsList.Count - 1);
267 ShowJoins
268 end;
269
270 procedure TFieldLinkEditor.LoadMasterFields;
271 begin
272 MasterFieldListBox.Clear;
273 if assigned(Master) then
274 Master.GetFieldNames(MasterFieldListBox.Items)
275 end;
276
277 procedure TFieldLinkEditor.SetButtonState;
278 begin
279 DeleteButton.Enabled := JoinedFields.Items.Count > 0;
280
281 JoinButton.Enabled := (DetailedFieldListBox.ItemIndex > -1) and
282 (MasterFieldListBox.ItemIndex > -1) and
283 (JoinedFields.Items.Count < FDetailedFieldsList.Count);
284
285 if JoinButton.Enabled then
286 JoinHint.Caption := Format('Click on the Join Button to bind %s to %s',
287 [FDetailedFieldsList[JoinedFields.Items.Count],
288 MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]])
289 else
290 JoinHint.Caption := '';
291 OKButton.Enabled := FChanged and (MasterIndexFieldNames <> '');
292 end;
293
294 procedure TFieldLinkEditor.ShowJoins;
295 var i: integer;
296 idx: integer;
297 begin
298 JoinedFields.Clear;
299 for i := 0 to FDetailedFieldsList.Count -1 do
300 if i < FMasterFieldsList.Count then
301 JoinedFields.Items.Add(FDetailedFieldsList[i] + ' => ' + FMasterFieldsList[i]);
302
303 for i := 0 to FMasterFieldsList.Count - 1 do
304 begin
305 idx := MasterFieldListBox.Items.IndexOf(FMasterFieldsList[i]);
306 if idx > -1 then
307 MasterFieldListBox.Items.Delete(idx);
308 end;
309 end;
310
311 constructor TFieldLinkEditor.Create(TheOwner: TComponent);
312 begin
313 inherited Create(TheOwner);
314 FDetailedFieldsList := TStringList.Create;
315 FMasterFieldsList := TStringList.Create;
316 FMasterFieldsList.Delimiter := ';';
317 FMasterFieldsList.StrictDelimiter := true
318 end;
319
320 destructor TFieldLinkEditor.Destroy;
321 begin
322 ClearJoinList;
323 if assigned(FDetailedFieldsList) then
324 FDetailedFieldsList.Free;
325 if assigned(FMasterFieldsList) then
326 FMasterFieldsList.Free;
327 inherited Destroy;
328 end;
329
330 end.
331