/ideintf/fieldseditor.pas
http://github.com/graemeg/lazarus · Pascal · 461 lines · 381 code · 46 blank · 34 comment · 40 complexity · 391575a2fda2b25a51be6c385ff0a940 MD5 · raw file
- { Copyright (C) 2005 Alexandru Alexandrov
- Date: 11.06.2005
- *****************************************************************************
- * *
- * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
- * for details about the copyright. *
- * *
- * This program is distributed in the hope that it will be useful, *
- * but WITHOUT ANY WARRANTY; without even the implied warranty of *
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
- * *
- *****************************************************************************
- }
- unit fieldseditor;
- {$mode objfpc}{$H+}
- interface
- {$IFNDEF VER2_0}
- uses
- Classes, SysUtils, LResources, TypInfo, LCLProc, Forms,
- Controls, Menus, Graphics, Dialogs, ComCtrls,
- db, ActnList, StdCtrls, ObjInspStrConsts, ComponentEditors,
- PropEdits, LCLType, NewField, FieldsList, ComponentReg;
- type
- TFieldsComponentEditor = class;
- { TDSFieldsEditorFrm }
- TDSFieldsEditorFrm = class(TForm)
- MenuItem6: TMenuItem;
- MenuItem7: TMenuItem;
- UnselectAllActn: TAction;
- SelectAllActn: TAction;
- FieldsListBox: TListBox;
- MoveDownActn: TAction;
- MoveUpActn: TAction;
- NewActn: TAction;
- DeleteFieldsActn: TAction;
- AddFieldsActn: TAction;
- ActionList1: TActionList;
- MenuItem1: TMenuItem;
- MenuItem2: TMenuItem;
- MenuItem3: TMenuItem;
- MenuItem4: TMenuItem;
- MenuItem5: TMenuItem;
- PopupMenu1: TPopupMenu;
- procedure AddFieldsActnExecute(Sender: TObject);
- procedure DeleteFieldsActnExecute(Sender: TObject);
- procedure FieldsEditorFrmClose(Sender: TObject;
- var CloseAction: TCloseAction);
- procedure FieldsEditorFrmDestroy(Sender: TObject);
- procedure FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure NewActnExecute(Sender: TObject);
- procedure ListBox1Click(Sender: TObject);
- procedure MoveDownActnExecute(Sender: TObject);
- procedure MoveUpActnExecute(Sender: TObject);
- procedure SelectAllActnExecute(Sender: TObject);
- procedure UnselectAllActnExecute(Sender: TObject);
- protected
- { protected declarations }
- procedure DoSelected(All: boolean);
- procedure SelectionChanged;
- procedure OnComponentRenamed(AComponent: TComponent);
- procedure OnPersistentDeleting(APersistent: TPersistent);
- procedure OnGetSelection(const ASelection: TPersistentSelectionList);
- procedure OnSetSelection(const ASelection: TPersistentSelectionList);
- procedure OnPersistentAdded(APersistent: TPersistent; Select: boolean);
- private
- { private declarations }
- LinkDataset: TDataset;
- FDesigner: TComponentEditorDesigner;
- FComponentEditor: TFieldsComponentEditor;
- procedure ExchangeItems(const fFirst, fSecond: integer);
- procedure RefreshFieldsListBox(SelectAllNew: boolean);
- public
- { public declarations }
- constructor Create(AOwner: TComponent; ADataset: TDataset;
- ADesigner: TComponentEditorDesigner); reintroduce;
- property Designer: TComponentEditorDesigner read FDesigner write FDesigner;
- property ComponentEditor: TFieldsComponentEditor write FComponentEditor;
- end;
- { TActionListComponentEditor }
- TFieldsComponentEditor = class(TComponentEditor)
- private
- FDataSet: TDataset;
- FFieldsEditorForm: TDSFieldsEditorFrm;
- fWindowClosed: Boolean;
- protected
- public
- constructor Create(AComponent: TComponent;
- ADesigner: TComponentEditorDesigner); override;
- destructor Destroy; override;
- function GetVerbCount: Integer; override;
- function GetVerb(Index: Integer): string; override;
- procedure ExecuteVerb(Index: Integer); override;
- procedure EditorWindowClose;
- property LinkDataset: TDataset read FDataSet write FDataSet;
- end;
- implementation
- { TDSFieldsEditorFrm }
- procedure TDSFieldsEditorFrm.AddFieldsActnExecute(Sender: TObject);
- var FieldsList: TFieldsListFrm;
- begin
- try
- FieldsList := TFieldsListFrm.Create(Self, LinkDataset, Designer);
- except
- on E:Exception do begin
- ShowMessage(fesNoFields+^M+fesCheckDSet+^M^M+E.Message);
- exit;
- end;
- end;
- try
- FieldsList.ShowModal;
- finally
- FieldsList.Free;
- end;
- SelectionChanged;
- end;
- constructor TDSFieldsEditorFrm.Create(AOwner: TComponent; ADataset: TDataset;
- ADesigner: TComponentEditorDesigner);
- begin
- inherited Create(AOwner);
- LinkDataset := ADataset;
- FDesigner := ADesigner;
- Caption := fesFeTitle + ' - ' + LinkDataset.Name;
- FieldsListBox.Clear;
- RefreshFieldsListBox(False);
- GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
- GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
- GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
- GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
- GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
- SelectionChanged;
- end;
- procedure TDSFieldsEditorFrm.DeleteFieldsActnExecute(Sender: TObject);
- var i: integer;
- PreActive: boolean;
- bModified: boolean;
- fld: TField;
- begin
- PreActive := LinkDataSet.Active;
- LinkDataSet.Active := False;
- bModified := False;
- for i := FieldsListBox.Items.Count - 1 downto 0 do
- if FieldsListBox.Selected[i] then begin
- fld := TField(FieldsListBox.Items.Objects[i]);
- FieldsListBox.Items.Delete(i);
- FDesigner.PropertyEditorHook.PersistentDeleting(fld);
- fld.Free;
- bModified := True;
- end;
- if bModified then
- fDesigner.Modified;
- if PreActive then
- LinkDataSet.Active := True;
- SelectionChanged;
- end;
- procedure TDSFieldsEditorFrm.FieldsEditorFrmClose(Sender: TObject;
- var CloseAction: TCloseAction);
- begin
- CloseAction := caFree;
- end;
- procedure TDSFieldsEditorFrm.FieldsEditorFrmDestroy(Sender: TObject);
- begin
- if Assigned(FComponentEditor) then begin
- if Assigned(LinkDataset) And (Not (csDestroying in LinkDataset.ComponentState)) And (FieldsListBox.SelCount > 0) then
- GlobalDesignHook.SelectOnlyThis(LinkDataset);
- FComponentEditor.EditorWindowClose;
- end;
- if Assigned(GlobalDesignHook) then
- GlobalDesignHook.RemoveAllHandlersForObject(Self);
- end;
- procedure TDSFieldsEditorFrm.FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if ssCtrl in Shift then
- case Key of
- VK_UP: begin
- MoveUpActn.Execute;
- Key := 0;
- end;
- VK_DOWN: begin
- MoveDownActn.Execute;
- Key := 0;
- end;
- end;
- end;
- procedure TDSFieldsEditorFrm.ExchangeItems(const fFirst, fSecond: integer);
- var SelFirst,
- SelSecond: boolean;
- begin
- with FieldsListBox do begin
- // save selected
- SelFirst := Selected[fFirst];
- SelSecond := Selected[fSecond];
- // exchange items
- FieldsListBox.Items.Exchange(fFirst,fSecond);
- // restore selected
- Selected[fFirst] := SelSecond;
- Selected[fSecond] := SelFirst;
- TField(Items.Objects[fFirst]).Index := fFirst;
- end;
- end;
- procedure TDSFieldsEditorFrm.RefreshFieldsListBox(SelectAllNew: boolean);
- var i, j: integer;
- fld: TField;
- PreActive: boolean;
- begin
- PreActive := LinkDataSet.Active;
- if PreActive And LinkDataset.DefaultFields then
- LinkDataset.Close;
- //Deselect & refresh all existing
- DoSelected(False);
- //Add new fields
- for i := 0 to LinkDataset.Fields.Count - 1 do begin
- fld := LinkDataset.Fields[i];
- if FieldsListBox.Items.IndexOfObject(fld) < 0 then begin
- j := FieldsListBox.Items.AddObject(fld.FieldName, fld);
- FieldsListBox.Selected[j] := SelectAllNew;
- end;
- end;
- if PreActive and not LinkDataset.Active then
- LinkDataset.Active:=true;
- end;
- procedure TDSFieldsEditorFrm.NewActnExecute(Sender: TObject);
- var nf: TNewFieldFrm;
- begin
- nf := TNewFieldFrm.Create(Self, LinkDataset, Designer);
- try
- nf.ShowModal;
- finally
- nf.Free;
- end;
- SelectionChanged;
- end;
- procedure TDSFieldsEditorFrm.ListBox1Click(Sender: TObject);
- begin
- SelectionChanged;
- end;
- procedure TDSFieldsEditorFrm.MoveDownActnExecute(Sender: TObject);
- var i: integer;
- bModified: boolean;
- begin
- if FieldsListBox.Selected[FieldsListBox.Items.Count - 1] then exit;
- bModified := False;
- for i := FieldsListBox.Items.Count - 2 downto 0 do
- if FieldsListBox.Selected[i] then begin
- ExchangeItems(i, i + 1);
- bModified := True;
- end;
- SelectionChanged;
- if bModified then fDesigner.Modified;
- end;
- procedure TDSFieldsEditorFrm.MoveUpActnExecute(Sender: TObject);
- var i: integer;
- bModified: boolean;
- begin
- if FieldsListBox.Selected[0] then exit;
- bModified := False;
- for i := 1 to FieldsListBox.Items.Count - 1 do
- if FieldsListBox.Selected[i] then begin
- ExchangeItems(i - 1, i);
- bModified := True;
- end;
- SelectionChanged;
- if bModified then fDesigner.Modified;
- end;
- procedure TDSFieldsEditorFrm.SelectAllActnExecute(Sender: TObject);
- begin
- DoSelected(True);
- SelectionChanged;
- end;
- procedure TDSFieldsEditorFrm.UnselectAllActnExecute(Sender: TObject);
- begin
- DoSelected(False);
- SelectionChanged;
- end;
- procedure TDSFieldsEditorFrm.DoSelected(All: boolean);
- var i: integer;
- begin
- for i := 0 to FieldsListBox.Items.Count - 1 do begin
- FieldsListBox.Items[i] := (FieldsListBox.Items.Objects[i] as TField).FieldName;
- FieldsListBox.Selected[i] := All;
- end;
- end;
- procedure TDSFieldsEditorFrm.SelectionChanged;
- var SelList: TPersistentSelectionList;
- begin
- GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
- try
- SelList := TPersistentSelectionList.Create;
- try
- OnGetSelection(SelList);
- FDesigner.PropertyEditorHook.SetSelection(SelList) ;
- finally
- SelList.Free;
- end;
- finally
- GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
- end;
- end;
- procedure TDSFieldsEditorFrm.OnComponentRenamed(AComponent: TComponent);
- var Field: TField;
- i: integer;
- begin
- if AComponent is TField then begin
- Field := TField(AComponent);
- if not Assigned( Field ) then Exit;
- i := FieldsListBox.Items.IndexOfObject(Field);
- if i >= 0 then
- FieldsListBox.Items[i] := Field.FieldName;
- end else
- if AComponent is TDataset And (AComponent = LinkDataset) then
- Caption := fesFeTitle + ' - ' + LinkDataset.Name;
- end;
- procedure TDSFieldsEditorFrm.OnPersistentDeleting(APersistent: TPersistent);
- var i: integer;
- begin
- if APersistent = LinkDataset then begin
- // removing all fields here ?
- end else begin
- i := FieldsListBox.Items.IndexOfObject(APersistent as TObject);
- if i >= 0 then FieldsListBox.Items.Delete( i );
- end;
- end;
- procedure TDSFieldsEditorFrm.OnGetSelection(
- const ASelection: TPersistentSelectionList);
- var i: integer;
- begin
- if Not Assigned(ASelection) then exit;
- if ASelection.Count > 0 then ASelection.Clear;
- for i := 0 to FieldsListBox.Items.Count - 1 do
- if FieldsListBox.Selected[i] then
- ASelection.Add(TPersistent(FieldsListBox.Items.Objects[i]));
- end;
- procedure TDSFieldsEditorFrm.OnSetSelection(
- const ASelection: TPersistentSelectionList);
- var i, j: integer;
- begin
- if Assigned(ASelection) then begin
- //Unselect all
- DoSelected(False);
- //select from list
- for i := 0 to ASelection.Count - 1 do
- if ASelection.Items[i] is TField then begin
- j := FieldsListBox.Items.IndexOfObject(ASelection.Items[i]);
- if j >= 0 then FieldsListBox.Selected[j] := True;
- end;
- end;
- end;
- procedure TDSFieldsEditorFrm.OnPersistentAdded(APersistent: TPersistent;
- Select: boolean);
- var i: integer;
- begin
- if Assigned(APersistent) And
- (APersistent is TField) And
- ((APersistent as TField).DataSet = LinkDataset) then begin
- i := FieldsListBox.Items.AddObject( TField(APersistent).FieldName, APersistent );
- FieldsListBox.Selected[i] := Select;
- TField(APersistent).Index := i;
- end;
- end;
- { TFieldsComponentEditor }
- constructor TFieldsComponentEditor.Create(AComponent: TComponent;
- ADesigner: TComponentEditorDesigner);
- begin
- inherited Create(AComponent, ADesigner);
- fWindowClosed := True;
- end;
- destructor TFieldsComponentEditor.Destroy;
- begin
- if not fWindowClosed
- then FreeThenNil(FFieldsEditorForm);
- inherited Destroy;
- end;
- function TFieldsComponentEditor.GetVerbCount: Integer;
- begin
- Result := 1;
- end;
- function TFieldsComponentEditor.GetVerb(Index: Integer): string;
- begin
- case Index of
- 0: Result := fesFeTitle;
- end;
- end;
- procedure TFieldsComponentEditor.ExecuteVerb(Index: Integer);
- var ADataset: TDataset;
- begin
- case index of
- 0: begin
- ADataset := GetComponent as TDataset;
- if ADataset = nil
- then raise Exception.Create('TFieldsComponentEditor.Edit LinkDataset=nil');
- if fWindowClosed then begin
- FFieldsEditorForm := TDSFieldsEditorFrm.Create(Application, ADataset, Designer);
- fWindowClosed := False;
- end;
- with FFieldsEditorForm do begin
- ComponentEditor := Self;
- ShowOnTop;
- end;
- end;
- end;
- end;
- procedure TFieldsComponentEditor.EditorWindowClose;
- begin
- fWindowClosed := True;
- FFieldsEditorForm:=nil;
- end;
- initialization
- {$I fieldseditor.lrs}
- RegisterComponentEditor(TDataset, TFieldsComponentEditor);
- {$ELSE The FCL of FPC 2.0 does not support this}
- implementation
- {$ENDIF}
- end.