trunk/design/dbFieldLinkPropEditor.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2011 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit dbFieldLinkPropEditor;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, PropEdits, DB;

type
  {TFieldLinkProperty}

  TFieldLinkProperty = class(TStringProperty)
    private
      FDataSet: TDataSet;
    protected
      function GetDataSet: TDataSet;
      function GetIndexDefs: TIndexDefs; virtual;
      function GetIndexFieldNames: string; virtual; abstract;
      function GetMasterFields: string; virtual; abstract;
      procedure SetIndexFieldNames(const Value: string); virtual; abstract;
      procedure SetMasterFields(const Value: string); virtual; abstract;
    public
      procedure Edit; override;
      function GetAttributes: TPropertyAttributes; override;
      property DataSet: TDataSet read GetDataSet;
      property IndexDefs: TIndexDefs read GetIndexDefs;
      property DetailIndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
      property MasterIndexFieldNames: string read GetMasterFields write SetMasterFields;
    end;

  { TFieldLinkEditor }

  TFieldLinkEditor = class(TForm)
    Bevel1: TBevel;
    Button1: TButton;
    OKButton: TButton;
    JoinButton: TButton;
    DeleteButton: TButton;
    JoinHint: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    DetailedFieldListBox: TListBox;
    JoinedFields: TListBox;
    MasterFieldListBox: TListBox;
    procedure DeleteButtonClick(Sender: TObject);
    procedure DetailedFieldListBoxSelectionChange(Sender: TObject; User: boolean);
    procedure FormShow(Sender: TObject);
    procedure JoinButtonClick(Sender: TObject);
    procedure JoinedFieldsClick(Sender: TObject);
    procedure MasterFieldListBoxSelectionChange(Sender: TObject; User: boolean);
  private
    { private declarations }
    FDetailedFieldsList: TStringList;
    FMasterFieldsList: TStringList;
    FChanged: boolean;
    procedure ClearJoinList;
    procedure ExtractNames(List: TStringList; Names: string);
    procedure LoadDetailedFields;
    procedure LoadJoinedFields;
    procedure LoadMasterFields;
    procedure SetButtonState;
    procedure ShowJoins;
  public
    { public declarations }
    DetailIndexDefs: TIndexDefs;
    DetailIndexFieldNames: string;
    MasterIndexFieldNames: string;
    Master: TDataset;
    IndexDefs: TIndexDefs;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  FieldLinkEditor: TFieldLinkEditor;

function EditFieldLink(aMaster: TDataSet; aIndexDefs: TIndexDefs;
                       var aDetailIndexFieldNames: string;
                       var aMasterIndexFieldNames: string): boolean;

implementation

uses IBCustomDataSet;

function EditFieldLink(aMaster: TDataSet; aIndexDefs: TIndexDefs;
   var aDetailIndexFieldNames: string; var aMasterIndexFieldNames: string
   ): boolean;
begin
  with TFieldLinkEditor.Create(Application) do
  try
    Master := aMaster;
    IndexDefs := aIndexDefs;
    DetailIndexFieldNames := aDetailIndexFieldNames;
    MasterIndexFieldNames := aMasterIndexFieldNames;
    Result := ShowModal = mrOK;
    if Result then
    begin
      aDetailIndexFieldNames := DetailIndexFieldNames;
      aMasterIndexFieldNames := MasterIndexFieldNames
    end;
  finally
    Free
  end;

end;

{$R *.lfm}

{ TFieldLinkProperty }

 function TFieldLinkProperty.GetIndexDefs: TIndexDefs;
begin
  Result := nil
end;

function TFieldLinkProperty.GetDataSet: TDataSet;
begin
  if FDataSet = nil then
    FDataSet := TDataSet(GetComponent(0));
  Result := FDataSet;
end;

procedure TFieldLinkProperty.Edit;
var detailedFields, masterFields: string;
begin
  if not assigned(DataSet.DataSource) or not assigned(DataSet.DataSource.DataSet) then
     raise Exception.Create('No Master Dataset');

  detailedFields := DetailIndexFieldNames;
  masterFields := MasterIndexFieldNames;
  if EditFieldLink(DataSet.DataSource.DataSet,IndexDefs,detailedFields,masterFields) then
  Begin
    DetailIndexFieldNames := detailedFields;
    MasterIndexFieldNames := masterFields;
    Modified
  end;
end;

function TFieldLinkProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

{ TFieldLinkEditor }

 procedure TFieldLinkEditor.DeleteButtonClick(Sender: TObject);
