trunk/design/dbFieldListPropEditor.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 dbFieldListPropEditor;

{$mode objfpc}{$H+}

interface

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

type

  { TIndexFieldNamesProperty }

  TIndexFieldNamesProperty =  class(TStringProperty)
  protected
    function GetFieldDefs: TFieldDefs; virtual;
    function GetIndexFieldNames: string; virtual; abstract;
    procedure SetIndexFieldNames(const Value: string); virtual; abstract;
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    property FieldDefs: TFieldDefs read GetFieldDefs;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
end;

  { TFieldListEditor }

  TFieldListEditor = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    AvailableFields: TListBox;
    SelectedFields: TListBox;
    SelectButton: TSpeedButton;
    DeselectButton: TSpeedButton;
    FSelectedFields: TStringList;
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
    procedure DeselectButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SelectButtonClick(Sender: TObject);
  private
    { private declarations }
    FFieldDefs: TFieldDefs;
    FIndexFieldNames: string;
    procedure ExtractNames(List: TStringList; Names: string);
  public
    { public declarations }
    constructor Create(TheComponent: TComponent); override;
    destructor Destroy; override;
    property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
    property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
  end;

var
  FieldListEditor: TFieldListEditor;

function EditIndexFieldList(var aIndexFieldNames: string; aFieldDefs: TFieldDefs): boolean;

implementation

function EditIndexFieldList(var aIndexFieldNames: string; aFieldDefs: TFieldDefs
  ): boolean;
begin
  with TFieldListEditor.Create(Application) do
  try
    IndexFieldNames := aIndexFieldNames;
    FieldDefs := aFieldDefs;
    Result := ShowModal = mrOK;
    if Result then
      aIndexFieldNames := IndexFieldNames
  finally
    Free
  end;
end;

{$R *.lfm}

{ TIndexFieldNamesProperty }

function TIndexFieldNamesProperty.GetFieldDefs: TFieldDefs;
begin
  Result := nil
end;

procedure TIndexFieldNamesProperty.Edit;
var aIndexFieldNames: string;
begin
  aIndexFieldNames := IndexFieldNames;
  if EditIndexFieldList(aIndexFieldNames,FieldDefs) then
  begin
    IndexFieldNames := aIndexFieldNames;
    Modified
  end
end;

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

{ TFieldListEditor }

procedure TFieldListEditor.ApplicationProperties1Idle(Sender: TObject;
  var Done: Boolean);
begin
  DeselectButton.Enabled :=  SelectedFields.ItemIndex >= 0;
  SelectButton.Enabled :=  AvailableFields.ItemIndex >= 0;
end;

procedure TFieldListEditor.DeselectButtonClick(Sender: TObject);
begin
  AvailableFields.Items.Add(SelectedFields.Items[SelectedFields.ItemIndex]);
  SelectedFields.Items.Delete(SelectedFields.ItemIndex);
  SelectedFields.ItemIndex := -1
end;

procedure TFieldListEditor.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
var I: integer;
begin
  if assigned(FieldDefs) and (ModalResult = mrOK) then
  begin
      FIndexFieldNames := '';
      for i := 0 to SelectedFields.Count - 1 do
        if i = 0 then
          FIndexFieldNames := SelectedFields.Items[0]
        else
          FIndexFieldNames := FIndexFieldNames + ';' + SelectedFields.items[i]
  end;
end;

procedure TFieldListEditor.FormShow(Sender: TObject);
var i: integer;
begin
  FSelectedFields.Clear;
  AvailableFields.Items.Clear;
  if not assigned(FieldDefs) then Exit;

  ExtractNames(FSelectedFields, FIndexFieldNames);
  FieldDefs.Update;
  for i := FSelectedFields.Count - 1 downto 0 do
      if FieldDefs.Find(FSelectedFields[i]) = nil then
         FSelectedFields.Delete(i);

  SelectedFields.Items.Assign(FSelectedFields);
  SelectedFields.ItemIndex := -1;

  for i := 0 to FieldDefs.Count - 1 do
    if SelectedFields.Items.IndexOf(FieldDefs.Items[i].Name) = -1 then
       AvailableFields.Items.Add(FieldDefs.Items[i].Name);
  AvailableFields.ItemIndex := -1
