1 {
2 
3  ***************************************************************************
4  *                                                                         *
5  *   This source is free software; you can redistribute it and/or modify   *
6  *   it under the terms of the GNU General Public License as published by  *
7  *   the Free Software Foundation; either version 2 of the License, or     *
8  *   (at your option) any later version.                                   *
9  *                                                                         *
10  *   This code is distributed in the hope that it will be useful, but      *
11  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
12  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
13  *   General Public License for more details.                              *
14  *                                                                         *
15  *   A copy of the GNU General Public License is available on the World    *
16  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
17  *   obtain it by writing to the Free Software Foundation,                 *
18  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
19  *                                                                         *
20  ***************************************************************************
21 
22 
23   author: Alexandru Alexandrov
24   date: 11.06.2005
25 
26 }
27 
28 unit FieldsList;
29 
30 {$mode objfpc}{$H+}
31 
32 interface
33 
34 uses
35   Classes, SysUtils, DB,
36   // LCL
37   Forms, Dialogs, Buttons, StdCtrls,
38   // IdeIntf
39   ObjInspStrConsts, ComponentEditors, IDEWindowIntf;
40 
41 type
42 
43   { TFieldsListFrm }
44 
45   TFieldsListFrm = class(TForm)
46     BitBtnOk: TBitBtn;
47     BitBtnCancel: TBitBtn;
48     ListBox1: TListBox;
49     procedure BitBtnOkClick(Sender: TObject);
50     procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
51     procedure FormCreate(Sender: TObject);
52   private
53     FDesigner: TComponentEditorDesigner;
54     LinkDataset: TDataset;
55   protected
56     procedure RefreshFieldsList; virtual;
57     procedure SelectAll; virtual;
58     procedure DoShow; override;
59   public
60     constructor Create(AOwner: TComponent; ADataset: TDataset;
61       ADesigner: TComponentEditorDesigner); reintroduce;
62   end;
63 
64 var
65   FieldsListFrm: TFieldsListFrm;
66 
67 implementation
68 
69 {$R *.lfm}
70 
71 { TFieldsListFrm }
72 
73 procedure TFieldsListFrm.FormCreate(Sender: TObject);
74 begin
75   IDEDialogLayoutList.ApplyLayout(Self);
76 end;
77 
78 procedure TFieldsListFrm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
79 begin
80   IDEDialogLayoutList.SaveLayout(Self);
81 end;
82 
83 procedure TFieldsListFrm.BitBtnOkClick(Sender: TObject);
84 var
85   i: integer;
86   NewField: TField;
87   fModified: boolean;
88   PreActive: boolean;
89   FieldDef: TFieldDef;
90 
FieldNameToPascalIdentifiernull91   function FieldNameToPascalIdentifier(const AName: string): string;
92   var
93     i : integer;
94   begin
95     Result := '';
96     // FieldName is an ansistring
97     for i := 1 to Length(AName) do
98       if AName[i] in ['0'..'9','a'..'z','A'..'Z','_'] then
99         Result := Result + AName[i];
100     if (Length(Result) > 0) and (not (Result[1] in ['0'..'9'])) then
101         Exit;
102     if Assigned(FieldDef.FieldClass) then
103     begin
104       Result := FieldDef.FieldClass.ClassName + Result;
105       if Copy(Result, 1, 1) = 'T' then
106         Result := Copy(Result, 2, Length(Result) - 1);
107     end
108     else
109       Result := 'Field' + Result;
110   end;
111 
CreateFieldNamenull112   function CreateFieldName(Owner: TComponent; const AName: string): string;
113   var
114     j:integer;
115   begin
116     for j := 0 to Owner.ComponentCount - 1 do
117     begin
118       if CompareText(Owner.Components[j].Name, AName) = 0 then
119       begin
120         Result := FDesigner.CreateUniqueComponentName(LinkDataset.Name +
121           FieldNameToPascalIdentifier(NewField.FieldName));
122         exit;
123       end;
124     end;
125     Result := AName;
126   end;
127 
128 begin
129   LinkDataset.DisableControls;
130   try
131     PreActive := LinkDataset.Active;
132     try
133       LinkDataSet.Active := False;
134       fModified := False;
135       for i := 0 to ListBox1.Items.Count - 1 do
136       begin
137         if ListBox1.Selected[i] and (LinkDataset.FindField(ListBox1.Items[i]) = nil) then
138         begin
139           FieldDef := LinkDataset.FieldDefs.Find(ListBox1.Items[i]);
140           if FieldDef = nil then
141             Continue;
142           NewField := FieldDef.CreateField(LinkDataset.Owner);
143           NewField.Name := CreateFieldName(LinkDataset.Owner, LinkDataset.Name +
144             FieldNameToPascalIdentifier(NewField.FieldName));
145           FDesigner.PropertyEditorHook.PersistentAdded(NewField, True);
146           fModified := True;
147         end;
148       end;
149       if fModified then FDesigner.Modified;
150     finally
151       if PreActive then
152         LinkDataset.Active:=True;
153     end;
154   finally
155     LinkDataset.EnableControls;
156   end;
157 end;
158 
159 procedure TFieldsListFrm.RefreshFieldsList;
160 
CheckFieldnull161   function CheckField(f: TFieldDef): boolean;
162   begin
163     Result := Assigned(f) and (LinkDataSet.FindField(f.Name) = nil);
164   end;
165 
FillListnull166   function FillList: integer;
167   var
168     i: integer;
169     f: TFieldDef;
170   begin
171     Result := 0;
172     with LinkDataset do
173     begin
174       for i := 0 to FieldDefs.Count - 1 do
175       begin
176         f := FieldDefs.Items[i];
177         if CheckField(f) then
178         begin
179           ListBox1.Items.Add(f.Name);
180           inc(Result);
181         end;
182       end;
183     end;
184   end;
185 
186 var
187   i: integer;
188   PreActive: boolean;
189 begin
190   i := 0;
191   ListBox1.Clear;
192   BitBtnOk.Enabled := False;
193   if not Assigned(LinkDataset) then Exit;
194   // refresh fielddefs
195   LinkDataset.FieldDefs.Update;
196   PreActive:=LinkDataset.Active;
197   LinkDataset.Active := False;
198   try
199     i := FillList;
200     BitBtnOk.Enabled := i > 0;
201   finally
202     if PreActive then
203       LinkDataset.Active:=True;
204   end;
205 end;
206 
207 procedure TFieldsListFrm.SelectAll;
208 begin
209   if BitBtnOk.Enabled then
210   begin
211     ListBox1.SelectAll;
212     ListBox1.MakeCurrentVisible;
213   end;
214 end;
215 
216 procedure TFieldsListFrm.DoShow;
217 begin
218   inherited DoShow;
219   SelectAll;
220 end;
221 
222 constructor TFieldsListFrm.Create(AOwner: TComponent; ADataset: TDataset;
223       ADesigner: TComponentEditorDesigner);
224 begin
225   inherited Create(AOwner);
226   LinkDataset := ADataset;
227   if not Assigned(LinkDataset) then
228     ShowMessage('LinkDataset = nil!')
229   else
230   begin
231     FDesigner := ADesigner;
232     Caption := fesFlTitle + ' - ' + LinkDataset.Name;
233   end;
234   RefreshFieldsList;
235 end;
236 
237 end.
238 
239