begin
  if (JoinedFields.Items.Count = 0) or
     (DetailIndexFieldNames = '') or
     (MessageDlg('Delete the current Field Bindings?',mtConfirmation,[mbYes,mbNo],0) = mrYes) then
  begin
    ClearJoinList;
    if DetailedFieldListBox.ItemIndex > -1 then
        DetailIndexFieldNames := DetailedFieldListBox.Items[DetailedFieldListBox.ItemIndex]
    else
        DetailIndexFieldNames := '';
    MasterIndexFieldNames := '';
    LoadMasterFields;
    LoadJoinedFields;
    FChanged := true;
    SetButtonState
  end;
end;

 procedure TFieldLinkEditor.DetailedFieldListBoxSelectionChange(Sender: TObject;
   User: boolean);
begin
  if (DetailedFieldListBox.ItemIndex > -1) and
     (DetailedFieldListBox.Items[DetailedFieldListBox.ItemIndex] <> DetailIndexFieldNames) then
     DeleteButtonClick(nil)
end;

 procedure TFieldLinkEditor.FormShow(Sender: TObject);
begin
 JoinHint.Caption := '';
 LoadDetailedFields;
 LoadMasterFields;
 LoadJoinedFields;
 FChanged := false;
 SetButtonState
end;

 procedure TFieldLinkEditor.JoinButtonClick(Sender: TObject);
begin
  FMasterFieldsList.Add(MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]);
  if FMasterFieldsList.Count = FDetailedFieldsList.Count then
     MasterIndexFieldNames :=  FMasterFieldsList.DelimitedText;
  FChanged := true;
  ShowJoins;
  SetButtonState
end;

 procedure TFieldLinkEditor.JoinedFieldsClick(Sender: TObject);
begin
  SetButtonState
end;

 procedure TFieldLinkEditor.MasterFieldListBoxSelectionChange(Sender: TObject;
   User: boolean);
begin
  SetButtonState
end;

 procedure TFieldLinkEditor.ClearJoinList;
 begin
   FDetailedFieldsList.Clear;
   FMasterFieldsList.Clear;
   JoinedFields.Items.Clear;
 end;

 procedure TFieldLinkEditor.ExtractNames(List: TStringList; Names: string);
 var idx: integer;
 begin
  idx := 1;
  List.Clear;
  while idx <= Length(Names) do
        List.Add(ExtractFieldName(Names,idx));
 end;

 procedure TFieldLinkEditor.LoadDetailedFields;
 var
     I: integer;
 begin
  DetailedFieldListBox.Clear;
  if Master is TIBCustomDataSet then
   with TIBCustomDataSet(Master) do
     if (Database = nil) or not Database.Connected then Exit;
  IndexDefs.Update;
  for I := 0 to IndexDefs.Count - 1 do
    with IndexDefs[I] do
      if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
        DetailedFieldListBox.Items.Add(Fields);
  DetailedFieldListBox.ItemIndex :=  DetailedFieldListBox.Items.IndexOf(DetailIndexFieldNames)
 end;

 procedure TFieldLinkEditor.LoadJoinedFields;
 begin
   ClearJoinList;
   ExtractNames(FDetailedFieldsList,DetailIndexFieldNames);
   ExtractNames(FMasterFieldsList,MasterIndexFieldNames);
   while FDetailedFieldsList.Count < FMasterFieldsList.Count do
         FMasterFieldsList.Delete(FMasterFieldsList.Count - 1);
   ShowJoins
 end;

 procedure TFieldLinkEditor.LoadMasterFields;
 begin
   MasterFieldListBox.Clear;
   if assigned(Master) then
        Master.GetFieldNames(MasterFieldListBox.Items)
 end;

 procedure TFieldLinkEditor.SetButtonState;
 begin
   DeleteButton.Enabled := JoinedFields.Items.Count > 0;

   JoinButton.Enabled := (DetailedFieldListBox.ItemIndex > -1) and
                         (MasterFieldListBox.ItemIndex > -1) and
                         (JoinedFields.Items.Count < FDetailedFieldsList.Count);

   if JoinButton.Enabled then
      JoinHint.Caption := Format('Click on the Join Button to bind %s to %s',
                                        [FDetailedFieldsList[JoinedFields.Items.Count],
                                         MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]])
   else
     JoinHint.Caption := '';
   OKButton.Enabled := FChanged and (MasterIndexFieldNames <> '');
 end;

 procedure TFieldLinkEditor.ShowJoins;
 var i: integer;
     idx: integer;
 begin
   JoinedFields.Clear;
   for i := 0 to FDetailedFieldsList.Count -1 do
       if i < FMasterFieldsList.Count then
       JoinedFields.Items.Add(FDetailedFieldsList[i] + ' => ' + FMasterFieldsList[i]);

   for i := 0 to FMasterFieldsList.Count - 1 do
   begin
     idx := MasterFieldListBox.Items.IndexOf(FMasterFieldsList[i]);
     if idx > -1 then
       MasterFieldListBox.Items.Delete(idx);
   end;
 end;

 constructor TFieldLinkEditor.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FDetailedFieldsList := TStringList.Create;
  FMasterFieldsList := TStringList.Create;
  FMasterFieldsList.Delimiter := ';';
  FMasterFieldsList.StrictDelimiter := true
