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;
  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;
 var FieldNames: string;
     idx: integer;
 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:	19
Committed:	Mon Jul 7 13:00:15 2014 UTC (9 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	9718 byte(s)
Log Message:	Committing updates for Release R1-1-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			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			IndexDefs.Update;
255			for I := 0 to IndexDefs.Count - 1 do
256			with IndexDefs[I] do
257			if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
258			DetailedFieldListBox.Items.Add(Fields);
259			DetailedFieldListBox.ItemIndex := DetailedFieldListBox.Items.IndexOf(DetailIndexFieldNames)
260			end;
261
262			procedure TFieldLinkEditor.LoadJoinedFields;
263			begin
264			ClearJoinList;
265			ExtractNames(FDetailedFieldsList,DetailIndexFieldNames);
266			ExtractNames(FMasterFieldsList,MasterIndexFieldNames);
267			while FDetailedFieldsList.Count < FMasterFieldsList.Count do
268			FMasterFieldsList.Delete(FMasterFieldsList.Count - 1);
269			ShowJoins
270			end;
271
272			procedure TFieldLinkEditor.LoadMasterFields;
273			var FieldNames: string;
274			idx: integer;
275			begin
276			MasterFieldListBox.Clear;
277			if assigned(Master) then
278			Master.GetFieldNames(MasterFieldListBox.Items)
279			end;
280
281			procedure TFieldLinkEditor.SetButtonState;
282			begin
283			DeleteButton.Enabled := JoinedFields.Items.Count > 0;
284
285			JoinButton.Enabled := (DetailedFieldListBox.ItemIndex > -1) and
286			(MasterFieldListBox.ItemIndex > -1) and
287			(JoinedFields.Items.Count < FDetailedFieldsList.Count);
288
289			if JoinButton.Enabled then
290			JoinHint.Caption := Format('Click on the Join Button to bind %s to %s',
291			[FDetailedFieldsList[JoinedFields.Items.Count],
292			MasterFieldListBox.Items[MasterFieldListBox.ItemIndex]])
293			else
294			JoinHint.Caption := '';
295			OKButton.Enabled := FChanged and (MasterIndexFieldNames <> '');
296			end;
297
298			procedure TFieldLinkEditor.ShowJoins;
299			var i: integer;
300			idx: integer;
301			begin
302			JoinedFields.Clear;
303			for i := 0 to FDetailedFieldsList.Count -1 do
304			if i < FMasterFieldsList.Count then
305			JoinedFields.Items.Add(FDetailedFieldsList[i] + ' => ' + FMasterFieldsList[i]);
306
307			for i := 0 to FMasterFieldsList.Count - 1 do
308			begin
309			idx := MasterFieldListBox.Items.IndexOf(FMasterFieldsList[i]);
310			if idx > -1 then
311			MasterFieldListBox.Items.Delete(idx);
312			end;
313			end;
314
315			constructor TFieldLinkEditor.Create(TheOwner: TComponent);
316			begin
317			inherited Create(TheOwner);
318			FDetailedFieldsList := TStringList.Create;
319			FMasterFieldsList := TStringList.Create;
320			FMasterFieldsList.Delimiter := ';';
321			FMasterFieldsList.StrictDelimiter := true
322			end;
323
324			destructor TFieldLinkEditor.Destroy;
325			begin
326			ClearJoinList;
327			if assigned(FDetailedFieldsList) then
328			FDetailedFieldsList.Free;
329			if assigned(FMasterFieldsList) then
330			FMasterFieldsList.Free;
331			inherited Destroy;
332			end;
333
334			end.
335