colledit.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

unit CollEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, InspCtrl, CompInsp, MySplit, StdCtrls, MyLstBox, ExtCtrls, ComCtrls,
  MyPanel, MyButton, Menus, TypInfo, PropList, PropEdit, MyAutoBtn;

type
  TCollectionPropertyEditor = class(TPropertyEditor)
  private
    function GetCollection: TCollection;
  public
    function Execute: Boolean; override;
    property Collection: TCollection read GetCollection;
  end;

  TTargetPosition = (tpNone,tpTop,tpItem,tpBottom);
  
  TfrmCollectionEditor = class(TForm)
    pnlOperator: TMyPanel;
    lstItems: TMyListBox;
    splMain: TMySplitter;
    cinItemProperties: TComponentInspector;
    btnClose: TMyAutoBitBtn;
    btnAdd: TMyAutoBitBtn;
    btnDelete: TMyAutoBitBtn;
    spbMoveUp: TMySpeedButton;
    spbMoveDown: TMySpeedButton;
    procedure spbMoveUpClick(Sender: TObject);
    procedure spbMoveDownClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure lstItemsClick(Sender: TObject);
    procedure lstItemsDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lstItemsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure lstItemsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure cinItemPropertiesChange(Sender: TObject; TheIndex: Integer);
    procedure cinItemPropertiesExit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FEditor: TCollectionPropertyEditor;
    FDragIndex: Integer;
    procedure WMGetMinMaxInfo(var Msg: TMessage); message WM_GETMINMAXINFO;
    function ItemText(CI: TCollectionItem): string;
    procedure UpdateSelection;
    procedure MoveUp(Target: Integer);
    procedure MoveDown(Target: Integer);
    procedure Reorder;
    { Private declarations }
  public
    { Public declarations }
  end;

{var
  frmCollectionEditor: TfrmCollectionEditor;}

implementation

{$R *.dfm}

function TCollectionPropertyEditor.GetCollection: TCollection;
begin
  Result:=Prop.AsObject as TCollection;
end;

function TCollectionPropertyEditor.Execute: Boolean;
var
  i: Integer;
begin
  Result:=False;
  with TfrmCollectionEditor.Create(Application) do
  try
    FEditor:=Self;
    with Collection do
    begin
      for i:=0 to Pred(Count) do
        if Items[i].ClassType=ItemClass then
          lstItems.Items.AddObject(ItemText(Items[i]),Items[i]);
      with cinItemProperties do
      begin
        Root:=TCompInspPropertyList(Prop.Owner).Root;
        PaintStyle:=TCompInspPropertyList(Prop.Owner).CompInspList.Owner.PaintStyle;
        TCompInspPropertyList(Prop.Owner).CompInspList.Owner.CustomizeInspector(cinItemProperties);
      end;
      ShowModal;
    end;
  finally
    Free;
  end;
end;

procedure TfrmCollectionEditor.WMGetMinMaxInfo(var Msg: TMessage);
begin
  inherited;
  with PMinMaxInfo(Msg.LParam)^.ptMinTrackSize do
  begin
    X:=415;
    Y:=200;
  end;
end;

function TfrmCollectionEditor.ItemText(CI: TCollectionItem): string;
begin
  with CI do
    Result:=Format('%d - %s',[Index,DisplayName]);
end;

procedure TfrmCollectionEditor.UpdateSelection;
var
  i,Idx: Integer;
begin
  with cinItemProperties,lstItems,Items do
    if (FdragIndex<0) or (ItemIndex=-1) then Instance:=nil
//    if (SelCount<1) or (ItemIndex=-1) then Instance:=nil
    else
      if (SelCount=1) and (Instance<>Objects[ItemIndex]) then Instance:=TComponent(Objects[ItemIndex])
      else
      begin
        i:=0;
        while i<InstanceCount do
        begin
          Idx:=IndexOfObject(Instances[i]);
          if (Idx<>-1) and not Selected[Idx] then DeleteInstance(Instances[i])
          else Inc(i);
        end;
        for i:=0 to Pred(Count) do
          if Selected[i] and (IndexOfInstance(TComponent(Objects[i]))=-1) then
            AddInstance(TComponent(Objects[i]));
      end;
end;

procedure TfrmCollectionEditor.MoveUp(Target: Integer);
var
  i,OldSelCount: Integer;
begin
  with lstItems,Items do
  begin
    OldSelCount:=SelCount;
    for i:=0 to Pred(Count) do
      if Selected[i] then
      begin
        Move(i,Target);
        Inc(Target);
      end;
    Reorder;
    for i:=Target-OldSelCount to Pred(Target) do Selected[i]:=True;
  end;
end;

procedure TfrmCollectionEditor.MoveDown(Target: Integer);
var
  i,OldSelCount: Integer;