end;

procedure TFieldListEditor.SelectButtonClick(Sender: TObject);
begin
  SelectedFields.Items.Add(AvailableFields.Items[AvailableFields.ItemIndex]);
  AvailableFields.Items.Delete(AvailableFields.ItemIndex);
  AvailableFields.ItemIndex := -1
end;

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

constructor TFieldListEditor.Create(TheComponent: TComponent);
begin
  inherited Create(TheComponent);
  FSelectedFields := TStringList.Create;
  FSelectedFields.Delimiter := ';';
  FSelectedFields.StrictDelimiter := true
end;

destructor TFieldListEditor.Destroy;
begin
 if assigned(FSelectedFields) then FSelectedFields.Free;
  inherited Destroy;
end;

end.

Revision:	21
Committed:	Thu Feb 26 10:33:34 2015 UTC (9 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	6070 byte(s)
Log Message:	Committing updates for Release R1-2-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	unit dbFieldListPropEditor;
27
28	{$mode objfpc}{$H+}
29
30	interface
31
32	uses
33	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
34	StdCtrls, Buttons, DB, PropEdits;
35
36	type
37
38	{ TIndexFieldNamesProperty }
39
40	TIndexFieldNamesProperty = class(TStringProperty)
41	protected
42	function GetFieldDefs: TFieldDefs; virtual;
43	function GetIndexFieldNames: string; virtual; abstract;
44	procedure SetIndexFieldNames(const Value: string); virtual; abstract;
45	public
46	procedure Edit; override;
47	function GetAttributes: TPropertyAttributes; override;
48	property FieldDefs: TFieldDefs read GetFieldDefs;
49	property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
50	end;
51
52	{ TFieldListEditor }
53
54	TFieldListEditor = class(TForm)
55	ApplicationProperties1: TApplicationProperties;
56	Bevel1: TBevel;
57	Button1: TButton;
58	Button2: TButton;
59	Label1: TLabel;
60	Label2: TLabel;
61	AvailableFields: TListBox;
62	SelectedFields: TListBox;
63	SelectButton: TSpeedButton;
64	DeselectButton: TSpeedButton;
65	FSelectedFields: TStringList;
66	procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
67	procedure DeselectButtonClick(Sender: TObject);
68	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
69	procedure FormShow(Sender: TObject);
70	procedure SelectButtonClick(Sender: TObject);
71	private
72	{ private declarations }
73	FFieldDefs: TFieldDefs;
74	FIndexFieldNames: string;
75	procedure ExtractNames(List: TStringList; Names: string);
76	public
77	{ public declarations }
78	constructor Create(TheComponent: TComponent); override;
79	destructor Destroy; override;
80	property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
81	property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
82	end;
83
84	var
85	FieldListEditor: TFieldListEditor;
86
87	function EditIndexFieldList(var aIndexFieldNames: string; aFieldDefs: TFieldDefs): boolean;
88
89	implementation
90
91	function EditIndexFieldList(var aIndexFieldNames: string; aFieldDefs: TFieldDefs
92	): boolean;
93	begin
94	with TFieldListEditor.Create(Application) do
95	try
96	IndexFieldNames := aIndexFieldNames;
97	FieldDefs := aFieldDefs;
98	Result := ShowModal = mrOK;
99	if Result then
100	aIndexFieldNames := IndexFieldNames
101	finally
102	Free
103	end;
104	end;
105
106	{$R *.lfm}
107
108	{ TIndexFieldNamesProperty }
109
110	function TIndexFieldNamesProperty.GetFieldDefs: TFieldDefs;
111	begin
112	Result := nil
113	end;
114
115	procedure TIndexFieldNamesProperty.Edit;
116	var aIndexFieldNames: string;
117	begin
118	aIndexFieldNames := IndexFieldNames;
119	if EditIndexFieldList(aIndexFieldNames,FieldDefs) then
120	begin
121	IndexFieldNames := aIndexFieldNames;
122	Modified
123	end
124	end;
125
126	function TIndexFieldNamesProperty.GetAttributes: TPropertyAttributes;
127	begin
128	Result := [paDialog];
129	end;
130
131	{ TFieldListEditor }
132
133	procedure TFieldListEditor.ApplicationProperties1Idle(Sender: TObject;
134	var Done: Boolean);
135	begin
136	DeselectButton.Enabled := SelectedFields.ItemIndex >= 0;
137	SelectButton.Enabled := AvailableFields.ItemIndex >= 0;
138	end;
139
140	procedure TFieldListEditor.DeselectButtonClick(Sender: TObject);
141	begin
142	AvailableFields.Items.Add(SelectedFields.Items[SelectedFields.ItemIndex]);
143	SelectedFields.Items.Delete(SelectedFields.ItemIndex);
144	SelectedFields.ItemIndex := -1
145	end;
146
147	procedure TFieldListEditor.FormClose(Sender: TObject;
148	var CloseAction: TCloseAction);
149	var I: integer;
150	begin
151	if assigned(FieldDefs) and (ModalResult = mrOK) then
152	begin
153	FIndexFieldNames := '';
154	for i := 0 to SelectedFields.Count - 1 do
155	if i = 0 then
156	FIndexFieldNames := SelectedFields.Items[0]
157	else
158	FIndexFieldNames := FIndexFieldNames + ';' + SelectedFields.items[i]
159	end;
160	end;
161
162	procedure TFieldListEditor.FormShow(Sender: TObject);
163	var i: integer;
164	begin
165	FSelectedFields.Clear;
166	AvailableFields.Items.Clear;
167	if not assigned(FieldDefs) then Exit;
168
169	ExtractNames(FSelectedFields, FIndexFieldNames);
170	FieldDefs.Update;
171	for i := FSelectedFields.Count - 1 downto 0 do
172	if FieldDefs.Find(FSelectedFields[i]) = nil then
173	FSelectedFields.Delete(i);
174
175	SelectedFields.Items.Assign(FSelectedFields);
176	SelectedFields.ItemIndex := -1;
177
178	for i := 0 to FieldDefs.Count - 1 do
179	if SelectedFields.Items.IndexOf(FieldDefs.Items[i].Name) = -1 then
180	AvailableFields.Items.Add(FieldDefs.Items[i].Name);
181	AvailableFields.ItemIndex := -1
182	end;
183
184	procedure TFieldListEditor.SelectButtonClick(Sender: TObject);
185	begin
186	SelectedFields.Items.Add(AvailableFields.Items[AvailableFields.ItemIndex]);
187	AvailableFields.Items.Delete(AvailableFields.ItemIndex);
188	AvailableFields.ItemIndex := -1
189	end;
190
191	procedure TFieldListEditor.ExtractNames(List: TStringList; Names: string);
192	var idx: integer;
193	begin
194	idx := 1;
195	List.Clear;
196	while idx <= Length(Names) do
197	List.Add(ExtractFieldName(Names,idx));
198	end;
199
200	constructor TFieldListEditor.Create(TheComponent: TComponent);
201	begin
202	inherited Create(TheComponent);
203	FSelectedFields := TStringList.Create;
204	FSelectedFields.Delimiter := ';';
205	FSelectedFields.StrictDelimiter := true
206	end;
207
208	destructor TFieldListEditor.Destroy;
209	begin
210	if assigned(FSelectedFields) then FSelectedFields.Free;
211	inherited Destroy;
212	end;
213
214	end.
215