end;

 destructor TFieldLinkEditor.Destroy;
begin
  ClearJoinList;
  if assigned(FDetailedFieldsList) then
     FDetailedFieldsList.Free;
  if assigned(FMasterFieldsList) then
     FMasterFieldsList.Free;
  inherited Destroy;
end;

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	9807 byte(s)
Log Message:	Updated for IBX 4 release
#	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	uses IBCustomDataSet;
113
114	function EditFieldLink(aMaster: TDataSet; aIndexDefs: TIndexDefs;
115	var aDetailIndexFieldNames: string; var aMasterIndexFieldNames: string
116	): boolean;
117	begin
118	with TFieldLinkEditor.Create(Application) do
119	try
120	Master := aMaster;
121	IndexDefs := aIndexDefs;
122	DetailIndexFieldNames := aDetailIndexFieldNames;
123	MasterIndexFieldNames := aMasterIndexFieldNames;
124	Result := ShowModal = mrOK;
125	if Result then
126	begin
127	aDetailIndexFieldNames := DetailIndexFieldNames;
128	aMasterIndexFieldNames := MasterIndexFieldNames
129	end;
130	finally
131	Free
132	end;
133
134	end;
135
136	{$R *.lfm}
137
138	{ TFieldLinkProperty }
139
140	function TFieldLinkProperty.GetIndexDefs: TIndexDefs;
141	begin
142	Result := nil
143	end;
144
145	function TFieldLinkProperty.GetDataSet: TDataSet;
146	begin
147	if FDataSet = nil then
148	FDataSet := TDataSet(GetComponent(0));
149	Result := FDataSet;
150	end;
151
152	procedure TFieldLinkProperty.Edit;
153	var detailedFields, masterFields: string;
154	begin
155	if not assigned(DataSet.DataSource) or not assigned(DataSet.DataSource.DataSet) then
156	raise Exception.Create('No Master Dataset');
157
158	detailedFields := DetailIndexFieldNames;
159	masterFields := MasterIndexFieldNames;
160	if EditFieldLink(DataSet.DataSource.DataSet,IndexDefs,detailedFields,masterFields) then
161	Begin
162	DetailIndexFieldNames := detailedFields;
163	MasterIndexFieldNames := masterFields;
164	Modified
165	end;
166	end;
167
168	function TFieldLinkProperty.GetAttributes: TPropertyAttributes;
169	begin
170	Result := [paDialog];
171	end;
172
173	{ TFieldLinkEditor }
174
175	procedure TFieldLinkEditor.DeleteButtonClick(Sender: TObject);
176	begin
177	if (JoinedFields.Items.Count = 0) or
178	(DetailIndexFieldNames = '') or
179	(MessageDlg('Delete the current Field Bindings?',mtConfirmation,[mbYes,mbNo],0) = mrYes) then
180	begin
181	ClearJoinList;
182	if DetailedFieldListBox.ItemIndex > -1 then
183	DetailIndexFieldNames := DetailedFieldListBox.Items[DetailedFieldListBox.ItemIndex]
184	else
185	DetailIndexFieldNames := '';
186	MasterIndexFieldNames := '';
187	LoadMasterFields;
188	LoadJoinedFields;
189	FChanged := true;
190	SetButtonState
191	end;
192	end;
193
194	procedure TFieldLinkEditor.DetailedFieldListBoxSelectionChange(Sender: TObject;
195	User: boolean);
196	begin
197	if (DetailedFieldListBox.ItemIndex > -1) and
198	(DetailedFieldListBox.Items[DetailedFieldListBox.ItemIndex] <> DetailIndexFieldNames) then
199	DeleteButtonClick(nil)
200	end;
201
202	procedure TFieldLinkEditor.FormShow(Sender: TObject);
203	begin
204	JoinHint.Caption := '';
205	LoadDetailedFields;
206	LoadMasterFields;
207	LoadJoinedFields;
208	FChanged := false;
209	SetButtonState
210	end;
211
212	procedure TFieldLinkEditor.JoinButtonClick(Sender: TObject);
213	begin
214	FMasterFieldsList.Add(MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]);
215	if FMasterFieldsList.Count = FDetailedFieldsList.Count then
216	MasterIndexFieldNames := FMasterFieldsList.DelimitedText;
217	FChanged := true;
218	ShowJoins;
219	SetButtonState
220	end;
221
222	procedure TFieldLinkEditor.JoinedFieldsClick(Sender: TObject);
223	begin
224	SetButtonState
225	end;
226
227	procedure TFieldLinkEditor.MasterFieldListBoxSelectionChange(Sender: TObject;
228	User: boolean);
229	begin
230	SetButtonState
231	end;
232
233	procedure TFieldLinkEditor.ClearJoinList;
234	begin
235	FDetailedFieldsList.Clear;
236	FMasterFieldsList.Clear;
237	JoinedFields.Items.Clear;
238	end;
239
240	procedure TFieldLinkEditor.ExtractNames(List: TStringList; Names: string);
241	var idx: integer;
242	begin
243	idx := 1;
244	List.Clear;
245	while idx <= Length(Names) do
246	List.Add(ExtractFieldName(Names,idx));
247	end;
248
249	procedure TFieldLinkEditor.LoadDetailedFields;
250	var
251	I: integer;
252	begin
253	DetailedFieldListBox.Clear;
254	if Master is TIBCustomDataSet then
255	with TIBCustomDataSet(Master) do
256	if (Database = nil) or not Database.Connected then Exit;
257	IndexDefs.Update;
258	for I := 0 to IndexDefs.Count - 1 do
259	with IndexDefs[I] do
260	if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
261	DetailedFieldListBox.Items.Add(Fields);
262	DetailedFieldListBox.ItemIndex := DetailedFieldListBox.Items.IndexOf(DetailIndexFieldNames)
263	end;
264
265	procedure TFieldLinkEditor.LoadJoinedFields;
266	begin
267	ClearJoinList;
268	ExtractNames(FDetailedFieldsList,DetailIndexFieldNames);
269	ExtractNames(FMasterFieldsList,MasterIndexFieldNames);
270	while FDetailedFieldsList.Count < FMasterFieldsList.Count do
271	FMasterFieldsList.Delete(FMasterFieldsList.Count - 1);
272	ShowJoins
273	end;
274
275	procedure TFieldLinkEditor.LoadMasterFields;
276	begin
277	MasterFieldListBox.Clear;
278	if assigned(Master) then
279	Master.GetFieldNames(MasterFieldListBox.Items)
280	end;
281
282	procedure TFieldLinkEditor.SetButtonState;
283	begin
284	DeleteButton.Enabled := JoinedFields.Items.Count > 0;
285
286	JoinButton.Enabled := (DetailedFieldListBox.ItemIndex > -1) and
287	(MasterFieldListBox.ItemIndex > -1) and
288	(JoinedFields.Items.Count < FDetailedFieldsList.Count);
289
290	if JoinButton.Enabled then
291	JoinHint.Caption := Format('Click on the Join Button to bind %s to %s',
292	[FDetailedFieldsList[JoinedFields.Items.Count],
293	MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]])
294	else
295	JoinHint.Caption := '';
296	OKButton.Enabled := FChanged and (MasterIndexFieldNames <> '');
297	end;
298
299	procedure TFieldLinkEditor.ShowJoins;
300	var i: integer;
301	idx: integer;
302	begin
303	JoinedFields.Clear;
304	for i := 0 to FDetailedFieldsList.Count -1 do
305	if i < FMasterFieldsList.Count then
306	JoinedFields.Items.Add(FDetailedFieldsList[i] + ' => ' + FMasterFieldsList[i]);
307
308	for i := 0 to FMasterFieldsList.Count - 1 do
309	begin
310	idx := MasterFieldListBox.Items.IndexOf(FMasterFieldsList[i]);
311	if idx > -1 then
312	MasterFieldListBox.Items.Delete(idx);
313	end;
314	end;
315
316	constructor TFieldLinkEditor.Create(TheOwner: TComponent);
317	begin
318	inherited Create(TheOwner);
319	FDetailedFieldsList := TStringList.Create;
320	FMasterFieldsList := TStringList.Create;
321	FMasterFieldsList.Delimiter := ';';
322	FMasterFieldsList.StrictDelimiter := true
323	end;
324
325	destructor TFieldLinkEditor.Destroy;
326	begin
327	ClearJoinList;
328	if assigned(FDetailedFieldsList) then
329	FDetailedFieldsList.Free;
330	if assigned(FMasterFieldsList) then
331	FMasterFieldsList.Free;
332	inherited Destroy;
333	end;
334
335	end.
336