begin
  with lstItems,Items do
  begin
    OldSelCount:=SelCount;
    i:=0;
    while (i<Count) and (SelCount>0) do
      if Selected[i] and (i<>Target) then Move(i,Target)
      else Inc(i);
    Reorder;
    for i:=Target-Pred(OldSelCount) to Target do Selected[i]:=True;
  end;
end;

procedure TfrmCollectionEditor.Reorder;
var
  i: Integer;
  Sel: Boolean;
begin
  with lstItems,Items do
    for i:=0 to Pred(Count) do
    begin
      Sel:=Selected[i];
      TCollectionItem(Objects[i]).Index:=i;
      Items[i]:=ItemText(TCollectionItem(Objects[i]));
      if Sel then Selected[i]:=True;
    end;
end;

procedure TfrmCollectionEditor.spbMoveUpClick(Sender: TObject);
var
  i,Index: Integer;
begin
  Index:=-1;
  with lstItems,Items do
    for i:=0 to Pred(Count) do
      if Selected[i] then
      begin
        Index:=i;
        Break;
      end;
  case Index of
    -1:;
    0: MoveUp(Index);
  else MoveUp(Pred(Index));
  end;
end;

procedure TfrmCollectionEditor.spbMoveDownClick(Sender: TObject);
var
  i,Index: Integer;
begin            
  Index:=-1;
  with lstItems,Items do
  begin
    for i:=Pred(Count) downto 0 do
      if Selected[i] then
      begin
        Index:=i;
        Break;
      end;
    if Index<>-1 then
      if Index=Pred(Count) then MoveDown(Index)
      else MoveDown(Succ(Index));
  end
end;

procedure TfrmCollectionEditor.btnAddClick(Sender: TObject);
var
  Index: Integer;
  CI: TCollectionItem;
begin
  with lstItems,Items do
  begin
    with FEditor do CI:=Collection.ItemClass.Create(Collection);
    for Index:=0 to Pred(Count) do Selected[Index]:=False;
    Index:=AddObject(ItemText(CI),CI);
    Selected[Index]:=True;
    cinItemProperties.Instance:=TComponent(CI);
    btnDelete.Enabled:=SelCount>0;
  end;
end;

procedure TfrmCollectionEditor.btnDeleteClick(Sender: TObject);
var
  i,OldSel: Integer;
begin
  with lstItems,Items do
  begin
    OldSel:=ItemIndex;
    i:=0;
    while (i<Count) and (SelCount>0) do
      if Selected[i] then
      begin
        Delete(i);
        FEditor.Collection.Items[i].Free;
      end
      else Inc(i);
    Reorder;
    if OldSel>Pred(Count) then OldSel:=Pred(Count);
    ItemIndex:=OldSel;
    Selected[OldSel]:=True;
    btnDelete.Enabled:=SelCount>0;
  end;
  UpdateSelection;
end;

procedure TfrmCollectionEditor.lstItemsClick(Sender: TObject);
begin
  UpdateSelection;
end;

procedure TfrmCollectionEditor.lstItemsDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Index: Integer;
begin
  with lstItems do
  begin
    Index:=ItemAtPos(Point(X,Y),True);
    if Index<FDragIndex then MoveUp(Index)
    else MoveDown(Index);
  end;
end;

procedure TfrmCollectionEditor.lstItemsDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Index: Integer;
begin
  with lstItems do
  begin
    Index:=ItemAtPos(Point(X,Y),True);
    Accept:=(Index>=0) and (Index<Items.Count) and not Selected[Index];
  end;
end;

procedure TfrmCollectionEditor.lstItemsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDragIndex:=lstItems.ItemAtPos(Point(X,Y),True);
end;

procedure TfrmCollectionEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  cinItemProperties.ApplyChanges;
end;

procedure TfrmCollectionEditor.FormShow(Sender: TObject);
begin
  with lstItems,Items do
  begin
    if Count>0 then
    begin
      ItemIndex:=0;
      Selected[0]:=True;
      UpdateSelection;
    end
    else cinItemProperties.Instance:=nil;
    btnDelete.Enabled:=SelCount>0;
  end;
end;

procedure TfrmCollectionEditor.cinItemPropertiesChange(Sender: TObject;
  TheIndex: Integer);
begin
  Reorder;
end;

procedure TfrmCollectionEditor.cinItemPropertiesExit(Sender: TObject);
begin
  cinItemProperties.ApplyChanges;
end;

procedure TfrmCollectionEditor.FormCreate(Sender: TObject);
begin
  if GetACP=936 then
    Self.Caption:='对象收集编辑器'
  else if GetACP=950 then
    Self.Caption:='癸禜Μ栋絪胯竟'
  else
    Self.Caption:='Collection Editor';
end;

end.