lasarus_compotents/ToolBar 2000/Source/TB2DsgnItemEditor.pas

unit TB2DsgnItemEditor;

{
  Toolbar2000
  Copyright (C) 1998-2008 by Jordan Russell
  All rights reserved.

  The contents of this file are subject to the "Toolbar2000 License"; you may
  not use or distribute this file except in compliance with the
  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
  TB2k-LICENSE.txt or at:
    http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt

  Alternatively, the contents of this file may be used under the terms of the
  GNU General Public License (the "GPL"), in which case the provisions of the
  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
  the GPL may be found in GPL-LICENSE.txt or at:
    http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
  If you wish to allow use of your version of this file only under the terms of
  the GPL and not to allow others to use your version of this file under the
  "Toolbar2000 License", indicate your decision by deleting the provisions
  above and replace them with the notice and other provisions required by the
  GPL. If you do not delete the provisions above, a recipient may use your
  version of this file under either the "Toolbar2000 License" or the GPL.

  $jrsoftware: tb2k/Source/TB2DsgnItemEditor.pas,v 1.63 2008/09/25 18:49:31 jr Exp $
}

interface

{$I TB2Ver.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF CLR} System.ComponentModel, {$ENDIF}
  StdCtrls, ExtCtrls, Buttons, ComCtrls, ImgList, Menus,
  TB2Item, TB2Toolbar, TB2Dock,
  {$IFDEF JR_D6}
    DesignIntf, DesignWindows, DesignEditors;
  {$ELSE}
    DsgnIntf, DsgnWnds, LibIntf;
  {$ENDIF}

const
  CM_DEFERUPDATE = WM_USER + 100;

type
  TTBItemEditForm = class(TDesignWindow)
    TreeView: TTreeView;
    ListView: TListView;
    Splitter1: TSplitter;
    Toolbar: TTBToolbar;
    NewSubmenuButton: TTBItem;
    NewItemButton: TTBItem;
    NewSepButton: TTBItem;
    DeleteButton: TTBItem;
    TBSeparatorItem1: TTBSeparatorItem;
    TBPopupMenu1: TTBPopupMenu;
    TBItemContainer1: TTBItemContainer;
    ToolbarItems: TTBSubmenuItem;
    CopyButton: TTBItem;
    CutButton: TTBItem;
    PasteButton: TTBItem;
    MoreMenu: TTBSubmenuItem;
    TBSeparatorItem2: TTBSeparatorItem;
    TBSubmenuItem1: TTBSubmenuItem;
    TConvertMenu: TTBItem;
    TBSeparatorItem3: TTBSeparatorItem;
    MoveUpButton: TTBItem;
    MoveDownButton: TTBItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure NewSubmenuButtonClick(Sender: TObject);
    procedure NewItemButtonClick(Sender: TObject);
    procedure ListViewChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure DeleteButtonClick(Sender: TObject);
    procedure NewSepButtonClick(Sender: TObject);
    procedure ListViewDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TreeViewEnter(Sender: TObject);
    procedure TreeViewDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure CopyButtonClick(Sender: TObject);
    procedure ListViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CutButtonClick(Sender: TObject);
    procedure PasteButtonClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ListViewKeyPress(Sender: TObject; var Key: Char);
    procedure ListViewDblClick(Sender: TObject);
    procedure ListViewEnter(Sender: TObject);
    procedure TreeViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TConvertMenuClick(Sender: TObject);
    procedure TreeViewKeyPress(Sender: TObject; var Key: Char);
    procedure MoveUpButtonClick(Sender: TObject);
    procedure MoveDownButtonClick(Sender: TObject);
  private
    FParentComponent: TComponent;
    FRootItem, FSelParentItem: TTBCustomItem;
    FNotifyItemList: TList;
    FSettingSel, FRebuildingTree, FRebuildingList: Integer;
    function AddListViewItem(const Index: Integer;
      const Item: TTBCustomItem): TListItem;
    procedure CMDeferUpdate(var Message: TMessage); message CM_DEFERUPDATE;
    procedure Copy;
    procedure CreateNewItem(const AClass: TTBCustomItemClass);
    procedure Cut;
    procedure Delete;
    procedure DeleteItem(const Item: TTBCustomItem);
    function GetItemTreeCaption(AItem: TTBCustomItem): String;
    procedure GetSelItemList(const AList: TList);
    procedure ItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean;
      Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem);
    procedure MoreItemClick(Sender: TObject);
    procedure MoveItem(CurIndex, NewIndex: Integer);
    procedure Paste;
    procedure RebuildList;
    procedure RebuildTree;
    procedure SelectInObjectInspector(AList: TList);
    procedure SetSelParentItem(ASelParentItem: TTBCustomItem);
    function TreeViewDragHandler(Sender, Source: TObject; X, Y: Integer;
      Drop: Boolean): Boolean;
    procedure UnregisterAllNotifications;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function UniqueName(Component: TComponent): String; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF JR_D6}
    function EditAction(Action: TEditAction): Boolean; override;
    {$ELSE}
    procedure EditAction(Action: TEditAction); override;
    {$ENDIF}
    function GetEditState: TEditState; override;
  end;

  TTBItemsEditor = class(TDefaultEditor)
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): String; override;
    function GetVerbCount: Integer; override;
  end;

  TTBItemsPropertyEditor = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: String; override;
  end;

procedure TBRegisterItemClass(AClass: TTBCustomItemClass;
  const ACaption: String; ResInstance: HINST);

implementation

{$R *.DFM}

uses
  {$IFDEF CLR} System.Drawing, System.IO, System.Reflection, {$ENDIF}
  TypInfo, CommCtrl, TB2Version, TB2Common, TB2DsgnConverter;

