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:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	6070 byte(s)
Log Message:	propset for eol-style
#	User	Rev	Content
1	tony	21	(*
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