QBasic & Borland Pascal & C/Delphi5.iso/Runimage/Delphi50/Source/Property Editors/COLNEDIT.PAS

Pascal/Delphi Source File | 1999-08-11 | 21.9 KB | 814 lines

{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{       TCollection Property Editor Dialog              }
{                                                       }
{       Copyright (c) 1999 Borland International        }
{                                                       }
{*******************************************************}

unit ColnEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  DsgnWnds, StdCtrls, Menus, ExtCtrls, DsgnIntf, ComCtrls, ImgList, ActnList,
  ToolWin, ToolWnds;

const
  AM_DeferUpdate = WM_USER + 100;  // avoids break-before-make listview ugliness

type

  TColOption = (coAdd, coDelete, coMove);
  TColOptions = set of TColOption;

  TCollectionEditor = class(TToolbarDesignWindow)
    Panel3: TPanel;
    ListView1: TListView;
    ImageList1: TImageList;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    AddCmd: TAction;
    DeleteCmd: TAction;
    MoveUpCmd: TAction;
    MoveDownCmd: TAction;
    SelectAllCmd: TAction;
    N2: TMenuItem;
    procedure AddClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure ListView1Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MoveUpClick(Sender: TObject);
    procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure MoveDownClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure SelectAll1Click(Sender: TObject);
    procedure SelectAllCommandUpdate(Sender: TObject);
    procedure SelectionUpdate(Sender: TObject);
    procedure ListView1KeyPress(Sender: TObject; var Key: Char);
  private
    FCollectionPropertyName: string;
    FStateLock: Integer;
    FItemIDList: TList;
    FCollectionClassName: string;
    FSelectionError: Boolean;
    FColOptions: TColOptions;
    function GetRegKey: string;
    procedure SetCollectionPropertyName(const Value: string);
    procedure AMDeferUpdate(var Msg); message AM_DeferUpdate;
    procedure SetColOptions(Value: TColOptions);
  protected
    procedure Activated; override;
    function  CanAdd(Index: Integer): Boolean; virtual;
    procedure LockState;
    procedure UnlockState;
    property StateLock: Integer read FStateLock;
    procedure SelectAll(DoUpdate: Boolean = True);
    procedure SelectNone(DoUpdate: Boolean = True);
  public
    Collection: TCollection;
    Component: TComponent;
    property Options: TColOptions read FColOptions write SetColOptions;
    procedure ComponentDeleted(Component: IPersistent); override;
    procedure FormClosed(AForm: TCustomForm); override;
    procedure FormModified; override;
    function GetItemName(Index, ItemIndex: Integer): string;
    procedure GetSelection;
    procedure SelectionChanged(ASelection: TDesignerSelectionList); override;
    procedure SetSelection;
    procedure UpdateListbox;
    property CollectionPropertyName: string read FCollectionPropertyName
      write SetCollectionPropertyName;
  end;

  TCollectionEditorClass = class of TCollectionEditor;

  TCollectionProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetEditorClass: TCollectionEditorClass; virtual;
    function GetColOptions: TColOptions; virtual;
  end;

procedure ShowCollectionEditor(ADesigner: IDesigner; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string);
function ShowCollectionEditorClass(ADesigner: IDesigner;
  CollectionEditorClass: TCollectionEditorClass; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string;
  ColOptions: TColOptions = [coAdd, coDelete, coMove]): TCollectionEditor;

implementation

{$R *.DFM}

uses LibIntf, Registry, TypInfo, DesignConst;

type
  TAccessCollection = class(TCollection); // used for protected method access
  TPersistentCracker = class(TPersistent);

var
  CollectionEditorsList: TList = nil;

function ShowCollectionEditorClass(ADesigner: IDesigner;
  CollectionEditorClass: TCollectionEditorClass; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string;
  ColOptions: TColOptions): TCollectionEditor;
var
  I: Integer;
begin
  if CollectionEditorsList = nil then
    CollectionEditorsList := TList.Create;
  for I := 0 to CollectionEditorsList.Count-1 do
  begin
    Result := TCollectionEditor(CollectionEditorsList[I]);
    with Result do
      if (Designer = ADesigner) and (Component = AComponent)
        and (Collection = ACollection)
        and (CompareText(CollectionPropertyName, PropertyName) = 0) then
      begin
        Show;
        BringToFront;
        Exit;
      end;
  end;
  Result := CollectionEditorClass.Create(Application);
  with Result do
  try
    Options := ColOptions;
    Designer := ADesigner as IFormDesigner;
    Collection := ACollection;
    FCollectionClassName := ACollection.ClassName;
    Component := AComponent;
    CollectionPropertyName := PropertyName;
    UpdateListbox;
    Show;
  except
    Free;
  end;
end;

procedure ShowCollectionEditor(ADesigner: IDesigner; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string);
begin
  ShowCollectionEditorClass(ADesigner, TCollectionEditor, AComponent,
    ACollection, PropertyName);
end;

{ TCollectionProperty }

procedure TCollectionProperty.Edit;
var
  Obj: TPersistent;
begin
  Obj := GetComponent(0);
  while (Obj <> nil) and not (Obj is TComponent) do
    Obj := TPersistentCracker(Obj).GetOwner;
  ShowCollectionEditorClass(Designer, GetEditorClass,
    TComponent(Obj), TCollection(GetOrdValue), GetName, GetColOptions);
end;

function TCollectionProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TCollectionProperty.GetEditorClass: TCollectionEditorClass;
begin
  Result := TCollectionEditor;
end;

function TCollectionProperty.GetColOptions: TColOptions;
begin
  Result := [coAdd, coDelete, coMove];
end;

{ TCollectionEditor }

procedure TCollectionEditor.Activated;
var
  Msg: TMessage;
begin
  Msg.Msg := WM_ACTIVATE;
  Msg.WParam := 1;
  Designer.IsDesignMsg(Designer.Form, Msg);
  SetSelection;
end;

procedure TCollectionEditor.SetColOptions(Value: TColOptions);
begin
  FColOptions := Value;
  AddCmd.Enabled := coAdd in Value;
end;

procedure TCollectionEditor.ComponentDeleted(Component: IPersistent);

  function IsOwnedBy(Owner, Child: TPersistent): Boolean;
  begin
    Result := False;
    if Owner = nil then Exit;
    while (Child <> nil) and (Child <> Owner) and not (Child is TComponent) do
      Child := TPersistentCracker(Child).GetOwner;
    Result := Child = Owner;
  end;

var
  Temp: TPersistent;
begin
  Temp := TryExtractPersistent(Component);
  if Temp = nil then Exit;
  if (Self.Component = nil) or (csDestroying in Self.Component.ComponentState) or
    (Temp = Self.Component) or IsOwnedBy(Temp, Collection) then
  begin
    Collection := nil;  // Component is already in its destructor; collection is gone
    Self.Component := nil;
    Close;
  end
  else if IsOwnedBy(Collection, Temp) then
    PostMessage(Handle, AM_DeferUpdate, 1, 0);
end;

procedure TCollectionEditor.FormClosed(AForm: TCustomForm);
begin
  if Designer.Form = AForm then
  begin
    Collection := nil;
    Component := nil;
    Close;
  end;
end;

procedure TCollectionEditor.FormModified;
begin
  if Collection <> nil then
  begin
    UpdateListbox;
    if CompLib.GetActiveForm.Designer <> Designer then Exit;
    GetSelection;
  end;
end;

function TCollectionEditor.GetItemName(Index, ItemIndex: Integer): string;
begin
  with TAccessCollection(Collection) do
    if GetAttrCount < 1 then
      Result := Format('%d - %s',[ItemIndex, Collection.Items[ItemIndex].DisplayName])
    else Result := GetItemAttr(Index, ItemIndex);
end;

function TCollectionEditor.GetRegKey: string;
begin
  Result := DelphiIDE.GetBaseRegKey + '\' + sIniEditorsName + '\Collection Editor';
end;

procedure TCollectionEditor.GetSelection;
var
  I: Integer;
  Item: TCollectionItem;
  List: TDesignerSelectionList;
begin
  LockState;
  try
    ListView1.Selected := nil;
  finally
    UnlockState;
  end;

  List := TDesignerSelectionList.Create;
  try
    Designer.GetSelections(List);
    if (List.Count = 0) or (List.Count > Collection.Count) then Exit;
    if not ((List[0] = Component) or (List[0] = Collection)
      or (TCollectionEditor(List[0]).GetOwner = Collection)) then Exit;

    if List.Count > ListView1.Items.Count then UpdateListbox;
  finally
    List.Free;
  end;

  LockState;
  try
    for I := FItemIDList.Count - 1 downto 0 do
    begin
      Item := Collection.FindItemID(Integer(FItemIDList[I]));
      if Item <> nil then
        ListView1.Items[Item.Index].Selected := True
      else FItemIDList.Delete(I);
    end;
  finally
    UnlockState;
  end;
end;

procedure TCollectionEditor.LockState;
begin
  Inc(FStateLock);
end;

procedure TCollectionEditor.SelectionChanged(ASelection: TDesignerSelectionList);
begin
end;

procedure TCollectionEditor.SetCollectionPropertyName(const Value: string);
begin
  if Value <> FCollectionPropertyName then
  begin
    FCollectionPropertyName := Value;
    Caption := Format(sColEditCaption, [Component.Name, DotSep, Value]);
  end;
end;

procedure TCollectionEditor.SetSelection;
var
  I: Integer;
  List: TDesignerSelectionList;
begin
  if FSelectionError then Exit;
  try
    if ListView1.SelCount > 0 then
    begin
      List := TDesignerSelectionList.Create;
      try
        FItemIDList.Clear;
        for I := 0 to ListView1.Items.Count - 1 do
          if ListView1.Items[I].Selected then
          begin
            List.Add(Collection.Items[I]);
            FItemIDList.Add(Pointer(Collection.Items[I].ID));
          end;
        Designer.SetSelections(List);
      finally
        List.Free;
      end;
    end
    else
      Designer.SelectComponent(Collection);
  except
    FSelectionError := True;
    Application.HandleException(ExceptObject);
    Close;
  end;
end;

procedure TCollectionEditor.UnlockState;
begin
  Dec(FStateLock);
end;

procedure TCollectionEditor.UpdateListbox;
var
  I, J: Integer;

  procedure UpdateSizes;
  var
    I: Integer;
  begin
    with TRegIniFile.Create(GetRegKey) do
    try
      Width := ReadInteger(FCollectionClassName, 'Width', Width);
      Height := ReadInteger(FCollectionClassName, 'Height', Height);
      Splitter1.Top := Toolbar1.Top + Toolbar1.Height;
      ToolBar1.Visible := ReadBool(FCollectionClassName, 'Toolbar', True);
      Splitter1.Visible := Toolbar1.Visible;
      LargeButtons := ReadBool(FCollectionClassName, 'LargeButtons', False);
      ListView1.HandleNeeded;
      if ListView1.Columns.Count > 1 then
        for I := 0 to ListView1.Columns.Count - 1 do
          ListView1.Column[I].Width := ReadInteger(FCollectionClassName,
            Format('Column%d', [I]), ListView1.Column[I].WidthType);
    finally
      Free;
    end;
  end;

  procedure UpdateColumns;
  var
    I: Integer;
  begin
    if (Collection <> nil) and
      (((TAccessCollection(Collection).GetAttrCount > 0) and
      (ListView1.Columns.Count <> TAccessCollection(Collection).GetAttrCount)) or
      ((ListView1.Columns.Count = 0) and
      (TAccessCollection(Collection).GetAttrCount < 1))) then
    begin
      ListView1.HandleNeeded;
      with TAccessCollection(Collection) do
      begin
        if GetAttrCount >= 1 then
          for I := 0 to GetAttrCount - 1 do
            with ListView1.Columns.Add do
            begin
              Caption := GetAttr(I);
              Width := -2;
            end
        else
          with ListView1.Columns.Add do
            Width := -1;
        if GetAttrCount >= 1 then
          ListView1.ShowColumnHeaders := True
        //else
        //  ListView1.Column[0].Width := ListView1.ClientWidth;
      end;
      UpdateSizes;
    end;
  end;

  procedure FetchItems(List: TStrings);
  var
    I, J: Integer;
    SubList: TStringList;
  begin
    if Collection <> nil then
      for I := 0 to Collection.Count - 1 do
        if CanAdd(I) then
        begin
          SubList := TStringList.Create;
          for J := 1 to TAccessCollection(Collection).GetAttrCount - 1 do
            SubList.Add(GetItemName(J, I));
          List.AddObject(GetItemName(0, I), SubList);
        end;

  end;

  function ItemsEqual(ListItems: TListItems; Items: TStrings): Boolean;
  var
    I, J: Integer;
  begin
    Result := False;
    if ListItems.Count <> Items.Count then Exit;
    for I := 0 to ListItems.Count - 1 do
    begin
      if ListItems[I].Caption = Items[I] then
      begin
        for J := 0 to ListItems[I].SubItems.Count - 1 do
          if ListItems[I].SubItems[J] <> TStrings(Items.Objects[I])[J] then
            Exit;
      end
      else
        Exit;
    end;
    Result := True;
  end;

var
  TmpItems: TStringList;
begin
  if Collection = nil then Exit;
  LockState;
  try
    TmpItems := TStringList.Create;
    FetchItems(TmpItems);
    try
      if (TmpItems.Count = 0) or not ItemsEqual(ListView1.Items, TmpItems) then
      begin
        ListView1.Items.BeginUpdate;
        try
          UpdateColumns;
          ListView1.Items.Clear;
          for I := 0 to TmpItems.Count - 1 do
            with ListView1.Items.Add do
            begin
              Caption := TmpItems[I];
              for J := 0 to TStrings(TmpItems.Objects[I]).Count - 1 do
                SubItems.Add(TStrings(TmpItems.Objects[I])[J]);
            end;
        finally
          ListView1.Items.EndUpdate;
        end;
      end;
    finally
      for I := 0 to TmpItems.Count - 1 do
        TStrings(TmpItems.Objects[I]).Free;
      TmpItems.Free;
    end;
  finally
    UnlockState;
  end;
end;

procedure TCollectionEditor.AddClick(Sender: TObject);
var
  Item: TListItem;
  PrevCount: Integer;
begin
  SelectNone(False);
  Collection.BeginUpdate;
  try
    PrevCount := Collection.Count + 1;
    Collection.Add;
    { Take into account collections that free items }
    if PrevCount <> Collection.Count then
      UpdateListBox
    else
      ListView1.Selected := ListView1.Items.Add;
  finally
    Collection.EndUpdate;
  end;
  SetSelection;
  Designer.Modified;
  { Focus last added item }
  Item := ListView1.Items[ListView1.Items.Count-1];
  Item.Focused := True;
  Item.MakeVisible(False);
end;

procedure TCollectionEditor.DeleteClick(Sender: TObject);
var
  I, J: Integer;
begin
  Collection.BeginUpdate;
  try
    Designer.SetSelections(nil);
    if ListView1.Selected <> nil then
      J := ListView1.Selected.Index
    else J := -1;
    if ListView1.SelCount = Collection.Count then
      Collection.Clear
    else if ListView1.SelCount > 0 then
      for I := ListView1.Items.Count - 1 downto 0 do
        if ListView1.Items[I].Selected then
          Collection.Items[I].Free;
  finally
    Collection.EndUpdate;
  end;
  UpdateListbox;
  if J >= ListView1.Items.Count then
    J := ListView1.Items.Count - 1;
  if (J > -1) and (J < ListView1.Items.Count) then
    ListView1.Selected := ListView1.Items[J];
  SetSelection;
  Designer.Modified;
end;

procedure TCollectionEditor.ListView1Click(Sender: TObject);
begin
//  SetSelection;
end;

procedure TCollectionEditor.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    DelphiIDE.ModalEdit(#0,Self);
end;

procedure TCollectionEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  I: Integer;
begin
  if Component <> nil then
    Designer.SelectComponent(Component);
  with TRegIniFile.Create(GetRegKey) do
  try
    EraseSection(FCollectionClassName);
    WriteInteger(FCollectionClassName, 'Width', Width);
    WriteInteger(FCollectionClassName, 'Height', Height);
    WriteBool(FCollectionClassName, 'LargeButtons', LargeButtons);
    WriteBool(FCollectionClassName, 'Toolbar', ToolBar1.Visible);
    for I := 0 to ListView1.Columns.Count - 1 do
      WriteInteger(FCollectionClassName, Format('Column%d', [I]),
        ListView1.Column[I].WidthType);
  finally
    Free;
  end;
  Action := caFree;
  LockState;
end;


procedure TCollectionEditor.MoveUpClick(Sender: TObject);
var
  I, InsPos: Integer;
begin
  if (ListView1.SelCount = 0) or
    (ListView1.SelCount = Collection.Count) then Exit;

  InsPos := 0;
  while not ListView1.Items[InsPos].Selected do
    Inc(InsPos);
  if InsPos > 0 then Dec(InsPos);

  Collection.BeginUpdate;
  try
     for I := 0 to ListView1.Items.Count - 1 do
       if ListView1.Items[I].Selected then
       begin
         Collection.Items[I].Index := InsPos;
         Inc(InsPos);
       end;
  finally
    Collection.EndUpdate;
  end;
  GetSelection;
  Designer.Modified;
end;

procedure TCollectionEditor.MoveDownClick(Sender: TObject);
var
  I, InsPos: Integer;
begin
  if (ListView1.SelCount = 0) or
    (ListView1.SelCount = Collection.Count) then Exit;

  InsPos := ListView1.Items.Count - 1;
  while not ListView1.Items[InsPos].Selected do
    Dec(InsPos);
  if InsPos < (ListView1.Items.Count -1) then Inc(InsPos);

  Collection.BeginUpdate;
  try
     for I := ListView1.Items.Count - 1 downto 0 do
       if ListView1.Items[I].Selected then
       begin
         Collection.Items[I].Index := InsPos;
         Dec(InsPos);
       end;
  finally
    Collection.EndUpdate;
  end;
  GetSelection;
  Designer.Modified;
end;

procedure TCollectionEditor.ListView1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Item: TListItem;
begin
  Item := ListView1.GetItemAt(X, Y);
  Accept := (Item <> nil) and (Source = ListView1) and
    (not Item.Selected);
end;

procedure TCollectionEditor.ListView1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Item: TListItem;
  I, J, InsPos: Integer;
  L: TList;
begin
  Item := ListView1.GetItemAt(X, Y);
  if Item <> nil then
    InsPos := Item.Index
  else Exit;
  L := TList.Create;
  try
    for I := 0 to ListView1.Items.Count - 1 do
      if ListView1.Items[I].Selected then
        L.Add(Collection.Items[I]);

    Collection.BeginUpdate;
    try
      for I := 0 to L.Count - 1 do
      with TCollectionItem(L[I]) do
      begin
        J := Index;
        Index := InsPos;
        if (J > InsPos) and (InsPos < Collection.Count) then
          Inc(InsPos);
      end;
    finally
      Collection.EndUpdate;
    end;
  finally
    L.Free;
  end;
  GetSelection;
  Designer.Modified;
end;


procedure TCollectionEditor.FormCreate(Sender: TObject);
begin
  FItemIdList := TList.Create;
  CollectionEditorsList.Add(Self);
end;

procedure TCollectionEditor.FormDestroy(Sender: TObject);
begin
  FItemIdList.Free;
  if CollectionEditorsList <> nil then
    CollectionEditorsList.Remove(Self);
end;

procedure TCollectionEditor.FormResize(Sender: TObject);
begin
  //if not ListView1.ShowColumnHeaders then
  //  ListView1.Column[0].Width := ListView1.ClientWidth;
end;

procedure TCollectionEditor.ListView1Change(Sender: TObject;
  Item: TListItem; Change: TItemChange);
var
  Msg: TMsg;
begin
  if (Change = ctState) and (FStateLock = 0) then
    if not PeekMessage(Msg, Handle, AM_DeferUpdate, AM_DeferUpdate, PM_NOREMOVE) then
      PostMessage(Handle, AM_DeferUpdate, 0, 0);
end;

procedure TCollectionEditor.AMDeferUpdate(var Msg);
begin
  if FStateLock = 0 then
  begin
    if TMessage(Msg).WParam = 0 then
      SetSelection
    else
      FormModified;
  end
  else
    PostMessage(Handle, AM_DeferUpdate, TMessage(Msg).WParam, TMessage(Msg).LParam);
end;

procedure TCollectionEditor.SelectAll1Click(Sender: TObject);
begin
  SelectAll();
end;

procedure TCollectionEditor.SelectionUpdate(Sender: TObject);
var
  Enabled: Boolean;
begin
  Enabled := ListView1.Selected <> nil;
  if Enabled then
    if Sender = DeleteCmd then
      Enabled := coDelete in Options else
    if (Sender = MoveUpCmd) or (Sender = MoveDownCmd) then
      Enabled := coMove in Options;
  (Sender as TAction).Enabled := Enabled;
end;

procedure TCollectionEditor.SelectAllCommandUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := ListView1.Items.Count > 0;
end;

procedure TCollectionEditor.SelectAll(DoUpdate: Boolean);
var
  I: Integer;
begin
  LockState;
  ListView1.Items.BeginUpdate;
  try
    for I := 0 to Listview1.Items.Count-1 do
      Listview1.Items[I].Selected := True;
  finally
    ListView1.Items.EndUpdate;
    UnlockState;
    if DoUpdate then SetSelection;
  end;
end;

procedure TCollectionEditor.SelectNone(DoUpdate: Boolean);
var
  I: Integer;
begin
  LockState;
  ListView1.Items.BeginUpdate;
  try
    for I := 0 to Listview1.Items.Count-1 do
      Listview1.Items[I].Selected := False;
  finally
    ListView1.Items.EndUpdate;
    UnlockState;
    if DoUpdate then SetSelection;
  end;
end;

procedure TCollectionEditor.ListView1KeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key in ['!'..'~'] then
  begin
    DelphiIDE.ModalEdit(Key, Self);
    Key := #0;
  end;
end;

function TCollectionEditor.CanAdd(Index: Integer): Boolean;
begin
  Result := True;
end;

initialization

finalization
  CollectionEditorsList.Free;
  CollectionEditorsList := nil;
end.