Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
lazarus-project / usr / share / lazarus / 2.0.10 / components / ideintf / fieldseditor.pas
Size: Mime:
{ Copyright (C) 2005 Alexandru Alexandrov
  Date: 11.06.2005

 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

 Modified Date: 20.10.2010
 By: Marcelo Borges de Paula
}
unit fieldseditor;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, types, db,
  // LCL
  LCLType, Forms, Controls, Menus, Dialogs, ComCtrls, ActnList, StdCtrls,
  // IdeIntf
  ObjInspStrConsts, ComponentEditors, PropEdits, PropEditUtils,
  NewField, FieldsList, IDEImagesIntf, IDEWindowIntf;

type

  TFieldsComponentEditor = class;

  { TDSFieldsEditorFrm }

  TDSFieldsEditorFrm = class(TForm)
    Fields: TImageList;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    tbCommands: TToolBar;
    tbAddFld: TToolButton;
    tbUnselect: TToolButton;
    tbDeleteFld: TToolButton;
    tbNewFld: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    tbMoveUp: TToolButton;
    tbMoveDown: TToolButton;
    ToolButton8: TToolButton;
    tbSelect: TToolButton;
    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 ActionList1Update({%H-}AAction: TBasicAction; var {%H-}Handled: Boolean);
    procedure AddFieldsActnExecute(Sender: TObject);
    procedure DeleteFieldsActnExecute(Sender: TObject);
    procedure FieldsEditorFrmClose(Sender: TObject;
      var CloseAction: TCloseAction);
    procedure FieldsEditorFrmDestroy(Sender: TObject);
    procedure FieldsListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
      ARect: TRect; {%H-}State: TOwnerDrawState);
    procedure FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    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
    procedure DoSelected(All: boolean);
    procedure SelectionChanged(AOrderChanged: Boolean = false);
    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
    LinkDataset: TDataset;
    FDesigner: TComponentEditorDesigner;
    FComponentEditor: TFieldsComponentEditor;
    FUpdateSelectionCount: Integer;
    procedure BeginUpdateSelection;
    procedure EndUpdateSelection;
    procedure ExchangeItems(const fFirst, fSecond: integer);
    procedure RefreshFieldsListBox(SelectAllNew: boolean);
    function FindChild(ACandidate: TPersistent; out AIndex: Integer): Boolean;
  public
    constructor Create(AOwner: TComponent; ADataset: TDataset;
      ADesigner: TComponentEditorDesigner); reintroduce;
    destructor Destroy; override;
    property Designer: TComponentEditorDesigner read FDesigner write FDesigner;
    property ComponentEditor: TFieldsComponentEditor write FComponentEditor;
  end;

  { TActionListComponentEditor }

  TFieldsComponentEditor = class(TComponentEditor)
  public
    function GetVerbCount: Integer; override;
    function GetVerb(Index: Integer): string; override;
    procedure ExecuteVerb(Index: Integer); override;
  end;

implementation

{$R *.lfm}

{ TDSFieldsEditorFrm }

constructor TDSFieldsEditorFrm.Create(AOwner: TComponent; ADataset: TDataset;
    ADesigner: TComponentEditorDesigner);
begin
  inherited Create(AOwner);

  tbCommands.Images := IDEImages.Images_16;
  tbAddFld.ImageIndex := IDEImages.LoadImage('laz_add');
  tbDeleteFld.ImageIndex := IDEImages.LoadImage('laz_delete');
  tbNewFld.ImageIndex := IDEImages.LoadImage('menu_new');
  tbMoveDown.ImageIndex := IDEImages.LoadImage('arrow_down');
  tbMoveUp.ImageIndex := IDEImages.LoadImage('arrow_up');
  tbSelect.ImageIndex := IDEImages.LoadImage('menu_select_all');
  tbUnselect.ImageIndex := IDEImages.LoadImage('menu_close_all');

  LinkDataset := ADataset;
  FDesigner := ADesigner;
  Caption := fesFeTitle + ' - ' + LinkDataset.Name;
  AddFieldsActn.Caption := oisAddFields;
  AddFieldsActn.Hint := oisAddFieldsFromFieldDefs;
  DeleteFieldsActn.Caption:=oisDeleteComponents;
  DeleteFieldsActn.Hint:=oisDeleteSelectedFieldS;
  NewActn.Caption:=oisNew;
  NewActn.Hint:=oisCreateNewFieldAndAddItAtCurrentPosition;
  MoveUpActn.Caption:=oisMoveUp;
  MoveUpActn.Hint:=oisMoveUpHint;
  MoveDownActn.Caption:=oisMoveDown;
  MoveDownActn.Hint:=oisMoveDownHint;
  SelectAllActn.Caption:=oisSelectAll;
  SelectAllActn.Hint:=oisSelectAllHint;
  UnselectAllActn.Caption:=oisUnselectAll;
  UnselectAllActn.Hint:=oisUnselectAllHint;

  FieldsListBox.Clear;
  RefreshFieldsListBox(False);

  if Assigned(GlobalDesignHook) then
  begin
    GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
    GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
    GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
    GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
    GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
  end;

  SelectionChanged;
end;

destructor TDSFieldsEditorFrm.Destroy;
begin
  UnregisterEditorForm(Self);
  inherited Destroy;
end;

procedure TDSFieldsEditorFrm.FormCreate(Sender: TObject);
begin
  IDEDialogLayoutList.ApplyLayout(Self);
end;

procedure TDSFieldsEditorFrm.FieldsEditorFrmClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  IDEDialogLayoutList.SaveLayout(Self);
  CloseAction := caFree;
end;

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;

procedure TDSFieldsEditorFrm.DeleteFieldsActnExecute(Sender: TObject);
var
  PreActive: boolean;