type
{$IFNDEF JR_D5}
  TDesignerSelectionList = TComponentList;
{$ENDIF}
{$IFDEF JR_D6}
  TDesignerSelectionList = IDesignerSelections;
{$ENDIF}

  TItemClassInfo = class
    ItemClass: TTBCustomItemClass;
    Caption: String;
    ImageIndex: Integer;
  end;

var
  ItemClasses: TList;
  ItemImageList: TImageList;

{$IFNDEF JR_D6}
function CreateSelectionList: TDesignerSelectionList;
begin
  Result := TDesignerSelectionList.Create;
end;
{$ENDIF}

procedure FreeItemClasses;
var
  I: Integer;
  IC: TList;
begin
  if ItemClasses = nil then Exit;
  IC := ItemClasses;
  ItemClasses := nil;
  for I := IC.Count-1 downto 0 do
    TItemClassInfo(IC[I]).Free;
  IC.Free;
end;

{ Note: AFAIK, there is no need for a similar function on .NET since assemblies
  can't be unloaded. When a design-time package is uninstalled, it remains
  loaded until the IDE is restarted. }
{$IFNDEF CLR}
procedure UnregisterModuleItemClasses(AModule: {$IFDEF JR_D5} LongWord {$ELSE} Integer {$ENDIF});
var
  I: Integer;
  Info: TItemClassInfo;
