PageRenderTime 31ms CodeModel.GetById 13ms app.highlight 8ms RepoModel.GetById 1ms app.codeStats 1ms

/ideintf/fieldseditor.pas

http://github.com/graemeg/lazarus
Pascal | 461 lines | 381 code | 46 blank | 34 comment | 40 complexity | 391575a2fda2b25a51be6c385ff0a940 MD5 | raw file
  1{ Copyright (C) 2005 Alexandru Alexandrov
  2  Date: 11.06.2005
  3
  4 *****************************************************************************
  5 *                                                                           *
  6 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
  7 *  for details about the copyright.                                         *
  8 *                                                                           *
  9 *  This program is distributed in the hope that it will be useful,          *
 10 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 11 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 12 *                                                                           *
 13 *****************************************************************************
 14}
 15unit fieldseditor;
 16
 17{$mode objfpc}{$H+}
 18
 19interface
 20
 21{$IFNDEF VER2_0}
 22uses
 23  Classes, SysUtils, LResources, TypInfo, LCLProc, Forms,
 24  Controls, Menus, Graphics, Dialogs, ComCtrls,
 25  db, ActnList, StdCtrls, ObjInspStrConsts, ComponentEditors,
 26  PropEdits, LCLType, NewField, FieldsList, ComponentReg;
 27
 28type
 29
 30  TFieldsComponentEditor = class;
 31
 32  { TDSFieldsEditorFrm }
 33
 34  TDSFieldsEditorFrm = class(TForm)
 35    MenuItem6: TMenuItem;
 36    MenuItem7: TMenuItem;
 37    UnselectAllActn: TAction;
 38    SelectAllActn: TAction;
 39    FieldsListBox: TListBox;
 40    MoveDownActn: TAction;
 41    MoveUpActn: TAction;
 42    NewActn: TAction;
 43    DeleteFieldsActn: TAction;
 44    AddFieldsActn: TAction;
 45    ActionList1: TActionList;
 46    MenuItem1: TMenuItem;
 47    MenuItem2: TMenuItem;
 48    MenuItem3: TMenuItem;
 49    MenuItem4: TMenuItem;
 50    MenuItem5: TMenuItem;
 51    PopupMenu1: TPopupMenu;
 52    procedure AddFieldsActnExecute(Sender: TObject);
 53    procedure DeleteFieldsActnExecute(Sender: TObject);
 54    procedure FieldsEditorFrmClose(Sender: TObject;
 55      var CloseAction: TCloseAction);
 56    procedure FieldsEditorFrmDestroy(Sender: TObject);
 57    procedure FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
 58      Shift: TShiftState);
 59    procedure NewActnExecute(Sender: TObject);
 60    procedure ListBox1Click(Sender: TObject);
 61    procedure MoveDownActnExecute(Sender: TObject);
 62    procedure MoveUpActnExecute(Sender: TObject);
 63    procedure SelectAllActnExecute(Sender: TObject);
 64    procedure UnselectAllActnExecute(Sender: TObject);
 65  protected
 66    { protected declarations }
 67    procedure DoSelected(All: boolean);
 68    procedure SelectionChanged;
 69    procedure OnComponentRenamed(AComponent: TComponent);
 70    procedure OnPersistentDeleting(APersistent: TPersistent);
 71    procedure OnGetSelection(const ASelection: TPersistentSelectionList);
 72    procedure OnSetSelection(const ASelection: TPersistentSelectionList);
 73    procedure OnPersistentAdded(APersistent: TPersistent; Select: boolean);
 74  private
 75    { private declarations }
 76    LinkDataset: TDataset;
 77    FDesigner: TComponentEditorDesigner;
 78    FComponentEditor: TFieldsComponentEditor;
 79    procedure ExchangeItems(const fFirst, fSecond: integer);
 80    procedure RefreshFieldsListBox(SelectAllNew: boolean);
 81  public
 82    { public declarations }
 83    constructor Create(AOwner: TComponent; ADataset: TDataset;
 84      ADesigner: TComponentEditorDesigner); reintroduce;
 85    property Designer: TComponentEditorDesigner read FDesigner write FDesigner;
 86    property ComponentEditor: TFieldsComponentEditor write FComponentEditor;
 87  end;
 88
 89  { TActionListComponentEditor }
 90
 91  TFieldsComponentEditor = class(TComponentEditor)
 92  private
 93    FDataSet: TDataset;
 94    FFieldsEditorForm: TDSFieldsEditorFrm;
 95    fWindowClosed: Boolean;
 96  protected
 97  public
 98    constructor Create(AComponent: TComponent;
 99                       ADesigner: TComponentEditorDesigner); override;
