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