begin
  I := 0;
  while I < ItemClasses.Count do begin
    Info := TItemClassInfo(ItemClasses[I]);
    if FindClassHInstance(Info.ItemClass) = AModule then begin
      ItemClasses.Delete(I);
      Info.Free;
    end
    else
      Inc(I);
  end;
  { Note: TTBItemEditForm also holds references to item classes, but since
    Delphi automatically closes all editor forms before compiling/removing
    a package, we don't need to remove them. }
end;
{$ENDIF}

{$IFNDEF CLR}
function LoadItemImage(Instance: HINST; const ResName: String): Integer;
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Handle := LoadBitmap(Instance, {$IFNDEF CLR}PChar{$ENDIF}(ResName));
    if Bmp.Handle = 0 then
      Result := -1
    else
      Result := ItemImageList.AddMasked(Bmp, Bmp.Canvas.Pixels[0, Bmp.Height-1]);
  finally
    Bmp.Free;
  end;
end;
{$ELSE}
function LoadItemImage(const AAssembly: System.Reflection.Assembly;
  const ResName: String): Integer;
var
  Bmp: TBitmap;
  ResStream: System.IO.Stream;
  ResBmp: System.Drawing.Bitmap;
begin
  Bmp := TBitmap.Create;
  try
    ResStream := AAssembly.GetManifestResourceStream(ResName);
    if ResStream = nil then begin
      Result := -1;
      Exit;
    end;
    try
      ResBmp := System.Drawing.Bitmap.Create(ResStream);
      try
        Bmp.LoadFromBitmap(ResBmp);
      finally
        ResBmp.Dispose;
      end;
    finally
      ResStream.Close;
    end;
    Result := ItemImageList.AddMasked(Bmp, Bmp.Canvas.Pixels[0, Bmp.Height-1]);
  finally
    Bmp.Free;
  end;
end;
{$ENDIF}

procedure TBRegisterItemClass(AClass: TTBCustomItemClass;
  const ACaption: String; ResInstance: HINST);
var
  I: Integer;
  Info: TItemClassInfo;
begin
  { Hack for Delphi.NET 2006 bug:
    If you start Delphi, open & rebuild the tb2k_dn10 package only, then open
    the Demo project, the IDE calls the Register procedure on tb2kdsgn_d10 a
    second time, without reloading either of the two packages. As a result,
    the TBRegisterItemClass calls are repeated. To avoid doubled items on the
    editor form's More menu, check if the class was already registered. }
  for I := 0 to ItemClasses.Count-1 do
    if TItemClassInfo(ItemClasses[I]).ItemClass = AClass then
      Exit;
  Info := TItemClassInfo.Create;
  Info.ItemClass := AClass;
  Info.Caption := ACaption;
  {$IFNDEF CLR}
  Info.ImageIndex := LoadItemImage(ResInstance,
    Uppercase(AClass.ClassName {$IFDEF JR_D9} , loInvariantLocale {$ENDIF}));
  {$ELSE}
  Info.ImageIndex := LoadItemImage(Assembly.GetCallingAssembly,
    AClass.ClassName + '.bmp');
  {$ENDIF}
  ItemClasses.Add(Info);
end;

function GetItemClassImage(AClass: TTBCustomItemClass): Integer;
var
  I: Integer;
  Info: TItemClassInfo;
begin
  for I := ItemClasses.Count-1 downto 0 do begin
    Info := TItemClassInfo(ItemClasses[I]);
    if AClass.InheritsFrom(Info.ItemClass) then begin
      Result := Info.ImageIndex;
      if Result >= 0 then
        Exit;
    end;
  end;
  if AClass.InheritsFrom(TTBSubmenuItem) then
    Result := 1
  else if AClass.InheritsFrom(TTBSeparatorItem) then
    Result := 2
  else
    Result := 0;
end;

procedure ShowEditForm(AParentComponent: TComponent; ARootItem: TTBCustomItem;
  const ADesigner: {$IFDEF JR_D6} IDesigner {$ELSE} IFormDesigner {$ENDIF});
var
  I: Integer;
  Form: TCustomForm;
  EditForm: TTBItemEditForm;
begin
  if Assigned(ARootItem.LinkSubitems) then begin
    case MessageDlg(Format('The LinkSubitems property is set to ''%s''. ' +
       'Would you like to edit that item instead?',
       [ARootItem.LinkSubitems.Name]), mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
      mrYes: begin
          AParentComponent := ARootItem.LinkSubitems;
          ARootItem := ARootItem.LinkSubitems;
        end;
      mrCancel: Exit;
    end;
  end;
  for I := 0 to Screen.FormCount-1 do begin
    Form := Screen.Forms[I];
    if Form is TTBItemEditForm then
      if TTBItemEditForm(Form).FRootItem = ARootItem then begin
        Form.Show;
        if Form.WindowState = wsMinimized then
          Form.WindowState := wsNormal;
        Exit;
      end;
  end;
  EditForm := TTBItemEditForm.Create(Application);
  try
    EditForm.Designer := ADesigner;
    EditForm.FParentComponent := AParentComponent;
    AParentComponent.FreeNotification(EditForm);
    EditForm.FRootItem := ARootItem;
    ARootItem.FreeNotification(EditForm);
    EditForm.FSelParentItem := ARootItem;
    EditForm.Caption := 'Editing ' + AParentComponent.Name;
    EditForm.RebuildTree;
    EditForm.RebuildList;
    {$IFDEF JR_D9}
    EditForm.PopupMode := pmExplicit;
    {$ENDIF}
    EditForm.Show;
  except
    EditForm.Free;
    raise;
  end;
end;

function IsSubmenuItem(Item: TTBCustomItem): Boolean;
begin
  Result := tbisSubitemsEditable in Item.GetItemStyle;
end;

procedure ShowVersion;
const
  AboutText =
    '%s'#13#10 +
    'Copyright (C) 1998-2008 by Jordan Russell'#13#10 +
    'For conditions of distribution and use, see LICENSE.TXT.'#13#10 +
    #13#10 +
    'Visit my web site for the latest versions of Toolbar2000:'#13#10 +
    'http://www.jrsoftware.org/';
begin
  MessageDlg(Format(AboutText, [Toolbar2000VersionPropText]), mtInformation,
    [mbOK], 0);
end;


{ TTBItemEditForm }

constructor TTBItemEditForm.Create(AOwner: TComponent);
var
  I: Integer;
  Info: TItemClassInfo;
  Item: TTBItem;
begin
  inherited;
  FNotifyItemList := TList.Create;
  ToolbarItems.SubMenuImages := ItemImageList;
  ListView.SmallImages := ItemImageList;
  { Populate the 'More' menu }
  for I := 0 to ItemClasses.Count-1 do begin
    Info := TItemClassInfo(ItemClasses[I]);
    Item := TTBItem.Create(Self);
    Item.Caption := Info.Caption;
    Item.ImageIndex := GetItemClassImage(Info.ItemClass);
    Item.Tag := {$IFNDEF CLR}Integer{$ELSE}TTag{$ENDIF}(Info.ItemClass);
    Item.OnClick := MoreItemClick;
    MoreMenu.Add(Item);
  end;
end;

destructor TTBItemEditForm.Destroy;
begin
  inherited;
  if Assigned(FNotifyItemList) then begin
    UnregisterAllNotifications;
    FNotifyItemList.Free;
    FNotifyItemList := nil;
  end;
end;

procedure TTBItemEditForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TTBItemEditForm.FormActivate(Sender: TObject);
begin
  SetSelParentItem(FSelParentItem);
end;

procedure TTBItemEditForm.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and
     ((AComponent = FParentComponent) or (AComponent = FRootItem)) then
    { Must use Free instead of Close, since Close causes the freeing of the
      form to be delayed until the next message. We have to destroy the form
      immediately, otherwise Delphi will crash when Compile is clicked on the
      TB2k package. }
    Free;
  {}{temp:}
  (*if (Operation = opRemove) and (FNotifyItemList.IndexOf(AComponent) <> -1) then begin
    outputdebugstring(pchar('Still in list: ' + AComponent.name));
    //beep;
  end;*)
end;

function TTBItemEditForm.UniqueName(Component: TComponent): String;
begin
  Result := Designer.UniqueName(Component.ClassName);
end;

function TTBItemEditForm.GetEditState: TEditState;
begin
  Result := [];
  if ActiveControl = ListView then begin
    if Assigned(ListView.Selected) then
      Result := [esCanDelete, esCanCut, esCanCopy];
    if ClipboardComponents then
      Include(Result, esCanPaste);
  end;
end;

{$IFDEF JR_D6}
function TTBItemEditForm.EditAction(Action: TEditAction): Boolean;
{$ELSE}
procedure TTBItemEditForm.EditAction(Action: TEditAction);
{$ENDIF}
begin
  {$IFDEF JR_D6}
  Result := True;
  {$ENDIF}
  case Action of
    eaCut: Cut;
    eaCopy: Copy;
    eaPaste: Paste;
    eaDelete: Delete;
  {$IFDEF JR_D6}
  else
    Result := False;
  {$ENDIF}
  end;
end;

procedure TTBItemEditForm.UnregisterAllNotifications;
var
  I: Integer;
begin
  for I := FNotifyItemList.Count-1 downto 0 do begin
    //outputdebugstring(pchar('Unregall: ' + TTBCustomItem(FNotifyItemList[I]).name));
    TTBCustomItem(FNotifyItemList[I]).UnregisterNotification(ItemNotification);
    FNotifyItemList.Delete(I);
  end;
end;

procedure TTBItemEditForm.ItemNotification(Ancestor: TTBCustomItem;
  Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer;
  Item: TTBCustomItem);
var
  ListItem: TListItem;
  TreeNode: TTreeNode;
  I: Integer;
  C: String;
begin
  { Manipulate the list view when items are inserted, deleted, or their Caption
    changes }
  case Action of
    tbicInserted:
      begin
        if (Ancestor = FSelParentItem) and not Relayed then
          AddListViewItem(Index, Item);
        if IsSubmenuItem(Item) then
          RebuildTree;
      end;
    tbicDeleting:
      if (Ancestor = FSelParentItem) and not Relayed then begin
        ListItem := ListView.FindData(0, Item, True, False);
        if Assigned(ListItem) then
          ListItem.Delete;
      end;
    tbicInvalidateAndResize:
      if (Ancestor = FSelParentItem) and not Relayed then begin
        ListItem := ListView.FindData(0, Item, True, False);
        if Assigned(ListItem) and (ListItem.Caption <> TTBCustomItem(Item).Caption) then
          ListItem.Caption := TTBCustomItem(Item).Caption;
      end;
  end;
  { Update tree view when an item is deleted, or a Caption changes }
  if Action = tbicDeleting then begin
    I := FNotifyItemList.IndexOf(Item);
    if I <> -1 then begin
      //outputdebugstring(pchar('Deleting, so unreging: ' + item.name));
      TTBCustomItem(Item).UnregisterNotification(ItemNotification);
      FNotifyItemList.Delete(I);
    end;
  end;
  if Action in [tbicDeleting, tbicInvalidateAndResize, tbicNameChanged] then begin
    TreeNode := TreeView.Items.GetFirstNode;
    while Assigned(TreeNode) do begin
      if TreeNode.Data = Item then begin
        if Action = tbicDeleting then begin
          TreeNode.Delete;
          if FSelParentItem = Item then
            SetSelParentItem(TTBCustomItem(Item).Parent);
        end
        else begin
          { tbicInvalidateAndResize, tbicNameChanged: }
          C := GetItemTreeCaption(Item);
          if TreeNode.Text <> C then
            TreeNode.Text := C;
        end;
        Break;
      end;
      TreeNode := TreeNode.GetNext;
    end;
  end;
end;

function TTBItemEditForm.GetItemTreeCaption(AItem: TTBCustomItem): String;
begin
  if AItem <> FRootItem then begin
    Result := AItem.Caption;
    if Result = '' then
      Result := '[' + AItem.Name + ']';
  end
  else
    Result := '(Root)';
end;

procedure TTBItemEditForm.RebuildTree;

  procedure Recurse(const AParentItem: TTBCustomItem; const ATreeNode: TTreeNode;
    var FoundSelParentItem: TTreeNode);
  var
    I: Integer;
    NewNode: TTreeNode;
    ChildItem: TTBCustomItem;
  begin
    {}AParentItem.FreeNotification(Self);
    AParentItem.RegisterNotification(ItemNotification);
    FNotifyItemList.Add(AParentItem);
    NewNode := TreeView.Items.AddChild(ATreeNode, GetItemTreeCaption(AParentItem));
    NewNode.Data := AParentItem;
    if AParentItem = FSelParentItem then
      FoundSelParentItem := NewNode;
    for I := 0 to AParentItem.Count-1 do begin
      ChildItem := AParentItem[I];
      if IsSubmenuItem(ChildItem) then
        Recurse(ChildItem, NewNode, FoundSelParentItem);
    end;
  end;

var
  FoundSelParentItem: TTreeNode;
begin
  Inc(FRebuildingTree);
  try
    TreeView.Items.BeginUpdate;
    try
      TreeView.Items.Clear;
      UnregisterAllNotifications;
      FoundSelParentItem := nil;
      Recurse(FRootItem, nil, FoundSelParentItem);
      if FoundSelParentItem = nil then
        SetSelParentItem(FRootItem)
      else
        TreeView.Selected := FoundSelParentItem;
      TreeView.Items[0].Expand(True);
    finally
      TreeView.Items.EndUpdate;
    end;
  finally
    Dec(FRebuildingTree);
  end;
end;

function TTBItemEditForm.AddListViewItem(const Index: Integer;
  const Item: TTBCustomItem): TListItem;
begin
  Result := ListView.Items.Insert(Index);
  Result.Data := Item;
  if not(Item is TTBControlItem) then begin
    Result.Caption := Item.Caption;
    Result.Subitems.Add(Item.ClassName);
    Result.ImageIndex := GetItemClassImage(TTBCustomItemClass(Item.ClassType));
  end
  else begin
    Result.Caption := '(Control)';
    Result.Subitems.Add(Item.ClassName);
    Result.ImageIndex := -1;
  end;
end;

procedure TTBItemEditForm.RebuildList;
var
  ChildItem: TTBCustomItem;
  I: Integer;
begin
  Inc(FRebuildingList);
  try
    ListView.Items.BeginUpdate;
    try
      ListView.Items.Clear;
      if Assigned(FSelParentItem) then begin
        for I := 0 to FSelParentItem.Count-1 do begin
          ChildItem := FSelParentItem[I];
          { Check for csDestroying because deleting an item in the tree view
            causes the parent item to be selected, and the parent item won't
            get a notification that the item is deleting since notifications
            were already sent }
          if not(csDestroying in ChildItem.ComponentState) then
            AddListViewItem(I, ChildItem);
        end;
        { Add an empty item to the end }
        ListView.Items.Add.ImageIndex := -1;
      end;
    finally
      ListView.Items.EndUpdate;
    end;
    { Work around a strange TListView bug(?). Without this, the column header
      isn't painted properly. }
    if HandleAllocated then
      SetWindowPos(ListView.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
        SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  finally
    Dec(FRebuildingList);
  end;
end;

procedure TTBItemEditForm.SelectInObjectInspector(AList: TList);
var
  CompList1, CompList2: TDesignerSelectionList;
  I: Integer;
  C: TComponent;
begin
  { Designer.SetSelections will make components appear selected on the form.
    It will also select the component in Object Inspector, but only if the
    form has the focus. TDesignWindow.SetSelection will select the component
    in Object Inspector regardless of whether the form has the focus. }
  CompList1 := CreateSelectionList;
  CompList2 := CreateSelectionList;
  for I := 0 to AList.Count-1 do begin
    C := TComponent(AList[I]);
    { Must check for csDestroying. If SetSelection is passed a component that's
      destroying, Delphi will crash. }
    if not(csDestroying in C.ComponentState) then begin
      CompList1.Add(C);
      CompList2.Add(C);
    end;
  end;
  if CompList1.Count = 0 then begin
    {$IFNDEF JR_D6}
    CompList1.Free;
    CompList2.Free;
    {$ENDIF}
  end
  else begin
    Designer.SetSelections(CompList1);
    { Note: Never pass an empty list to SetSelection or Delphi will crash }
    { History here:
      - 1.34: SetSelection call remarked out because it fixed Delphi 6 issue
        with random AV's after the editor was closed.
      - 1.38: SetSelection call restored because without it, Ctrl+X/C/V didn't
        work.
      - 1.40: SetSelection call disabled on Delphi 6 only because AV problem
        still seems to exist despite another change which I thought fixed it.
        On D6 it isn't necessary to call SetSelection for Ctrl+X/C/V to work.
        Note: Using "ComponentDesigner.SetSelection(Designer, nil, CompList2);"
        instead seems to fix the AV problem, but for consistency with Delphi's
        TMainMenu editor (which only selects items when its parent form is
        focused), I decided not to call SetSelection at all on D6.
    }
    {$IFNDEF JR_D6}
    SetSelection(CompList2);
    {$ENDIF}
  end;
end;

procedure TTBItemEditForm.GetSelItemList(const AList: TList);
var
  ListItem: TListItem;
begin
  ListItem := nil;
  while True do begin
    ListItem := ListView.GetNextItem(ListItem, sdAll, [isSelected]);
    if ListItem = nil then
      Break;
    if Assigned(ListItem.Data) then
      AList.Add(ListItem.Data);
  end;
end;

procedure TTBItemEditForm.SetSelParentItem(ASelParentItem: TTBCustomItem);
{ - Rebuilds the list view to match a new selection (ASelParentItem) in the
    tree view
  - Updates toolbar
  - Selects selected item(s) into Object Inspector }
var
  I: Integer;
  TreeNode: TTreeNode;
  ItemIsSelected: Boolean;
  List: TList;
begin
  if FSettingSel > 0 then
    Exit;
  List := TList.Create;
  Inc(FSettingSel);
  try
    if FSelParentItem <> ASelParentItem then begin
      FSelParentItem := ASelParentItem;
      NewSubmenuButton.Enabled := Assigned(ASelParentItem);
      NewItemButton.Enabled := Assigned(ASelParentItem);
      NewSepButton.Enabled := Assigned(ASelParentItem);
      for I := 0 to MoreMenu.Count-1 do
        MoreMenu[I].Enabled := Assigned(ASelParentItem);
      if not Assigned(TreeView.Selected) or (TreeView.Selected.Data <> FSelParentItem) then begin
        if FSelParentItem = nil then
          TreeView.Selected := nil
        else begin
          TreeNode := TreeView.Items.GetFirstNode;
          while Assigned(TreeNode) do begin
            if TreeNode.Data = FSelParentItem then begin
              TreeView.Selected := TreeNode;
              Break;
            end;
            TreeNode := TreeNode.GetNext;
          end;
        end;
      end;
      RebuildList;
    end;

    ItemIsSelected := (ActiveControl = ListView) and Assigned(ListView.Selected) and
      Assigned(ListView.Selected.Data);
    if ItemIsSelected then
      GetSelItemList(List);

    CutButton.Enabled := ItemIsSelected;
    CopyButton.Enabled := ItemIsSelected;
    PasteButton.Enabled := (ActiveControl = ListView);
    DeleteButton.Enabled := ItemIsSelected or
      ((ActiveControl = TreeView) and (FSelParentItem <> FRootItem));
    MoveUpButton.Enabled := ItemIsSelected and
      (FSelParentItem.IndexOf(TTBCustomItem(List.First)) > 0);
    MoveDownButton.Enabled := ItemIsSelected and
      (FSelParentItem.IndexOf(TTBCustomItem(List.Last)) < FSelParentItem.Count-1);

    if ActiveControl = ListView then begin
      if List.Count = 0 then
        { No item was selected, or the blank item was selected.
          Select the root item so it looks like no item was selected in
          Object Inspector }
        List.Add(FRootItem);
    end
    else if not Assigned(ASelParentItem) or (ASelParentItem = FRootItem) then
      List.Add(FParentComponent)
    else
      List.Add(ASelParentItem);
    SelectInObjectInspector(List);
  finally
    Dec(FSettingSel);
    List.Free;
  end;
end;

procedure TTBItemEditForm.Cut;
begin
  Copy;
  Delete;
end;

procedure TTBItemEditForm.Copy;
var
  SelList: TList;
  CompList: TDesignerSelectionList;
  I: Integer;
  Item: TTBCustomItem;
begin
  if ListView.Selected = nil then Exit;
  CompList := nil;
  SelList := TList.Create;
  try
    GetSelItemList(SelList);
    CompList := CreateSelectionList;
    for I := 0 to SelList.Count-1 do begin
      Item := TTBCustomItem(SelList[I]);
      if Item is TTBControlItem then
        raise EInvalidOperation.Create('Cannot cut or copy TTBControlItems');
      CompList.Add(Item);
    end;
    CopyComponents(FParentComponent.Owner, CompList);
  finally
    {$IFNDEF JR_D6}
    CompList.Free;
    {$ENDIF}
    SelList.Free;
  end;
end;

procedure TTBItemEditForm.Paste;
var
  CompList: TDesignerSelectionList;
begin
  if FSelParentItem = nil then Exit;
  CompList := CreateSelectionList;
  try
    PasteComponents(FParentComponent.Owner, FSelParentItem, CompList);
    if CompList.Count <> 0 then
      Designer.Modified;
  finally
    {$IFNDEF JR_D6}
    CompList.Free;
    {$ENDIF}
  end;
end;

procedure TTBItemEditForm.DeleteItem(const Item: TTBCustomItem);
begin
  if csAncestor in Item.ComponentState then
    raise EInvalidOperation.Create('Items introduced in an ancestor form cannot be deleted');
  //Designer.ValidateRename(Item, Item.Name, '');
  Item.Free;
  Designer.Modified;
end;

procedure TTBItemEditForm.Delete;
var
  List: TList;
  Item: TTBCustomItem;
  ListItem: TListItem;
begin
  List := TList.Create;
  try
    List.Add(FSelParentItem);
    SelectInObjectInspector(List);
  finally
    List.Free;
  end;
  FSelParentItem.ViewBeginUpdate;
  try
    while Assigned(ListView.Selected) do begin
      Item := TTBCustomItem(ListView.Selected.Data);
      if Item = nil then
        Break;
      DeleteItem(Item);
    end;
  finally
    FSelParentItem.ViewEndUpdate;
  end;
  { After deleting the items, select the item with the focus }
  ListItem := ListView.GetNextItem(nil, sdAll, [isFocused]);
  if Assigned(ListItem) then
    ListItem.Selected := True;
end;

procedure TTBItemEditForm.MoveItem(CurIndex, NewIndex: Integer);
var
  WasFocused: Boolean;
begin
  WasFocused := ListView.Items[CurIndex].Focused;

  FSelParentItem.Move(CurIndex, NewIndex);
  Designer.Modified;

  if WasFocused then
    ListView.Items[NewIndex].Focused := True;
  ListView.Items[NewIndex].Selected := True;
end;

procedure TTBItemEditForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
  NewSelectedParentItem: TTBCustomItem;
begin
  if (FRebuildingTree > 0) or (FSettingSel > 0) then Exit;
  if Node = nil then
    NewSelectedParentItem := nil
  else
    NewSelectedParentItem := TTBCustomItem(Node.Data);
  SetSelParentItem(NewSelectedParentItem);
end;

procedure TTBItemEditForm.TreeViewEnter(Sender: TObject);
{ When the tree view gets the focus, act as if the currently selected item
  was clicked. }
begin
  ListView.Selected := nil;
  SetSelParentItem(FSelParentItem);
end;

procedure TTBItemEditForm.CMDeferUpdate(var Message: TMessage);
begin
  SetSelParentItem(FSelParentItem);
end;

procedure TTBItemEditForm.ListViewChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
  Msg: TMsg;
begin
  if (FRebuildingList > 0) or (FSettingSel > 0) or (Change <> ctState) or
     (csDestroying in ListView.ComponentState) then
    Exit;
  if not PeekMessage(Msg, Handle, CM_DEFERUPDATE, CM_DEFERUPDATE,
     PM_NOREMOVE or PM_NOYIELD) then
    PostMessage(Handle, CM_DEFERUPDATE, 0, 0);
end;

procedure TTBItemEditForm.ListViewEnter(Sender: TObject);
begin
  { When list view gets the focus, update the toolbar }
  SetSelParentItem(FSelParentItem);
end;

procedure TTBItemEditForm.ListViewDblClick(Sender: TObject);
var
  SelItem: TTBCustomItem;
  PropCount, I: Integer;
  Props: {$IFNDEF CLR} PPropList {$ELSE} TPropList {$ENDIF};
  PropInfo: {$IFNDEF CLR} PPropInfo {$ELSE} TPropInfo {$ENDIF};
  MethodName: String;
  Method: TMethod;
begin
  SelItem := nil;
  if Assigned(ListView.Selected) then
    SelItem := TTBCustomItem(ListView.Selected.Data);
  if SelItem = nil then Exit;
  if IsSubmenuItem(SelItem) then begin
    SetSelParentItem(SelItem);
    Exit;
  end;
  {$IFNDEF CLR}
  PropCount := GetPropList(SelItem.ClassInfo, [tkMethod], nil);
  GetMem(Props, PropCount * SizeOf(PPropInfo));
  try
    GetPropList(SelItem.ClassInfo, [tkMethod], Props);
  {$ELSE}
    Props := GetPropList(SelItem.ClassInfo, [tkMethod]);
    PropCount := Length(Props);
  {$ENDIF}
    for I := PropCount-1 downto 0 do begin
      PropInfo := Props[I];
      {$IFNDEF CLR}
      if CompareText(String(PropInfo.Name), 'OnClick') = 0 then begin
      {$ELSE}
      if SameText(PropInfo.Name, 'OnClick', loInvariantLocale) then begin
      {$ENDIF}
        Method := GetMethodProp(SelItem, PropInfo);
        MethodName := Designer.GetMethodName(Method);
        if MethodName = '' then begin
          MethodName := SelItem.Name + 'Click';
          Method := Designer.CreateMethod(MethodName, GetTypeData(
            {$IFNDEF CLR} PropInfo.PropType^ {$ELSE} PropInfo.TypeInfo {$ENDIF}));
          SetMethodProp(SelItem, PropInfo, Method);
          Designer.Modified;
        end;
        if Designer.MethodExists(MethodName) then
          Designer.ShowMethod(MethodName);
        Break;
      end;
    end;
  {$IFNDEF CLR}
  finally
    FreeMem(Props);
  end;
  {$ENDIF}
end;

procedure TTBItemEditForm.ListViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN: begin
        Key := 0;
        ActivateInspector(#0);
      end;
    VK_INSERT: begin
        Key := 0;
        if ssCtrl in Shift then
          NewSubmenuButtonClick(Sender)
        else
          NewItemButtonClick(Sender);
      end;
    VK_DELETE: begin
        Key := 0;
        Delete;
      end;
  end;
end;

procedure TTBItemEditForm.TreeViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN: begin
        Key := 0;
        ActivateInspector(#0);
      end;
    VK_DELETE: begin
        Key := 0;
        DeleteButtonClick(Sender);
      end;
  end;
end;

procedure TTBItemEditForm.TreeViewKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key >= #33) and (Key <= #126) then begin
    ActivateInspector(Key);
    Key := #0;
  end
  else if Key = #13 then
    Key := #0;  { suppress beep }
end;

procedure TTBItemEditForm.ListViewKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = '-' then begin
    NewSepButtonClick(Sender);
    Key := #0;
  end
  else if (Key >= #33) and (Key <= #126) then begin
    ActivateInspector(Key);
    Key := #0;
  end;
end;

procedure TTBItemEditForm.ListViewDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
{ List item dragged over the list view }
var
  Item: TListItem;
begin
  Accept := False;
  if (Sender = ListView) and (Source = ListView) and (ListView.SelCount = 1) then begin
    Item := ListView.GetItemAt(X, Y);
    if Assigned(Item) and (Item <> ListView.Selected) then
      Accept := True;
  end;
end;

procedure TTBItemEditForm.ListViewDragDrop(Sender, Source: TObject; X,
  Y: Integer);
{ List item dropped onto another list item }
var
  ListItem: TListItem;
  Item: TTBCustomItem;
  NewIndex: Integer;
begin
  if (Sender = ListView) and (Source = ListView) and (ListView.SelCount = 1) then begin
    ListItem := ListView.GetItemAt(X, Y);
    if Assigned(ListItem) and (ListItem <> ListView.Selected) and Assigned(FSelParentItem) then begin
      NewIndex := FSelParentItem.IndexOf(TTBCustomItem(ListItem.Data));
      if NewIndex <> -1 then begin
        ListView.Items.BeginUpdate;
        { For good performance and to prevent Object Inspector flicker, increment
          FSettingSel to prevent calls to SetSelParentItem while moving items }
        Inc(FSettingSel);
        try
          Item := TTBCustomItem(ListView.Selected.Data);
          MoveItem(FSelParentItem.IndexOf(Item), NewIndex);
        finally
          Dec(FSettingSel);
          ListView.Items.EndUpdate;
        end;
        { After decrementing FSettingSel, now call SetSelParentItem, to update
          the toolbar buttons }
        SetSelParentItem(FSelParentItem);
      end;
    end;
  end;
end;

function TTBItemEditForm.TreeViewDragHandler(Sender, Source: TObject;
  X, Y: Integer; Drop: Boolean): Boolean;
var
  Node: TTreeNode;
  ListItem: TListItem;
  Item, NewParentItem: TTBCustomItem;
  ItemList: TList;
  I: Integer;
  NeedRebuildTree: Boolean;
begin
  Result := False;
  if (Sender = TreeView) and (Source = ListView) then begin
    Node := TreeView.GetNodeAt(X, Y);
    if Assigned(Node) and (Node <> TreeView.Selected) then begin
      NewParentItem := TTBCustomItem(Node.Data);
      ItemList := TList.Create;
      try
        ListItem := nil;
        while True do begin
          ListItem := ListView.GetNextItem(ListItem, sdAll, [isSelected]);
          if ListItem = nil then
            Break;
          Item := TTBCustomItem(ListItem.Data);
          if Assigned(Item) and (Item <> NewParentItem) and
             not Item.ContainsItem(NewParentItem) and
             not(Item is TTBControlItem) then begin
            Result := True;
            ItemList.Add(Item);
          end;
        end;
        if Drop then begin
          NeedRebuildTree := False;
          for I := 0 to ItemList.Count-1 do begin
            Item := TTBCustomItem(ItemList[I]);
            Item.Parent.Remove(Item);
            NewParentItem.Add(Item);
            Designer.Modified;
            if IsSubmenuItem(Item) then
              NeedRebuildTree := True;
          end;
          if NeedRebuildTree then
            RebuildTree;
        end;
      finally
        ItemList.Free;
      end;
    end;
  end;
end;

procedure TTBItemEditForm.TreeViewDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
{ List item dragged over the tree view }
begin
  Accept := TreeViewDragHandler(Sender, Source, X, Y, False);
end;

procedure TTBItemEditForm.TreeViewDragDrop(Sender, Source: TObject; X,
  Y: Integer);
{ List item dropped onto the tree view }
begin
  TreeViewDragHandler(Sender, Source, X, Y, True);
end;

procedure TTBItemEditForm.CreateNewItem(const AClass: TTBCustomItemClass);
var
  NewIndex: Integer;
  NewItem: TTBCustomItem;
  ListItem: TListItem;
begin
  if FSelParentItem = nil then Exit;
  NewIndex := -1;
  if (GetKeyState(VK_SHIFT) >= 0) and Assigned(ListView.Selected) then
    NewIndex := FSelParentItem.IndexOf(TTBCustomItem(ListView.Selected.Data));
  if NewIndex = -1 then
    NewIndex := FSelParentItem.Count;
  NewItem := AClass.Create(FParentComponent.Owner{Designer.Form});
  try
    NewItem.Name := Designer.UniqueName(NewItem.ClassName);
    FSelParentItem.Insert(NewIndex, NewItem);
  except
    NewItem.Free;
    raise;
  end;
  Designer.Modified;
  ListView.Selected := nil;
  ListItem := ListView.FindData(0, NewItem, True, False);
  if Assigned(ListItem) then begin
    ListItem.Selected := True;
    ListItem.Focused := True;
    ListItem.MakeVisible(False);
    ListView.SetFocus;
  end;
end;

procedure TTBItemEditForm.NewSubmenuButtonClick(Sender: TObject);
begin
  CreateNewItem(TTBSubmenuItem);
end;

procedure TTBItemEditForm.NewItemButtonClick(Sender: TObject);
begin
  CreateNewItem(TTBItem);
end;

procedure TTBItemEditForm.NewSepButtonClick(Sender: TObject);
begin
  CreateNewItem(TTBSeparatorItem);
end;

procedure TTBItemEditForm.MoreItemClick(Sender: TObject);
begin
  CreateNewItem(TTBCustomItemClass((Sender as TTBItem).Tag));
end;

procedure TTBItemEditForm.CutButtonClick(Sender: TObject);
begin
  Cut;
end;

procedure TTBItemEditForm.CopyButtonClick(Sender: TObject);
begin
  Copy;
end;

procedure TTBItemEditForm.PasteButtonClick(Sender: TObject);
begin
  Paste;
end;

procedure TTBItemEditForm.DeleteButtonClick(Sender: TObject);
begin
  if ActiveControl = ListView then
    Delete
  else if (ActiveControl = TreeView) and (FSelParentItem <> FRootItem) then
    DeleteItem(FSelParentItem);
end;

procedure TTBItemEditForm.MoveUpButtonClick(Sender: TObject);
var
  SelList: TList;
  I, J: Integer;
  Item: TTBCustomItem;
  ListItem: TListItem;
begin
  if FSelParentItem = nil then Exit;
  SelList := TList.Create;
  try
    GetSelItemList(SelList);
    if SelList.Count = 0 then Exit;

    ListView.Items.BeginUpdate;
    FSelParentItem.ViewBeginUpdate;
    { For good performance and to prevent Object Inspector flicker, increment
      FSettingSel to prevent calls to SetSelParentItem while moving items }
    Inc(FSettingSel);
    try
      for I := 0 to SelList.Count-1 do begin
        Item := TTBCustomItem(SelList[I]);
        J := FSelParentItem.IndexOf(Item);
        if J <> -1 then
          MoveItem(J, J-1);
      end;
      ListItem := ListView.FindData(0, SelList[0], True, False);
      if Assigned(ListItem) then
        ListItem.MakeVisible(False);
    finally
      Dec(FSettingSel);
      FSelParentItem.ViewEndUpdate;
      ListView.Items.EndUpdate;
    end;
    { After decrementing FSettingSel, now call SetSelParentItem, to update
      the toolbar buttons }
    SetSelParentItem(FSelParentItem);
  finally
    SelList.Free;
  end;
end;

procedure TTBItemEditForm.MoveDownButtonClick(Sender: TObject);
var
  SelList: TList;
  I, J: Integer;
  Item: TTBCustomItem;
  ListItem: TListItem;
begin
  if FSelParentItem = nil then Exit;
  SelList := TList.Create;
  try
    GetSelItemList(SelList);
    if SelList.Count = 0 then Exit;

    ListView.Items.BeginUpdate;
    FSelParentItem.ViewBeginUpdate;
    { For good performance and to prevent Object Inspector flicker, increment
      FSettingSel to prevent calls to SetSelParentItem while moving items }
    Inc(FSettingSel);
    try
      for I := SelList.Count-1 downto 0 do begin
        Item := TTBCustomItem(SelList[I]);
        J := FSelParentItem.IndexOf(Item);
        if J <> -1 then
          MoveItem(J, J+1);
      end;
      ListItem := ListView.FindData(0, SelList[SelList.Count-1], True, False);
      if Assigned(ListItem) then
        ListItem.MakeVisible(False);
    finally
      Dec(FSettingSel);
      FSelParentItem.ViewEndUpdate;
      ListView.Items.EndUpdate;
    end;
    { After decrementing FSettingSel, now call SetSelParentItem, to update
      the toolbar buttons }
    SetSelParentItem(FSelParentItem);
  finally
    SelList.Free;
  end;
end;

procedure TTBItemEditForm.TConvertMenuClick(Sender: TObject);
begin
  if FSelParentItem = nil then Exit;
  DoConvert(FSelParentItem, FParentComponent.Owner);
end;


{ TTBItemsEditor }

procedure TTBItemsEditor.Edit;
var
  Item: TTBCustomItem;
begin
  if Assigned(Component) then begin
    Item := TBGetItems(Component);
    if Assigned(Item) then
      ShowEditForm(Component, Item, Designer);
  end;
end;

procedure TTBItemsEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: Edit;
    1: ShowVersion;
  end;
end;

function TTBItemsEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

function TTBItemsEditor.GetVerb(Index: Integer): String;
begin
  case Index of
    0: Result := 'Edit...';
    1: Result := 'Version...';
  else
    Result := '';
  end;
end;


{ TTBItemsPropertyEditor }

procedure TTBItemsPropertyEditor.Edit;
var
  Editor: {$IFDEF JR_D6} IComponentEditor {$ELSE} TComponentEditor {$ENDIF};
begin
  if PropCount <> 1 then Exit;
  Editor := GetComponentEditor(GetComponent(0) as TComponent, Designer);
  try
    Editor.Edit;
  finally
    {$IFNDEF JR_D6}
    Editor.Free;
    {$ENDIF}
  end;
end;

function TTBItemsPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paDialog, paReadOnly];
end;

function TTBItemsPropertyEditor.GetValue: String;
begin
  Result := '(TB2000 Items)';
end;

initialization
  ItemImageList := TImageList.Create(nil);
  {$IFNDEF CLR}
  ItemImageList.Handle := ImageList_LoadImage(HInstance, 'TB2_DSGNEDITORIMAGES',
    16, 0, clFuchsia, IMAGE_BITMAP, 0);
  {$ELSE}
  { Initialize the image list as plain ILC_COLOR (4-bit), because on Windows
    2000, at color depths > 16 (what TImageList's ILC_COLORDDB would give us
    when running on a true-color display), selected images are drawn with an
    ugly dithering effect }
  ItemImageList.Handle := ImageList_Create(16, 16, ILC_COLOR or ILC_MASK, 4, 4);
  LoadItemImage(Assembly.GetExecutingAssembly, 'TB2DsgnEditorImages.bmp');
  {$ENDIF}
  ItemClasses := TList.Create;
  {$IFNDEF CLR}
  AddModuleUnloadProc(UnregisterModuleItemClasses);
  {$ENDIF}
finalization
  {$IFNDEF CLR}
  RemoveModuleUnloadProc(UnregisterModuleItemClasses);
  {$ENDIF}
  FreeItemClasses;
  FreeAndNil(ItemImageList);
end.