100    destructor Destroy; override;
101    function GetVerbCount: Integer; override;
102    function GetVerb(Index: Integer): string; override;
103    procedure ExecuteVerb(Index: Integer); override;
104    procedure EditorWindowClose;
105    property LinkDataset: TDataset read FDataSet write FDataSet;
106  end;
107
108implementation
109
110{ TDSFieldsEditorFrm }
111
112procedure TDSFieldsEditorFrm.AddFieldsActnExecute(Sender: TObject);
113var FieldsList: TFieldsListFrm;
114begin
115  try
116    FieldsList :=  TFieldsListFrm.Create(Self, LinkDataset, Designer);
117  except
118    on E:Exception do begin
119      ShowMessage(fesNoFields+^M+fesCheckDSet+^M^M+E.Message);
120      exit;
121    end;
122  end;
123  try
124    FieldsList.ShowModal;
125  finally
126    FieldsList.Free;
127  end;
128  SelectionChanged;
129end;
130
131constructor TDSFieldsEditorFrm.Create(AOwner: TComponent; ADataset: TDataset;
132    ADesigner: TComponentEditorDesigner);
133begin
134  inherited Create(AOwner);
135
136  LinkDataset := ADataset;
137  FDesigner := ADesigner;
138  Caption := fesFeTitle + ' - ' + LinkDataset.Name;
139  FieldsListBox.Clear;
140  RefreshFieldsListBox(False);
141
142  GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
143  GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
144  GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
145  GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
146  GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
147
148  SelectionChanged;
149end;
150
151procedure TDSFieldsEditorFrm.DeleteFieldsActnExecute(Sender: TObject);
152var i: integer;
153    PreActive: boolean;
154    bModified: boolean;
155    fld: TField;
156begin
157  PreActive := LinkDataSet.Active;
158  LinkDataSet.Active := False;
159  bModified := False;
160  for i := FieldsListBox.Items.Count - 1 downto 0 do
161    if FieldsListBox.Selected[i] then begin
162      fld := TField(FieldsListBox.Items.Objects[i]);
163      FieldsListBox.Items.Delete(i);
164      FDesigner.PropertyEditorHook.PersistentDeleting(fld);
165      fld.Free;
166      bModified := True;
167    end;
168  if bModified then
169    fDesigner.Modified;
170  if PreActive then
171    LinkDataSet.Active := True;
172  SelectionChanged;
173end;
174
175procedure TDSFieldsEditorFrm.FieldsEditorFrmClose(Sender: TObject;
176  var CloseAction: TCloseAction);
177begin
178  CloseAction := caFree;
179end;
180
181procedure TDSFieldsEditorFrm.FieldsEditorFrmDestroy(Sender: TObject);
182begin
183  if Assigned(FComponentEditor) then begin
184    if Assigned(LinkDataset) And (Not (csDestroying in LinkDataset.ComponentState)) And (FieldsListBox.SelCount > 0) then
185         GlobalDesignHook.SelectOnlyThis(LinkDataset);
186    FComponentEditor.EditorWindowClose;
187  end;
188  if Assigned(GlobalDesignHook) then
189    GlobalDesignHook.RemoveAllHandlersForObject(Self);
190end;
191
192procedure TDSFieldsEditorFrm.FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
193  Shift: TShiftState);
194begin
195  if ssCtrl in Shift then
196    case Key of
197      VK_UP: begin
198        MoveUpActn.Execute;
199        Key := 0;
200      end;
201      VK_DOWN: begin
202        MoveDownActn.Execute;
203        Key := 0;
204      end;
205    end;
206end;
207
208procedure TDSFieldsEditorFrm.ExchangeItems(const fFirst, fSecond: integer);
209var SelFirst,
210    SelSecond: boolean;
211begin
212  with FieldsListBox do begin
213//  save selected
214    SelFirst := Selected[fFirst];
215    SelSecond := Selected[fSecond];
216//  exchange items
217    FieldsListBox.Items.Exchange(fFirst,fSecond);
218//  restore selected
219    Selected[fFirst] := SelSecond;
220    Selected[fSecond] := SelFirst;
221
222    TField(Items.Objects[fFirst]).Index := fFirst;
223  end;
224end;
225
226procedure TDSFieldsEditorFrm.RefreshFieldsListBox(SelectAllNew: boolean);
227var i, j: integer;
228    fld: TField;
229    PreActive: boolean;
230begin
231  PreActive := LinkDataSet.Active;
232  if PreActive And LinkDataset.DefaultFields then
233    LinkDataset.Close;
234  //Deselect & refresh all existing
235  DoSelected(False);
236  //Add new fields
237  for i := 0 to LinkDataset.Fields.Count - 1 do begin
238    fld := LinkDataset.Fields[i];
239    if FieldsListBox.Items.IndexOfObject(fld) < 0 then begin
240      j := FieldsListBox.Items.AddObject(fld.FieldName, fld);
241      FieldsListBox.Selected[j] := SelectAllNew;
242    end;
243  end;
244  if PreActive and not LinkDataset.Active then
245    LinkDataset.Active:=true;
246end;
247
248procedure TDSFieldsEditorFrm.NewActnExecute(Sender: TObject);
249var nf: TNewFieldFrm;
250begin
251  nf := TNewFieldFrm.Create(Self, LinkDataset, Designer);
252  try
253    nf.ShowModal;
254  finally
255    nf.Free;
256  end;
257  SelectionChanged;
258end;
259
260procedure TDSFieldsEditorFrm.ListBox1Click(Sender: TObject);
261begin
262  SelectionChanged;
263end;
264
265procedure TDSFieldsEditorFrm.MoveDownActnExecute(Sender: TObject);
266var i: integer;
267    bModified: boolean;
268begin
269  if FieldsListBox.Selected[FieldsListBox.Items.Count - 1] then exit;
270  bModified := False;
271  for i := FieldsListBox.Items.Count - 2 downto 0 do
272    if FieldsListBox.Selected[i] then begin
273      ExchangeItems(i, i + 1);
274      bModified := True;
275    end;
276  SelectionChanged;
277  if bModified then fDesigner.Modified;
278end;
279
280procedure TDSFieldsEditorFrm.MoveUpActnExecute(Sender: TObject);
281var i: integer;
282    bModified: boolean;
283begin
284  if FieldsListBox.Selected[0] then exit;
285  bModified := False;
286  for i := 1 to FieldsListBox.Items.Count - 1 do
287    if FieldsListBox.Selected[i] then begin
288      ExchangeItems(i - 1, i);
289      bModified := True;
290    end;
291  SelectionChanged;
292  if bModified then fDesigner.Modified;
293end;
294
295procedure TDSFieldsEditorFrm.SelectAllActnExecute(Sender: TObject);
296begin
297  DoSelected(True);
298  SelectionChanged;
299end;
300
301procedure TDSFieldsEditorFrm.UnselectAllActnExecute(Sender: TObject);
302begin
303  DoSelected(False);
304  SelectionChanged;
305end;
306
307procedure TDSFieldsEditorFrm.DoSelected(All: boolean);
308var i: integer;
309begin
310  for i := 0 to FieldsListBox.Items.Count - 1 do begin
311    FieldsListBox.Items[i] := (FieldsListBox.Items.Objects[i] as TField).FieldName;
312    FieldsListBox.Selected[i] := All;
313  end;
314end;
315
316procedure TDSFieldsEditorFrm.SelectionChanged;
317var SelList: TPersistentSelectionList;
318begin
319  GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
320  try
321    SelList := TPersistentSelectionList.Create;
322    try
323      OnGetSelection(SelList);
324      FDesigner.PropertyEditorHook.SetSelection(SelList) ;
325    finally
326      SelList.Free;
327    end;
328  finally
329    GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
330  end;
331end;
332
333procedure TDSFieldsEditorFrm.OnComponentRenamed(AComponent: TComponent);
334var Field: TField;
335    i: integer;
336begin
337  if AComponent is TField then begin
338    Field := TField(AComponent);
339    if not Assigned( Field ) then Exit;
340    i := FieldsListBox.Items.IndexOfObject(Field);
341    if i >= 0 then
342      FieldsListBox.Items[i] := Field.FieldName;
343  end else
344  if AComponent is TDataset And (AComponent = LinkDataset) then
345    Caption := fesFeTitle + ' - ' + LinkDataset.Name;
346end;
347
348procedure TDSFieldsEditorFrm.OnPersistentDeleting(APersistent: TPersistent);
349var i: integer;
350begin
351  if APersistent = LinkDataset then begin
352//    removing all fields here ?
353  end else begin
354    i := FieldsListBox.Items.IndexOfObject(APersistent as TObject);
355    if i >= 0 then FieldsListBox.Items.Delete( i );
356  end;
357end;
358
359procedure TDSFieldsEditorFrm.OnGetSelection(
360  const ASelection: TPersistentSelectionList);
361var i: integer;
362begin
363  if Not Assigned(ASelection) then exit;
364  if ASelection.Count > 0 then ASelection.Clear;
365  for i := 0 to FieldsListBox.Items.Count - 1 do
366    if FieldsListBox.Selected[i] then
367      ASelection.Add(TPersistent(FieldsListBox.Items.Objects[i]));
368end;
369
370procedure TDSFieldsEditorFrm.OnSetSelection(
371  const ASelection: TPersistentSelectionList);
372var i, j: integer;
373begin
374  if Assigned(ASelection) then begin
375    //Unselect all
376    DoSelected(False);
377    //select from list
378    for i := 0 to ASelection.Count - 1 do
379      if ASelection.Items[i] is TField then begin
380        j := FieldsListBox.Items.IndexOfObject(ASelection.Items[i]);
381        if j >= 0 then FieldsListBox.Selected[j] := True;
382      end;
383  end;
384end;
385
386procedure TDSFieldsEditorFrm.OnPersistentAdded(APersistent: TPersistent;
387  Select: boolean);
388var i: integer;
389begin
390  if Assigned(APersistent) And
391     (APersistent is TField) And
392     ((APersistent as TField).DataSet = LinkDataset) then begin
393    i := FieldsListBox.Items.AddObject( TField(APersistent).FieldName, APersistent );
394    FieldsListBox.Selected[i] := Select;
395    TField(APersistent).Index := i;
396  end;
397end;
398
399{ TFieldsComponentEditor }
400
401constructor TFieldsComponentEditor.Create(AComponent: TComponent;
402  ADesigner: TComponentEditorDesigner);
403begin
404  inherited Create(AComponent, ADesigner);
405  fWindowClosed := True;
406end;
407
408destructor TFieldsComponentEditor.Destroy;
409begin
410  if not fWindowClosed
411    then FreeThenNil(FFieldsEditorForm);
412  inherited Destroy;
413end;
414
415function TFieldsComponentEditor.GetVerbCount: Integer;
416begin
417  Result := 1;
418end;
419
420function TFieldsComponentEditor.GetVerb(Index: Integer): string;
421begin
422  case Index of
423    0: Result := fesFeTitle;
424  end;
425end;
426
427procedure TFieldsComponentEditor.ExecuteVerb(Index: Integer);
428var ADataset: TDataset;
429begin
430  case index of
431    0: begin
432      ADataset := GetComponent as TDataset;
433      if ADataset = nil
434      then raise Exception.Create('TFieldsComponentEditor.Edit LinkDataset=nil');
435      if fWindowClosed then begin
436        FFieldsEditorForm := TDSFieldsEditorFrm.Create(Application, ADataset, Designer);
437        fWindowClosed := False;
438      end;
439      with FFieldsEditorForm do begin
440        ComponentEditor := Self;
441        ShowOnTop;
442      end;
443    end;
444  end;
445end;
446
447procedure TFieldsComponentEditor.EditorWindowClose;
448begin
449  fWindowClosed := True;
450  FFieldsEditorForm:=nil;
451end;
452
453
454initialization
455  {$I fieldseditor.lrs}
456  RegisterComponentEditor(TDataset, TFieldsComponentEditor);
457
458{$ELSE The FCL of FPC 2.0 does not support this}
459implementation
460{$ENDIF}
461end.