begin
  PreActive := LinkDataSet.Active;
  LinkDataSet.Active := False;
  if FieldsListBox.SelCount = 0 then
    exit;
  BeginUpdateSelection;
  FDesigner.DeleteSelection;
  EndUpdateSelection;
  if PreActive then
    LinkDataSet.Active := True;
end;

procedure TDSFieldsEditorFrm.FieldsEditorFrmDestroy(Sender: TObject);
begin
  if GlobalDesignHook = Nil then
    Exit;
  if Assigned(FComponentEditor) and Assigned(LinkDataset)
  and not (csDestroying in LinkDataset.ComponentState)
  and (FieldsListBox.SelCount > 0) then
    GlobalDesignHook.SelectOnlyThis(LinkDataset);
  GlobalDesignHook.RemoveAllHandlersForObject(Self);
end;

procedure TDSFieldsEditorFrm.FieldsListBoxDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  fld: TField;
begin
  if Index < 0 then Exit;
  if not Assigned(FieldsListBox.Items.Objects[Index]) then Exit;
  //
  FieldsListBox.Canvas.FillRect(ARect);
  fld := TField(FieldsListBox.Items.Objects[Index]);
  //
  if pfinKey in fld.ProviderFlags then
    Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,0)
  else
    case fld.FieldKind of
      fkData         : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,1);
      fkCalculated   : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,2);
      fkLookup       : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,3);
      fkInternalCalc : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,4);
    end;
  //
  FieldsListBox.Canvas.TextRect(ARect, ARect.Left + 20,ARect.Top,
                                FieldsListBox.Items[Index]);
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
  FieldsListBox.ClearSelection;
  //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;

function TDSFieldsEditorFrm.FindChild(ACandidate: TPersistent; out
  AIndex: Integer): Boolean;
begin
  if ACandidate is TField then
    AIndex := FieldsListBox.Items.IndexOfObject(ACandidate)
  else
    AIndex := -1;
  Result := AIndex >= 0;
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(True);
  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(True);
  if bModified then fDesigner.Modified;
end;

procedure TDSFieldsEditorFrm.ActionList1Update(AAction: TBasicAction;
  var Handled: Boolean);
var
  b: boolean;
  i, SelectedCount: integer;
begin
  b := FieldsListBox.Count > 0;
  SelectedCount := 0;
  for i:= 0 to FieldsListBox.Count-1 do
    if FieldsListBox.Selected[i] then
      Inc(SelectedCount);

  DeleteFieldsActn.Enabled := b and (SelectedCount > 0);
  MoveDownActn.Enabled := b and (SelectedCount > 0)
    and (Not FieldsListBox.Selected[FieldsListBox.Items.Count - 1]);
  MoveUpActn.Enabled := b and (SelectedCount > 0)
    and (Not FieldsListBox.Selected[0]);
  SelectAllActn.Enabled := b and (FieldsListBox.Count <> SelectedCount);
  UnselectAllActn.Enabled := b and (SelectedCount > 0);
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(AOrderChanged: Boolean = false);
var SelList: TPersistentSelectionList;
begin
  if (FUpdateSelectionCount>0) or (GlobalDesignHook=nil) then
    exit;
  GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
  try
    SelList := TPersistentSelectionList.Create;
    SelList.ForceUpdate := AOrderChanged;
    try
      OnGetSelection(SelList);
      FDesigner.PropertyEditorHook.SetSelection(SelList) ;
    finally
      SelList.Free;
    end;
  finally
    GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
  end;
  ActionList1.UpdateAction(nil);
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 FindChild(APersistent, i) then
    FieldsListBox.Items.Delete(i);
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
    FieldsListBox.ClearSelection;
    //select from list
    for i := 0 to ASelection.Count - 1 do
      if FindChild(ASelection.Items[i], j) then
        FieldsListBox.Selected[j] := true;
  end;
end;

procedure TDSFieldsEditorFrm.OnPersistentAdded(APersistent: TPersistent;
  Select: boolean);
var fld: TField;
begin
  if Assigned(APersistent) And
     (APersistent is TField) And
     ((APersistent as TField).DataSet = LinkDataset) then begin
       fld := APersistent as TField;
       with FieldsListBox do
         Selected[Items.AddObject(fld.FieldName, fld)] := Select;
  end;
end;

procedure TDSFieldsEditorFrm.BeginUpdateSelection;
begin
  Inc(FUpdateSelectionCount);
end;

procedure TDSFieldsEditorFrm.EndUpdateSelection;
begin
  dec(FUpdateSelectionCount);
  if FUpdateSelectionCount=0 then
    SelectionChanged;
end;

{ TFieldsComponentEditor }

function TFieldsComponentEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

function TFieldsComponentEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := fesFeTitle;
    else Result := '';
  end;
end;

procedure TFieldsComponentEditor.ExecuteVerb(Index: Integer);
var
  ADataset: TDataset;
  AEditor: TObject;
begin
  case index of
    0:
      begin
        ADataset := GetComponent as TDataset;
        if ADataset=nil then
           raise Exception.Create('TFieldsComponentEditor.Edit LinkDataset=nil');

        AEditor := FindEditorForm(ADataset);
        if AEditor=nil then begin
          AEditor := TDSFieldsEditorFrm.Create(Application, ADataset, Designer);
          RegisterEditorForm(AEditor, ADataset);
        end;

        if AEditor<>nil then
          with TDsFieldsEditorFrm(AEditor) do begin
            ComponentEditor := Self;
            ShowOnTop;
          end;
      end;
  end;
end;

initialization
  RegisterComponentEditor(TDataset, TFieldsComponentEditor);
end.