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 / usr / share / lazarus / 1.6 / components / ideintf / collectionpropeditform.pas
Size: Mime:
unit CollectionPropEditForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, ComCtrls, StdCtrls, ActnList, LCLType;

type
  { TCollectionPropertyEditorForm }

  TCollectionPropertyEditorForm = class(TForm)
    actAdd: TAction;
    actDel: TAction;
    actMoveUp: TAction;
    actMoveDown: TAction;
    ActionList1: TActionList;
    CollectionListBox: TListBox;
    ToolBar1: TToolBar;
    AddButton: TToolButton;
    DeleteButton: TToolButton;
    DividerToolButton: TToolButton;
    MoveUpButton: TToolButton;
    MoveDownButton: TToolButton;
    procedure actAddExecute(Sender: TObject);
    procedure actDelExecute(Sender: TObject);
    procedure actMoveDownExecute(Sender: TObject);
    procedure actMoveUpExecute(Sender: TObject);
    procedure CollectionListBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FCollection: TCollection;
    FOwnerComponent: TPersistent;
    FOwnerPersistent: TPersistent;
    FPropertyName: String;
  protected
    procedure UpdateCaption;
    procedure UpdateButtons;
    procedure PersistentAdded({%H-}APersistent: TPersistent; {%H-}Select: boolean);
    procedure ComponentRenamed(AComponent: TComponent);
    procedure PersistentDeleting(APersistent: TPersistent);
    procedure RefreshPropertyValues;
  public
    procedure FillCollectionListBox;
    procedure SelectInObjectInspector(ForceUpdate, UnselectAll: Boolean);
    procedure SetCollection(NewCollection: TCollection;
                    NewOwnerPersistent: TPersistent; const NewPropName: String);
    procedure Modified;
  public
    property Collection: TCollection read FCollection;
    property OwnerComponent: TPersistent read FOwnerComponent;
    property OwnerPersistent: TPersistent read FOwnerPersistent;
    property PropertyName: String read FPropertyName;
  end;

implementation

{$R *.lfm}

uses
  Controls, Dialogs, LCLProc, IDEImagesIntf, ObjInspStrConsts, PropEdits,
  PropEditUtils;

type
  TPersistentAccess = class(TPersistent)

  end;

procedure TCollectionPropertyEditorForm.FormCreate(Sender: TObject);
begin
  ToolBar1.Images := IDEImages.Images_16;
  actAdd.Caption := oiColEditAdd;
  actDel.Caption := oiColEditDelete;
  actMoveUp.Caption := oiColEditUp;
  actMoveDown.Caption := oiColEditDown;
  actAdd.ImageIndex := IDEImages.LoadImage(16, 'laz_add');
  actDel.ImageIndex := IDEImages.LoadImage(16, 'laz_delete');
  actMoveUp.ImageIndex := IDEImages.LoadImage(16, 'arrow_up');
  actMoveDown.ImageIndex := IDEImages.LoadImage(16, 'arrow_down');
  actMoveUp.ShortCut := scCtrl or VK_UP;
  actMoveDown.ShortCut := scCtrl or VK_DOWN;

  actAdd.Hint := oiColEditAdd;
  actDel.Hint := oiColEditDelete;
  actMoveUp.Hint := oiColEditUp;
  actMoveDown.Hint := oiColEditDown;
end;

procedure TCollectionPropertyEditorForm.FormDestroy(Sender: TObject);
begin
  if GlobalDesignHook <> nil then
    GlobalDesignHook.RemoveAllHandlersForObject(Self);
end;

procedure TCollectionPropertyEditorForm.CollectionListBoxClick(Sender: TObject);
begin
  UpdateButtons;
  UpdateCaption;
  SelectInObjectInspector(False, False);
end;

procedure TCollectionPropertyEditorForm.actAddExecute(Sender: TObject);
begin
  if Collection = nil then Exit;
  Collection.Add;

  FillCollectionListBox;
  if CollectionListBox.Items.Count > 0 then
    CollectionListBox.ItemIndex := CollectionListBox.Items.Count - 1;
  SelectInObjectInspector(True, False);
  UpdateButtons;
  UpdateCaption;
  Modified;
end;

procedure TCollectionPropertyEditorForm.actDelExecute(Sender: TObject);
var
  I : Integer;
  NewItemIndex: Integer;
