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