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

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;
  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:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (8 years ago) by tony
Content type:	text/x-pascal
File size:	9649 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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