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
#	User	Rev	Content
1	tony	19	(*
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	tony	45	function EditFieldLink(aMaster: TDataSet; aIndexDefs: TIndexDefs;
113	tony	19	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