begin
  if Collection = nil then Exit;

  I := CollectionListBox.ItemIndex;
  if (I >= 0) and (I < Collection.Count) then
  begin
    if MessageDlg(oisConfirmDelete,
      Format(oisDeleteItem, [Collection.Items[I].DisplayName]),
      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      // select other item, or unselect
      NewItemIndex := I + 1;
      while (NewItemIndex < CollectionListBox.Items.Count)
      and (CollectionListBox.Selected[NewItemIndex]) do Inc(NewItemIndex);

      if NewItemIndex = CollectionListBox.Items.Count then
      begin
        NewItemIndex := 0;
        while (NewItemIndex < Pred(I))
        and not (CollectionListBox.Selected[NewItemIndex]) do Inc(NewItemIndex);

        if NewItemIndex = I then NewItemIndex := -1;
      end;

      CollectionListBox.ItemIndex := -1;

      if NewItemIndex > I then Dec(NewItemIndex);
      //debugln('TCollectionPropertyEditorForm.DeleteClick A NewItemIndex=',dbgs(NewItemIndex),' ItemIndex=',dbgs(CollectionListBox.ItemIndex),' CollectionListBox.Items.Count=',dbgs(CollectionListBox.Items.Count),' Collection.Count=',dbgs(Collection.Count));
      // unselect all items in OI (collections can act strange on delete)
      SelectInObjectInspector(True, True);
      // now delete
      Collection.Items[I].Free;
      // update listbox after whatever happened
      FillCollectionListBox;
      // set NewItemIndex
      if NewItemIndex < CollectionListBox.Items.Count then
      begin
        CollectionListBox.ItemIndex := NewItemIndex;
        SelectInObjectInspector(False, False);
      end;
      //debugln('TCollectionPropertyEditorForm.DeleteClick B');
      Modified;
    end;
  end;
  UpdateButtons;
  UpdateCaption;
end;

procedure TCollectionPropertyEditorForm.actMoveDownExecute(Sender: TObject);
var
  I: Integer;
begin
  if Collection = nil then Exit;

  I := CollectionListBox.ItemIndex;
  if I >= Collection.Count - 1 then Exit;

  Collection.Items[I].Index := I + 1;
  CollectionListBox.ItemIndex := I + 1;

  FillCollectionListBox;
  SelectInObjectInspector(True, False);
  Modified;
end;

procedure TCollectionPropertyEditorForm.actMoveUpExecute(Sender: TObject);
var
  I: Integer;
begin
  if Collection = nil then Exit;

  I := CollectionListBox.ItemIndex;
  if I < 0 then Exit;

  Collection.Items[I].Index := I - 1;
  CollectionListBox.ItemIndex := I - 1;

  FillCollectionListBox;
  SelectInObjectInspector(True, False);
  Modified;
end;

procedure TCollectionPropertyEditorForm.UpdateCaption;
var
  NewCaption: String;
begin
  //I think to match Delphi this should be formatted like
  //"Editing ComponentName.PropertyName[Index]"
  if OwnerPersistent is TComponent then
    NewCaption := TComponent(OwnerPersistent).Name
  else
    if OwnerPersistent <> nil then
      NewCaption := OwnerPersistent.GetNamePath
    else
      NewCaption := '';

  if NewCaption <> '' then NewCaption := NewCaption + '.';
  NewCaption := oiColEditEditing + ' ' + NewCaption + PropertyName;

  if CollectionListBox.ItemIndex > -1 then
    NewCaption := NewCaption + '[' + IntToStr(CollectionListBox.ItemIndex) + ']';
  Caption := NewCaption;
end;

procedure TCollectionPropertyEditorForm.UpdateButtons;
var
  I: Integer;
begin
  I := CollectionListBox.ItemIndex;
  actAdd.Enabled := Collection <> nil;
  actDel.Enabled := I > -1;
  actMoveUp.Enabled := I > 0;
  actMoveDown.Enabled := (I >= 0) and (I < CollectionListBox.Items.Count - 1);
end;

procedure TCollectionPropertyEditorForm.PersistentAdded(APersistent: TPersistent; Select: boolean);
begin
  //DebugLn('*** TCollectionPropertyEditorForm.PersistentAdded called ***');
  FillCollectionListBox;
end;

procedure TCollectionPropertyEditorForm.ComponentRenamed(AComponent: TComponent);
begin
  //DebugLn('*** TCollectionPropertyEditorForm.ComponentRenamed called ***');
  if AComponent = OwnerPersistent then
    UpdateCaption;
end;

procedure TCollectionPropertyEditorForm.PersistentDeleting(APersistent: TPersistent);
var
  AIndex, I: Integer;
begin
  if (APersistent = OwnerPersistent) or (APersistent = OwnerComponent) then
  begin
    SetCollection(nil, nil, '');
    Hide;
  end
  else
  if Assigned(Collection) and (APersistent is TCollectionItem) and
    (TCollectionItem(APersistent).Collection = Collection) then
  begin
    // persistent is still alive
    AIndex := CollectionListBox.ItemIndex;
    CollectionListBox.Items.BeginUpdate;
    CollectionListBox.Items.Delete(TCollectionItem(APersistent).Index);
    for I := TCollectionItem(APersistent).Index to CollectionListBox.Items.Count - 1 do
      CollectionListBox.Items[I] := IntToStr(I) + ' - ' + Collection.Items[I + 1].DisplayName;
    CollectionListBox.Items.EndUpdate;
    if AIndex < CollectionListBox.Items.Count then
      CollectionListBox.ItemIndex := AIndex
    else
      CollectionListBox.ItemIndex := CollectionListBox.Items.Count - 1;
  end;
  UpdateButtons;
  UpdateCaption;
  //DebugLn('*** TCollectionPropertyEditorForm.PersistentDeleting called ***');
end;

procedure TCollectionPropertyEditorForm.RefreshPropertyValues;
begin
  FillCollectionListBox;
  //DebugLn('*** TCollectionPropertyEditorForm.RefreshPropertyValues called ***');
end;

procedure TCollectionPropertyEditorForm.FillCollectionListBox;
var
  I: Integer;
  CurItem: String;
  Cnt: Integer;
begin
  CollectionListBox.Items.BeginUpdate;
  try
    if Collection <> nil then Cnt := Collection.Count
    else Cnt := 0;

    // add or replace list items
    for I := 0 to Cnt - 1 do
    begin
      CurItem := IntToStr(I) + ' - ' + Collection.Items[I].DisplayName;
      if I >= CollectionListBox.Items.Count then
        CollectionListBox.Items.Add(CurItem)
      else
        CollectionListBox.Items[I] := CurItem;
    end;

    // delete unneeded list items
    if Cnt > 0 then
    begin
      while CollectionListBox.Items.Count > Cnt do
      begin
        CollectionListBox.Items.Delete(CollectionListBox.Items.Count - 1);
      end;
    end
    else
    begin
      CollectionListBox.Items.Clear;
    end;
  finally
    CollectionListBox.Items.EndUpdate;
    UpdateButtons;
    UpdateCaption;
  end;
end;

procedure TCollectionPropertyEditorForm.SelectInObjectInspector(ForceUpdate, UnselectAll: Boolean);
var
  I: Integer;
  NewSelection: TPersistentSelectionList;
begin
  if Collection = nil then Exit;
  // select in OI
  NewSelection := TPersistentSelectionList.Create;
  NewSelection.ForceUpdate := ForceUpdate;
  try
    if not UnselectAll then
    begin
      for I := 0 to CollectionListBox.Items.Count - 1 do
        if CollectionListBox.Selected[I] then
          NewSelection.Add(Collection.Items[I]);
    end;
    if GlobalDesignHook <> nil then
    begin
      GlobalDesignHook.SetSelection(NewSelection);
      GlobalDesignHook.LookupRoot := GetLookupRootForComponent(OwnerPersistent);
    end;
  finally
    NewSelection.Free;
  end;
end;

procedure TCollectionPropertyEditorForm.SetCollection(NewCollection: TCollection;
  NewOwnerPersistent: TPersistent; const NewPropName: String);
begin
  if (FCollection = NewCollection) and (FOwnerPersistent = NewOwnerPersistent)
    and (FPropertyName = NewPropName) then Exit;

  FCollection := NewCollection;
  FOwnerPersistent := NewOwnerPersistent;
  FPropertyName := NewPropName;
  //find the component that owns the collection
  FOwnerComponent := NewOwnerPersistent;
  while FOwnerComponent <> nil do
  begin
    if FOwnerComponent is TComponent then
      break;
    FOwnerComponent := TPersistentAccess(FOwnerComponent).GetOwner;
  end;
  //debugln('TCollectionPropertyEditorForm.SetCollection A Collection=',dbgsName(FCollection),' OwnerPersistent=',dbgsName(OwnerPersistent),' PropName=',PropertyName);
  if GlobalDesignHook <> nil then
  begin
    GlobalDesignHook.RemoveAllHandlersForObject(Self);
    if FOwnerPersistent <> nil then
    begin
      GlobalDesignHook.AddHandlerPersistentAdded(@PersistentAdded);
      GlobalDesignHook.AddHandlerComponentRenamed(@ComponentRenamed);
      GlobalDesignHook.AddHandlerPersistentDeleting(@PersistentDeleting);
      GlobalDesignHook.AddHandlerRefreshPropertyValues(@RefreshPropertyValues);
    end;
  end;

  FillCollectionListBox;
  UpdateCaption;
end;

procedure TCollectionPropertyEditorForm.Modified;
begin
  //debugln(['TCollectionPropertyEditorForm.Modified FOwnerPersistent=',DbgSName(FOwnerPersistent),' FCollection=',DbgSName(FCollection),' GlobalDesignHook.LookupRoot=',DbgSName(GlobalDesignHook.LookupRoot)]);
  if GlobalDesignHook <> nil then
    GlobalDesignHook.Modified(Self);
end;

end.