lazarus/ideintf/fieldseditor.pas

{ Copyright (C) 2005 Alexandru Alexandrov
  Date: 11.06.2005

 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, 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, 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

resourcestring
  rsTitle = 'Edit fields';

{ TDSFieldsEditorFrm }

procedure TDSFieldsEditorFrm.AddFieldsActnExecute(Sender: TObject);
var FieldsList: TFieldsListFrm;
begin
  FieldsList :=  TFieldsListFrm.Create(Self, LinkDataset, Designer);
  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 := rsTitle + ' - ' + 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;
    sActive: boolean;
    bModified: boolean;
    fld: TField;
begin
  sActive := 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 LinkDataset.Fields.Count > 0 then LinkDataSet.Active := sActive;
  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);
  inherited Destroy;
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;
begin
  if LinkDataset.Active 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;
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 := rsTitle + ' - ' + 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 := rsTitle;
  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;
end;


initialization
  {$I fieldseditor.lrs}
  RegisterComponentEditor(TDataset, TFieldsComponentEditor);

{$ELSE The FCL of FPC 2.0 does not support this}
implementation
{$ENDIF}
end.