1 unit DBGridColumnsPropEditForm;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, typinfo, db,
9 // LCL
10 Controls, Dialogs, LCLProc, Forms, ComCtrls, StdCtrls, ActnList, LCLType, DBGrids,
11 // IdeIntf
12 IDEImagesIntf, ObjInspStrConsts, PropEdits, PropEditUtils;
13
14 type
15 { TDBGridColumnsPropertyEditorForm }
16
17 TDBGridColumnsPropertyEditorForm = class(TForm)
18 actAdd: TAction;
19 actDel: TAction;
20 actAddFields: TAction;
21 actDeleteAll: TAction;
22 actFetchLabels: TAction;
23 actMoveUp: TAction;
24 actMoveDown: TAction;
25 ActionList1: TActionList;
26 CollectionListBox: TListBox;
27 DividerToolButton1: TToolButton;
28 DividerToolButton2: TToolButton;
29 DividerToolButton3: TToolButton;
30 ToolBar1: TToolBar;
31 AddButton: TToolButton;
32 DeleteButton: TToolButton;
33 DividerToolButton: TToolButton;
34 MoveUpButton: TToolButton;
35 MoveDownButton: TToolButton;
36 btAddFlds: TToolButton;
37 ToolButton1: TToolButton;
38 ToolButton2: TToolButton;
39 procedure actAddExecute(Sender: TObject);
40 procedure actAddFieldsExecute(Sender: TObject);
41 procedure actDeleteAllExecute(Sender: TObject);
42 procedure actDelExecute(Sender: TObject);
43 procedure actFetchLabelsExecute(Sender: TObject);
44 procedure actMoveDownExecute(Sender: TObject);
45 procedure actMoveUpExecute(Sender: TObject);
46 procedure CollectionListBoxClick(Sender: TObject);
47 procedure FormCreate(Sender: TObject);
48 procedure FormDestroy(Sender: TObject);
49 private
50 FCollection: TCollection;
51 FOwnerComponent: TPersistent;
52 FOwnerPersistent: TPersistent;
53 FPropertyName: String;
54 procedure FillCollectionListBox;
GetDataSetnull55 function GetDataSet: TDataSet;
56 procedure SelectInObjectInspector(ForceUpdate: Boolean);
57 procedure UnSelectInObjectInspector(ForceUpdate: Boolean);
58 procedure UpdDesignHook(aSelection: TPersistentSelectionList);
59 protected
60 procedure UpdateCaption;
61 procedure UpdateButtons;
62 procedure PersistentAdded({%H-}APersistent: TPersistent; {%H-}Select: boolean);
63 procedure ComponentRenamed(AComponent: TComponent);
64 procedure PersistentDeleting(APersistent: TPersistent);
65 procedure RefreshPropertyValues;
66 public
67 procedure SetCollection(NewCollection: TCollection;
68 NewOwnerPersistent: TPersistent; const NewPropName: String);
69 procedure Modified;
70 end;
71
72 implementation
73
74 {$R *.lfm}
75
76 type
77 TPersistentAccess = class(TPersistent);
78
79 procedure TDBGridColumnsPropertyEditorForm.FormCreate(Sender: TObject);
80 begin
81 ToolBar1.Images := IDEImages.Images_16;
82 actAdd.Caption := oiColEditAdd;
83 actAddFields.Caption := dceAddFields;
84 actAddFields.ImageIndex := IDEImages.LoadImage('laz_add');
85 actFetchLabels.Caption := dceFetchLabels;
86 actFetchLabels.ImageIndex := IDEImages.LoadImage('laz_add');
87 actDel.Caption := oiColEditDelete;
88 actMoveUp.Caption := oiColEditUp;
89 actMoveDown.Caption := oiColEditDown;
90 actAdd.ImageIndex := IDEImages.LoadImage('laz_add');
91 actDel.ImageIndex := IDEImages.LoadImage('laz_delete');
92 actDeleteAll.Caption := dceDeleteAll;
93 actDeleteAll.ImageIndex := IDEImages.LoadImage('laz_delete');
94 actMoveUp.ImageIndex := IDEImages.LoadImage('arrow_up');
95 actMoveDown.ImageIndex := IDEImages.LoadImage('arrow_down');
96 actMoveUp.ShortCut := scCtrl or VK_UP;
97 actMoveDown.ShortCut := scCtrl or VK_DOWN;
98
99 actAdd.Hint := oiColEditAdd;
100 actDel.Hint := oiColEditDelete;
101 actMoveUp.Hint := oiColEditUp;
102 actMoveDown.Hint := oiColEditDown;
103 end;
104
105 procedure TDBGridColumnsPropertyEditorForm.FormDestroy(Sender: TObject);
106 begin
107 if GlobalDesignHook <> nil then
108 GlobalDesignHook.RemoveAllHandlersForObject(Self);
109 end;
110
111 procedure TDBGridColumnsPropertyEditorForm.CollectionListBoxClick(Sender: TObject);
112 begin
113 // Do not use OnSelectionChange because it fires on changing ItemIndex by code
114 // (OnClick does not)
115 UpdateButtons;
116 UpdateCaption;
117 SelectInObjectInspector(False);
118 end;
119
120 procedure TDBGridColumnsPropertyEditorForm.actAddExecute(Sender: TObject);
121 begin
122 if FCollection = nil then Exit;
123 FCollection.Add;
124
125 FillCollectionListBox;
126 if CollectionListBox.Items.Count > 0 then
127 CollectionListBox.ItemIndex := CollectionListBox.Items.Count - 1;
128 SelectInObjectInspector(True);
129 UpdateButtons;
130 UpdateCaption;
131 Modified;
132 end;
133
134 procedure TDBGridColumnsPropertyEditorForm.actAddFieldsExecute(Sender: TObject);
135 var
136 DataSet: TDataSet;
137 Item: TColumn;
138 i: Integer;
139 begin
140 if FCollection=nil then Exit;
141 if not (FCollection is TDBGridColumns) then Exit;
142 DataSet:=GetDataSet;
143 if DataSet=nil then Exit;
144
145 if FCollection.Count>0 then
146 if (MessageDlg(dceColumnEditor, dceOkToDelete, mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
147 Exit;
148
149 try
150 FCollection.Clear;
151 for i:=0 to DataSet.Fields.Count-1 do
152 begin
153 Item:=FCollection.Add as TColumn;
154 Item.Field:=DataSet.Fields[i];
155 Item.Title.Caption:=DataSet.Fields[i].DisplayLabel;
156 end;
157 finally
158 RefreshPropertyValues;
159 UpdateButtons;
160 UpdateCaption;
161 Modified;
162 end;
163 end;
164
165 procedure TDBGridColumnsPropertyEditorForm.actDeleteAllExecute(Sender: TObject);
166 begin
167 if FCollection = nil then
168 Exit;
169 if (MessageDlg(dceColumnEditor, dceOkToDelete, mtConfirmation,
170 [mbYes, mbNo], 0) = mrYes) then
171 try
172 UnSelectInObjectInspector(True);
173 FCollection.Clear;
174 finally
175 RefreshPropertyValues;
176 UpdateButtons;
177 UpdateCaption;
178 Modified;
179 end;
180 end;
181
182 procedure TDBGridColumnsPropertyEditorForm.actDelExecute(Sender: TObject);
183 var
184 I : Integer;
185 begin
186 if FCollection = nil then Exit;
187 I := CollectionListBox.ItemIndex;
188 if (I < 0) or (I >= FCollection.Count) then Exit;
189 if MessageDlg(oisConfirmDelete,
190 Format(oisDeleteItem, [FCollection.Items[I].DisplayName]),
191 mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
192 Exit;
193
194 CollectionListBox.ItemIndex := -1;
195 // unselect all items in OI (collections can act strange on delete)
196 UnSelectInObjectInspector(True);
197 // now delete
198 FCollection.Items[I].Free;
199 // update listbox after whatever happened
200 FillCollectionListBox;
201 // set new ItemIndex
202 if I >= CollectionListBox.Items.Count then
203 I := CollectionListBox.Items.Count-1;
204 if I >= 0 then
205 begin
206 CollectionListBox.ItemIndex := I;
207 SelectInObjectInspector(False);
208 end;
209 Modified;
210 UpdateButtons;
211 UpdateCaption;
212 end;
213
214 procedure TDBGridColumnsPropertyEditorForm.actFetchLabelsExecute(Sender: TObject);
215 var
216 Column: TColumn;
217 DataSet: TDataSet;
218 Field: TField;
219 i: Integer;
220 begin
221 DataSet:=GetDataSet;
222 if DataSet=nil then Exit;
223
224 if MessageDlg(dceColumnEditor, dceWillReplaceContinue, mtConfirmation,
225 [mbYes, mbNo], 0)<>mrYes then Exit;
226
227 for i:=0 to FCollection.Count-1 do
228 begin
229 Column:=FCollection.Items[i] as TColumn;
230 Field:= DataSet.FindField(Column.FieldName);
231 if Field<>nil then
232 Column.Title.Caption:=Field.DisplayLabel;
233 end;
234 end;
235
236 procedure TDBGridColumnsPropertyEditorForm.actMoveDownExecute(Sender: TObject);
237 var
238 I: Integer;
239 begin
240 if FCollection = nil then Exit;
241
242 I := CollectionListBox.ItemIndex;
243 if I >= FCollection.Count - 1 then Exit;
244
245 FCollection.Items[I].Index := I + 1;
246 CollectionListBox.ItemIndex := I + 1;
247
248 FillCollectionListBox;
249 SelectInObjectInspector(True);
250 Modified;
251 end;
252
253 procedure TDBGridColumnsPropertyEditorForm.actMoveUpExecute(Sender: TObject);
254 var
255 I: Integer;
256 begin
257 if FCollection = nil then Exit;
258
259 I := CollectionListBox.ItemIndex;
260 if I < 0 then Exit;
261
262 FCollection.Items[I].Index := I - 1;
263 CollectionListBox.ItemIndex := I - 1;
264
265 FillCollectionListBox;
266 SelectInObjectInspector(True);
267 Modified;
268 end;
269
270 procedure TDBGridColumnsPropertyEditorForm.UpdateCaption;
271 var
272 NewCaption: String;
273 begin
274 //I think to match Delphi this should be formatted like
275 //"Editing ComponentName.PropertyName[Index]"
276 if FOwnerPersistent is TComponent then
277 NewCaption := TComponent(FOwnerPersistent).Name
278 else
279 if FOwnerPersistent <> nil then
280 NewCaption := FOwnerPersistent.GetNamePath
281 else
282 NewCaption := '';
283
284 if NewCaption <> '' then NewCaption := NewCaption + '.';
285 NewCaption := oiColEditEditing + ' ' + NewCaption + FPropertyName;
286
287 if CollectionListBox.ItemIndex > -1 then
288 NewCaption := NewCaption + '[' + IntToStr(CollectionListBox.ItemIndex) + ']';
289 Caption := NewCaption;
290 end;
291
292 procedure TDBGridColumnsPropertyEditorForm.UpdateButtons;
293 var
294 I: Integer;
295 begin
296 I := CollectionListBox.ItemIndex;
297 actAdd.Enabled := FCollection <> nil;
298 actFetchLabels.Enabled:=actAdd.Enabled and (CollectionListBox.Items.Count > 0);
299 actDel.Enabled := I > -1;
300 actMoveUp.Enabled := I > 0;
301 actMoveDown.Enabled := (I >= 0) and (I < CollectionListBox.Items.Count - 1);
302 DividerToolButton1.Visible := (FCollection is TDBGridColumns);
303 btAddFlds.Visible := DividerToolButton1.Visible;
304 actAddFields.Enabled := DividerToolButton1.Visible;
305 end;
306
307 procedure TDBGridColumnsPropertyEditorForm.PersistentAdded(APersistent: TPersistent; Select: boolean);
308 begin
309 //DebugLn('*** TDBGridColumnsPropertyEditorForm.PersistentAdded called ***');
310 FillCollectionListBox;
311 end;
312
313 procedure TDBGridColumnsPropertyEditorForm.ComponentRenamed(AComponent: TComponent);
314 begin
315 //DebugLn('*** TDBGridColumnsPropertyEditorForm.ComponentRenamed called ***');
316 if AComponent = FOwnerPersistent then
317 UpdateCaption;
318 end;
319
320 procedure TDBGridColumnsPropertyEditorForm.PersistentDeleting(APersistent: TPersistent);
321 begin
322 // For some reason this is called only when the whole collection is deleted,
323 // for example when changing to another project. Thus clear the whole collection.
324 DebugLn(['TDBGridColumnsPropertyEditorForm.PersistentDeleting: APersistent=', APersistent,
325 ', FOwnerPersistent=', FOwnerPersistent, ', FOwnerComponent=', FOwnerComponent]);
326 SetCollection(nil, nil, '');
327 Hide;
328 UpdateButtons;
329 UpdateCaption;
330 end;
331
332 procedure TDBGridColumnsPropertyEditorForm.RefreshPropertyValues;
333 begin
334 FillCollectionListBox;
335 //DebugLn('*** TDBGridColumnsPropertyEditorForm.RefreshPropertyValues called ***');
336 end;
337
338 procedure TDBGridColumnsPropertyEditorForm.FillCollectionListBox;
339 var
340 ItemIndex: Integer;
341 i: Integer;
342 begin
343 CollectionListBox.Items.BeginUpdate;
344 try
345 ItemIndex:=CollectionListBox.ItemIndex;
346 CollectionListBox.Clear;
347 if FCollection<>nil then
348 for i:=0 to FCollection.Count-1 do
349 CollectionListBox.Items.Add(Format('%d - %s', [i, FCollection.Items[i].DisplayName]));
350 if ItemIndex<CollectionListBox.Count then
351 CollectionListBox.ItemIndex:=ItemIndex // OnClick not fires
352 else
353 CollectionListBox.ItemIndex:=-1;
354 finally
355 CollectionListBox.Items.EndUpdate;
356 UpdateButtons;
357 UpdateCaption;
358 end;
359 end;
360
GetDataSetnull361 function TDBGridColumnsPropertyEditorForm.GetDataSet: TDataSet;
362 begin
363 if (FOwnerPersistent as TCustomDBGrid).DataSource=nil then Exit(nil);
364 Result:=TCustomDBGrid(FOwnerPersistent).DataSource.DataSet;
365 end;
366
367 procedure TDBGridColumnsPropertyEditorForm.SelectInObjectInspector(ForceUpdate: Boolean);
368 var
369 I: Integer;
370 NewSelection: TPersistentSelectionList;
371 begin
372 Assert(Assigned(FCollection), 'SelectInObjectInspector: FCollection=Nil.');
373 // select in OI
374 NewSelection := TPersistentSelectionList.Create;
375 NewSelection.ForceUpdate := ForceUpdate;
376 try
377 for I := 0 to CollectionListBox.Items.Count - 1 do
378 if CollectionListBox.Selected[I] then
379 NewSelection.Add(FCollection.Items[I]);
380 UpdDesignHook(NewSelection);
381 finally
382 NewSelection.Free;
383 end;
384 end;
385
386 procedure TDBGridColumnsPropertyEditorForm.UnSelectInObjectInspector(ForceUpdate: Boolean);
387 var
388 EmptySelection: TPersistentSelectionList;
389 begin
390 EmptySelection := TPersistentSelectionList.Create;
391 EmptySelection.ForceUpdate := ForceUpdate;
392 try
393 UpdDesignHook(EmptySelection);
394 finally
395 EmptySelection.Free;
396 end;
397 end;
398
399 procedure TDBGridColumnsPropertyEditorForm.UpdDesignHook(aSelection: TPersistentSelectionList);
400 begin
401 if GlobalDesignHook = nil then Exit;
402 GlobalDesignHook.SetSelection(aSelection);
403 GlobalDesignHook.LookupRoot := GetLookupRootForComponent(FOwnerPersistent);
404 end;
405
406 procedure TDBGridColumnsPropertyEditorForm.SetCollection(NewCollection: TCollection;
407 NewOwnerPersistent: TPersistent; const NewPropName: String);
408 begin
409 if (FCollection = NewCollection) and (FOwnerPersistent = NewOwnerPersistent)
410 and (FPropertyName = NewPropName) then Exit;
411
412 FCollection := NewCollection;
413 FOwnerPersistent := NewOwnerPersistent;
414 FPropertyName := NewPropName;
415 //find the component that owns the collection
416 FOwnerComponent := NewOwnerPersistent;
417 while FOwnerComponent <> nil do
418 begin
419 if FOwnerComponent is TComponent then
420 break;
421 FOwnerComponent := TPersistentAccess(FOwnerComponent).GetOwner;
422 end;
423 //debugln('TDBGridColumnsPropertyEditorForm.SetCollection A Collection=',dbgsName(FCollection),' OwnerPersistent=',dbgsName(FOwnerPersistent),' PropName=',FPropertyName);
424 if GlobalDesignHook <> nil then
425 begin
426 GlobalDesignHook.RemoveAllHandlersForObject(Self);
427 if FOwnerPersistent <> nil then
428 begin
429 GlobalDesignHook.AddHandlerPersistentAdded(@PersistentAdded);
430 GlobalDesignHook.AddHandlerComponentRenamed(@ComponentRenamed);
431 GlobalDesignHook.AddHandlerPersistentDeleting(@PersistentDeleting);
432 GlobalDesignHook.AddHandlerRefreshPropertyValues(@RefreshPropertyValues);
433 end;
434 end;
435
436 FillCollectionListBox;
437 UpdateCaption;
438 end;
439
440 procedure TDBGridColumnsPropertyEditorForm.Modified;
441 begin
442 if GlobalDesignHook <> nil then
443 GlobalDesignHook.Modified(Self);
444 end;
445
446 end.
447
448