Delphi XE2中的自定义菜单项（设计时）

时间：2012-03-20 10:44:47

标签： delphi menu design-time

我有一个带有自定义项目（TOMenuItem）的增强弹出菜单（TOPopupMenu）。在Delphi 2007中，我使用TNT的代码强制delphi设计编辑器在菜单编辑器中创建TOMenuItem。不幸的是，在XE2中，同样的方法对我不起作用。

有人知道如何在Delphi XE2中执行此操作吗？

注意：

in D2007 TOPopupMenu = class(TTntPopupMenu), TOMenuItem = class(TTntMenuItem)
in DXE2 TOPopupMenu = class(TPopupMenu), TOMenuItem = class(TMenuItem)

Delphi 2007：
http://s15.postimage.org/rzd4sc8pn/delphi_menu.png

enter image description here

在Delphi 2007中运行的单元OMenus_Editors（基本上是从TntUnicodeControls复制的）

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
{                                                                             }
{*****************************************************************************}

unit OMenus_Editors;

{$INCLUDE ..\TntUnicodeControls\Source\TntCompilers.inc}

{*******************************************************}
{  Special Thanks to Francisco Leong for getting these  }
{    menu designer enhancements to work w/o MnuBuild.   }
{*******************************************************}

interface

{$IFDEF COMPILER_6}     // Delphi 6 and BCB 6 have MnuBuild available
  {$DEFINE MNUBUILD_AVAILABLE}
{$ENDIF}

{$IFDEF COMPILER_7}     // Delphi 7 has MnuBuild available
  {$DEFINE MNUBUILD_AVAILABLE}
{$ENDIF}

uses
  Windows, Classes, Menus, Messages,
  {$IFDEF MNUBUILD_AVAILABLE} MnuBuild, {$ENDIF}
  DesignEditors, DesignIntf;

type
  TOMenuEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string{TNT-ALLOW string}; override;
    function GetVerbCount: Integer; override;
  end;

procedure Register;

implementation

uses
  {$IFDEF MNUBUILD_AVAILABLE} MnuConst, {$ELSE} DesignWindows, {$ENDIF} SysUtils, Graphics, ActnList,
  Controls, Forms, TntDesignEditors_Design, TntActnList, TntMenus, OPopupMenu;

procedure Register;
begin
  //RegisterComponentEditor(TMainMenu, TOMenuEditor);
  RegisterComponentEditor(TOPopupMenu, TOMenuEditor);
end;

function GetMenuBuilder: TForm{TNT-ALLOW TForm};
{$IFDEF MNUBUILD_AVAILABLE}
begin
  Result := MenuEditor;
{$ELSE}
var
  Comp: TComponent;
begin
  Result := nil;
  if Application <> nil then
  begin
    Comp := Application.FindComponent('MenuBuilder');
    if Comp is TForm{TNT-ALLOW TForm} then
      Result := TForm{TNT-ALLOW TForm}(Comp);
  end;
{$ENDIF}
end;

{$IFDEF DELPHI_9} // verified against Delphi 9
type
  THackMenuBuilder = class(TDesignWindow)
  protected
    Fields: array[1..26] of TObject;
    FWorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
  end;
{$ENDIF}

{$IFDEF COMPILER_10_UP}
{$IFDEF DELPHI_10} // NOT verified against Delphi 10
type
  THackMenuBuilder = class(TDesignWindow)
  protected
    Fields: array[1..26] of TObject;
    FWorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
  end;
{$ENDIF}
{$ENDIF}

function GetMenuBuilder_WorkMenu(MenuBuilder: TForm{TNT-ALLOW TForm}): TMenuItem{TNT-ALLOW TMenuItem};
begin
  if MenuBuilder = nil then
    Result := nil
  else begin
    {$IFDEF MNUBUILD_AVAILABLE}
    Result := MenuEditor.WorkMenu;
    {$ELSE}
    Result := THackMenuBuilder(MenuBuilder).FWorkMenu;
    Assert((Result = nil) or (Result is TMenuItem{TNT-ALLOW TMenuItem}),
      'TNT Internal Error: THackMenuBuilder has incorrect internal layout.');
    {$ENDIF}
  end;
end;

{$IFDEF DELPHI_9} // verified against Delphi 9
type
  THackMenuItemWin = class(TCustomControl)
  protected
    FxxxxCaptionExtent: Integer;
    FMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
  end;
{$ENDIF}

{$IFDEF DELPHI_10} // beta: NOT verified against Delphi 10
type
  THackMenuItemWin = class(TCustomControl)
  protected
    FxxxxCaptionExtent: Integer;
    FMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
  end;
{$ENDIF}

function GetMenuItem(Control: TWinControl; DoVerify: Boolean = True): TMenuItem{TNT-ALLOW TMenuItem};
begin
  {$IFDEF MNUBUILD_AVAILABLE}
  if Control is TMenuItemWin then
    Result := TMenuItemWin(Control).MenuItem
  {$ELSE}
  if Control.ClassName = 'TMenuItemWin' then begin
    Result := THackMenuItemWin(Control).FMenuItem;
    Assert((Result = nil) or (Result is TMenuItem{TNT-ALLOW TMenuItem}), 'TNT Internal Error: Unexpected TMenuItem field layout.');
  end
  {$ENDIF}
  else if DoVerify then
    raise Exception.Create('TNT Internal Error: Control is not a TMenuItemWin.')
  else
    Result := nil;
end;

procedure SetMenuItem(Control: TWinControl; Item: TMenuItem{TNT-ALLOW TMenuItem});
begin
  {$IFDEF MNUBUILD_AVAILABLE}
  if Control is TMenuItemWin then
    TMenuItemWin(Control).MenuItem := Item
  {$ELSE}
  if Control.ClassName = 'TMenuItemWin' then begin
    THackMenuItemWin(Control).FMenuItem := Item;
    Item.FreeNotification(Control);
  end
  {$ENDIF}
  else
    raise Exception.Create('TNT Internal Error: Control is not a TMenuItemWin.');
end;

procedure ReplaceMenuItem(Control: TWinControl; ANewItem: TMenuItem{TNT-ALLOW TMenuItem});
var
  OldItem: TMenuItem{TNT-ALLOW TMenuItem};
  OldName: string{TNT-ALLOW string};
begin
  OldItem := GetMenuItem(Control, True);
  Assert(OldItem <> nil);
  OldName := OldItem.Name;
  FreeAndNil(OldItem);
  ANewItem.Name := OldName; { assume old name }
  SetMenuItem(Control, ANewItem);
end;

{ TTntMenuBuilderChecker }

type
  TMenuBuilderChecker = class(TComponent)
  private
    FMenuBuilder: TForm{TNT-ALLOW TForm};
    FCheckMenuAction: TTntAction;
    FLastCaption: string{TNT-ALLOW string};
    FLastActiveControl: TControl;
    FLastMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
    procedure CheckMenuItems(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var MenuBuilderChecker: TMenuBuilderChecker = nil;

constructor TMenuBuilderChecker.Create(AOwner: TComponent);
begin
  inherited;
  MenuBuilderChecker := Self;
  FCheckMenuAction := TTntAction.Create(Self);
  FCheckMenuAction.OnUpdate := CheckMenuItems;
  FCheckMenuAction.OnExecute := CheckMenuItems;
  FMenuBuilder := AOwner as TForm{TNT-ALLOW TForm};
  FMenuBuilder.Action := FCheckMenuAction;
end;

destructor TMenuBuilderChecker.Destroy;
begin
  FMenuBuilder := nil;
  MenuBuilderChecker := nil;
  inherited;
end;

type TAccessOMenuItem = class(TOMenuItem);

function CreateOMenuItem(OldItem: TMenuItem{TNT-ALLOW TMenuItem}): TOMenuItem;
var
  OldName: AnsiString;
  OldParent: TMenuItem{TNT-ALLOW TMenuItem};
  OldIndex: Integer;
  OldItemsList: TList;
  j: integer;
begin
  // item should be converted.
  OldItemsList := TList.Create;
  try
    // clone properties
    Result := TOMenuItem.Create(OldItem.Owner);
    TAccessOMenuItem(Result).FComponentStyle := OldItem.ComponentStyle; {csTransient hides item from object inspector}
    Result.Action := OldItem.Action;
    Result.AutoCheck := OldItem.AutoCheck;
    Result.AutoHotkeys := OldItem.AutoHotkeys;
    Result.AutoLineReduction := OldItem.AutoLineReduction;
    Result.Bitmap := OldItem.Bitmap;
    Result.Break := OldItem.Break;
    Result.Caption := OldItem.Caption;
    Result.Checked := OldItem.Checked;
    Result.Default := OldItem.Default;
    Result.Enabled := OldItem.Enabled;
    Result.GroupIndex := OldItem.GroupIndex;
    Result.HelpContext := OldItem.HelpContext;
    Result.Hint := OldItem.Hint;
    Result.ImageIndex := OldItem.ImageIndex;
    Result.MenuIndex := OldItem.MenuIndex;
    Result.RadioItem := OldItem.RadioItem;
    Result.ShortCut := OldItem.ShortCut;
    Result.SubMenuImages := OldItem.SubMenuImages;
    Result.Visible := OldItem.Visible;
    Result.Tag := OldItem.Tag;

    // clone events
    Result.OnAdvancedDrawItem := OldItem.OnAdvancedDrawItem;
    Result.OnClick := OldItem.OnClick;
    Result.OnDrawItem := OldItem.OnDrawItem;
    Result.OnMeasureItem := OldItem.OnMeasureItem;

    // remember name, parent, index, children
    OldName := OldItem.Name;
    OldParent := OldItem.Parent;
    OldIndex := OldItem.MenuIndex;
    for j := OldItem.Count - 1 downto 0 do begin
      OldItemsList.Insert(0, OldItem.Items[j]);
      OldItem.Remove(OldItem.Items[j]);
    end;

    // clone final parts of old item
    for j := 0 to OldItemsList.Count - 1 do
      Result.Add(TMenuItem{TNT-ALLOW TMenuItem}(OldItemsList[j])); { add children }
    if OldParent <> nil then
      OldParent.Insert(OldIndex, Result); { insert into parent }
  finally
    OldItemsList.Free;
  end;
end;

procedure CheckMenuItemWin(MenuItemWin: TWinControl; PartOfATntMenu: Boolean);
var
  OldItem: TMenuItem{TNT-ALLOW TMenuItem};
begin
  OldItem := GetMenuItem(MenuItemWin);
  if OldItem = nil then
    exit;
  if (OldItem.ClassType = TMenuItem{TNT-ALLOW TMenuItem})
  and (PartOfATntMenu or (OldItem.Parent is TOMenuItem)) then
  begin
    if MenuItemWin.Focused then
      MenuItemWin.Parent.SetFocus;  {Lose focus and regain later to ensure object inspector gets updated.}
    ReplaceMenuItem(MenuItemWin, CreateOMenuItem(OldItem));
  end else if (OldItem.ClassType = TOMenuItem)
  and (OldItem.Parent = nil) and (OldItem.Caption = '') and (OldItem.Name = '')
  and not (PartOfATntMenu or (OldItem.Parent is TOMenuItem)) then begin
    if MenuItemWin.Focused then
      MenuItemWin.Parent.SetFocus;  {Lose focus and regain later to ensure object inspector gets updated.}
    ReplaceMenuItem(MenuItemWin, TMenuItem{TNT-ALLOW TMenuItem}.Create(OldItem.Owner));
  end;
end;

procedure TMenuBuilderChecker.CheckMenuItems(Sender: TObject);
var
  a, i: integer;
  MenuWin: TWinControl;
  MenuItemWin: TWinControl;
  SaveFocus: HWND;
  PartOfATntMenu: Boolean;
  WorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
begin
  if (FMenuBuilder <> nil)
  and (FMenuBuilder.Action = FCheckMenuAction) then begin
    if (FLastCaption <> FMenuBuilder.Caption)
    or (FLastActiveControl <> FMenuBuilder.ActiveControl)
    or (FLastMenuItem <> GetMenuItem(FMenuBuilder.ActiveControl, False))
    then begin
      try
        try
          with FMenuBuilder do begin
            WorkMenu := GetMenuBuilder_WorkMenu(FMenuBuilder);
            PartOfATntMenu := (WorkMenu <> nil)
              and ((WorkMenu.Owner is TTntMainMenu) or (WorkMenu.Owner is TTntPopupMenu));
            SaveFocus := Windows.GetFocus;
            for a := ComponentCount - 1 downto 0 do begin
              {$IFDEF MNUBUILD_AVAILABLE}
              if Components[a] is TMenuWin then begin
              {$ELSE}
              if Components[a].ClassName = 'TMenuWin' then begin
              {$ENDIF}
                MenuWin := Components[a] as TWinControl;
                with MenuWin do begin
                  for i := ComponentCount - 1 downto 0 do begin
                    {$IFDEF MNUBUILD_AVAILABLE}
                    if Components[i] is TMenuItemWin then begin
                    {$ELSE}
                    if Components[i].ClassName = 'TMenuItemWin' then begin
                    {$ENDIF}
                      MenuItemWin := Components[i] as TWinControl;
                      CheckMenuItemWin(MenuItemWin, PartOfATntMenu);
                    end;
                  end;
                end;
              end;
            end;
            if SaveFocus <> Windows.GetFocus then
              Windows.SetFocus(SaveFocus);
          end;
        except
          on E: Exception do begin
            FMenuBuilder.Action := nil;
          end;
        end;
      finally
        FLastCaption := FMenuBuilder.Caption;
        FLastActiveControl := FMenuBuilder.ActiveControl;
        FLastMenuItem := GetMenuItem(FMenuBuilder.ActiveControl, False);
      end;
    end;
  end;
end;

{ TOMenuEditor }

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

{$IFNDEF MNUBUILD_AVAILABLE}
resourcestring
  SMenuDesigner = 'Menu Designer...';
{$ENDIF}

function TOMenuEditor.GetVerb(Index: Integer): string{TNT-ALLOW string};
begin
  Result := SMenuDesigner;
end;

procedure TOMenuEditor.ExecuteVerb(Index: Integer);
var
  MenuBuilder: TForm{TNT-ALLOW TForm};
begin
  EditPropertyWithDialog(Component, 'Items', Designer);
  MenuBuilder := GetMenuBuilder;
  if Assigned(MenuBuilder) then begin
    if (MenuBuilderChecker = nil) or (MenuBuilderChecker.FMenuBuilder <> MenuBuilder) then begin
      MenuBuilderChecker.Free;
      MenuBuilderChecker := TMenuBuilderChecker.Create(MenuBuilder);
    end;
    EditPropertyWithDialog(Component, 'Items', Designer); // update menu builder caption
  end;
end;

initialization

finalization
  if Assigned(MenuBuilderChecker) then
    FreeAndNil(MenuBuilderChecker); // design package might be recompiled

end.

1 个答案:

答案 0 :(得分：0)

我明白了。问题出在THackMenuBuilder上。此代码适用于D2007和DXE2。

如果他写自定义菜单，也许有人觉得它很有用。

OMenus_Editors.pas：

{*****************************************************************************}
{                                                                             }
{    Modified by oxo (http://www.kluug.at)                                    }
{                                                                             }
{    Original Code (TntMenus_Editors.pas)                                     }
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
{                                                                             }
{*****************************************************************************}

unit OMenus_Editors;

{*******************************************************}
{  Special Thanks to Francisco Leong for getting these  }
{    menu designer enhancements to work w/o MnuBuild.   }
{*******************************************************}

interface

{$IFDEF VER150}//Delphi 7
  {$DEFINE MNUBUILD_AVAILABLE}
{$ENDIF}
{$IFDEF VER140}//Delphi 6
  {$DEFINE MNUBUILD_AVAILABLE}
{$ENDIF}

uses
  Windows, Classes, Menus, Messages,
  {$IFDEF MNUBUILD_AVAILABLE} MnuBuild, {$ENDIF}
  DesignEditors, DesignIntf;

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

procedure Register;

implementation

uses
  {$IFDEF MNUBUILD_AVAILABLE} MnuConst, {$ELSE} DesignWindows, {$ENDIF} SysUtils, Graphics, ActnList,
  Controls, Forms, OPopupMenu, ODesignEditors_Design, Dialogs;

procedure Register;
begin
  RegisterComponentEditor(TOPopupMenu, TOMenuEditor);
end;

function GetMenuBuilder: TCustomForm;
{$IFDEF MNUBUILD_AVAILABLE}
begin
  Result := MenuEditor;
{$ELSE}
var
  Comp: TComponent;
begin
  Result := nil;
  if Application <> nil then
  begin
    Comp := Application.FindComponent('MenuBuilder');
    if Comp is TCustomForm then begin
      Result := TCustomForm(Comp);
    end;
  end;
{$ENDIF}
end;

type
  THackMenuBuilder = class(TDesignWindow)
  protected
    Fields: array[0..49] of TObject;
  end;

function GetMenuBuilder_WorkMenu(MenuBuilder: TCustomForm): TMenuItem;
var I: Integer;
begin
  if MenuBuilder = nil then
    Result := nil
  else begin
    {$IFDEF MNUBUILD_AVAILABLE}
    Result := MenuEditor.WorkMenu;
    {$ELSE}
    Result := nil;
    for I := 25 to 35 do begin
      try
      if THackMenuBuilder(MenuBuilder).Fields[I] is TMenuItem then
        Result := TMenuItem(THackMenuBuilder(MenuBuilder).Fields[I]);
      except
      end;
    end;

    Assert((Result = nil) or (Result is TMenuItem),
      'OMenus Internal Error: THackMenuBuilder has incorrect internal layout.');
    {$ENDIF}
  end;
end;

type
  THackMenuItemWin = class(TCustomControl)
  protected
    FxxxxCaptionExtent: Integer;
    FMenuItem: TMenuItem;
  end;

function GetMenuItem(Control: TWinControl; DoVerify: Boolean = True): TMenuItem;
begin
  {$IFDEF MNUBUILD_AVAILABLE}
  if Control is TMenuItemWin then
    Result := TMenuItemWin(Control).MenuItem
  {$ELSE}
  if Control.ClassName = 'TMenuItemWin' then begin
    Result := THackMenuItemWin(Control).FMenuItem;
    Assert((Result = nil) or (Result is TMenuItem), 'OMenus Internal Error: Unexpected TMenuItem field layout.');
  end
  {$ENDIF}
  else if DoVerify then
    raise Exception.Create('OMenus Internal Error: Control is not a TMenuItemWin.')
  else
    Result := nil;
end;

procedure SetMenuItem(Control: TWinControl; Item: TMenuItem);
begin
  {$IFDEF MNUBUILD_AVAILABLE}
  if Control is TMenuItemWin then
    TMenuItemWin(Control).MenuItem := Item
  {$ELSE}
  if Control.ClassName = 'TMenuItemWin' then begin
    THackMenuItemWin(Control).FMenuItem := Item;
    Item.FreeNotification(Control);
  end
  {$ENDIF}
  else
    raise Exception.Create('OMenus Internal Error: Control is not a TMenuItemWin.');
end;

procedure ReplaceMenuItem(Control: TWinControl; ANewItem: TMenuItem);
var
  OldItem: TMenuItem;
  OldName: string;
begin
  OldItem := GetMenuItem(Control, True);
  Assert(OldItem <> nil);
  OldName := OldItem.Name;
  FreeAndNil(OldItem);
  ANewItem.Name := OldName; { assume old name }
  SetMenuItem(Control, ANewItem);
end;

{ TMenuBuilderChecker }

type
  TMenuBuilderChecker = class(TComponent)
  private
    FMenuBuilder: TCustomForm;
    FCheckMenuAction: TAction;
    FLastCaption: string;
    FLastActiveControl: TControl;
    FLastMenuItem: TMenuItem;
    procedure CheckMenuItems(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var MenuBuilderChecker: TMenuBuilderChecker = nil;

constructor TMenuBuilderChecker.Create(AOwner: TComponent);
begin
  inherited;
  MenuBuilderChecker := Self;
  FCheckMenuAction := TAction.Create(Self);
  FCheckMenuAction.OnUpdate := CheckMenuItems;
  FCheckMenuAction.OnExecute := CheckMenuItems;
  FMenuBuilder := AOwner as TCustomForm;
  FMenuBuilder.Action := FCheckMenuAction;
end;

destructor TMenuBuilderChecker.Destroy;
begin
  FMenuBuilder := nil;
  MenuBuilderChecker := nil;
  inherited;
end;

type TAccessOMenuItem = class(TOMenuItem);

function CreateOMenuItem(OldItem: TMenuItem): TOMenuItem;
var
  OldName: AnsiString;
  OldParent: TMenuItem;
  OldIndex: Integer;
  OldItemsList: TList;
  j: integer;
begin
  // item should be converted.
  OldItemsList := TList.Create;
  try
    // clone properties
    Result := TOMenuItem.Create(OldItem.Owner);
    TAccessOMenuItem(Result).FComponentStyle := OldItem.ComponentStyle; {csTransient hides item from object inspector}
    Result.Action := OldItem.Action;
    Result.AutoCheck := OldItem.AutoCheck;
    Result.AutoHotkeys := OldItem.AutoHotkeys;
    Result.AutoLineReduction := OldItem.AutoLineReduction;
    Result.Bitmap := OldItem.Bitmap;
    Result.Break := OldItem.Break;
    Result.Caption := OldItem.Caption;
    Result.Checked := OldItem.Checked;
    Result.Default := OldItem.Default;
    Result.Enabled := OldItem.Enabled;
    Result.GroupIndex := OldItem.GroupIndex;
    Result.HelpContext := OldItem.HelpContext;
    Result.Hint := OldItem.Hint;
    Result.ImageIndex := OldItem.ImageIndex;
    Result.MenuIndex := OldItem.MenuIndex;
    Result.RadioItem := OldItem.RadioItem;
    Result.ShortCut := OldItem.ShortCut;
    Result.SubMenuImages := OldItem.SubMenuImages;
    Result.Visible := OldItem.Visible;
    Result.Tag := OldItem.Tag;

    // clone events
    Result.OnAdvancedDrawItem := OldItem.OnAdvancedDrawItem;
    Result.OnClick := OldItem.OnClick;
    Result.OnDrawItem := OldItem.OnDrawItem;
    Result.OnMeasureItem := OldItem.OnMeasureItem;

    // remember name, parent, index, children
    OldName := OldItem.Name;
    OldParent := OldItem.Parent;
    OldIndex := OldItem.MenuIndex;
    for j := OldItem.Count - 1 downto 0 do begin
      OldItemsList.Insert(0, OldItem.Items[j]);
      OldItem.Remove(OldItem.Items[j]);
    end;

    // clone final parts of old item
    for j := 0 to OldItemsList.Count - 1 do
      Result.Add(TMenuItem(OldItemsList[j])); { add children }
    if OldParent <> nil then
      OldParent.Insert(OldIndex, Result); { insert into parent }
  finally
    OldItemsList.Free;
  end;
end;

procedure CheckMenuItemWin(MenuItemWin: TWinControl; PartOfAMenu: Boolean);
var
  OldItem: TMenuItem;
begin
  OldItem := GetMenuItem(MenuItemWin);
  if OldItem = nil then
    exit;
  if (OldItem.ClassType = TMenuItem)
  and (PartOfAMenu or (OldItem.Parent is TOMenuItem)) then
  begin
    if MenuItemWin.Focused then
      MenuItemWin.Parent.SetFocus;  {Lose focus and regain later to ensure object inspector gets updated.}
    ReplaceMenuItem(MenuItemWin, CreateOMenuItem(OldItem));
  end else if (OldItem.ClassType = TOMenuItem)
  and (OldItem.Parent = nil) and (OldItem.Caption = '') and (OldItem.Name = '')
  and not (PartOfAMenu or (OldItem.Parent is TOMenuItem)) then begin
    if MenuItemWin.Focused then
      MenuItemWin.Parent.SetFocus;  {Lose focus and regain later to ensure object inspector gets updated.}
    ReplaceMenuItem(MenuItemWin, TMenuItem.Create(OldItem.Owner));
  end;
end;

procedure TMenuBuilderChecker.CheckMenuItems(Sender: TObject);
var
  a, i: integer;
  MenuWin: TWinControl;
  MenuItemWin: TWinControl;
  SaveFocus: HWND;
  PartOfAMenu: Boolean;
  WorkMenu: TMenuItem;
begin
  if (FMenuBuilder <> nil)
  and (FMenuBuilder.Action = FCheckMenuAction) then begin
    if (FLastCaption <> FMenuBuilder.Caption)
    or (FLastActiveControl <> FMenuBuilder.ActiveControl)
    or (FLastMenuItem <> GetMenuItem(FMenuBuilder.ActiveControl, False))
    then begin
      try
        try
          with FMenuBuilder do begin
            WorkMenu := GetMenuBuilder_WorkMenu(FMenuBuilder);
            PartOfAMenu := (WorkMenu <> nil)
              and ((WorkMenu.Owner is TMainMenu) or (WorkMenu.Owner is TPopupMenu));
            //ShowMessage('CheckMenuItems: ' + BoolToStr((WorkMenu <> nil), True));
            SaveFocus := Windows.GetFocus;
            for a := ComponentCount - 1 downto 0 do begin
              {$IFDEF MNUBUILD_AVAILABLE}
              if Components[a] is TMenuWin then begin
              {$ELSE}
              if Components[a].ClassName = 'TMenuWin' then begin
              {$ENDIF}
                MenuWin := Components[a] as TWinControl;
                with MenuWin do begin
                  for i := ComponentCount - 1 downto 0 do begin
                    {$IFDEF MNUBUILD_AVAILABLE}
                    if Components[i] is TMenuItemWin then begin
                    {$ELSE}
                    if Components[i].ClassName = 'TMenuItemWin' then begin
                    {$ENDIF}
                      MenuItemWin := Components[i] as TWinControl;
                      CheckMenuItemWin(MenuItemWin, PartOfAMenu);
                    end;
                  end;
                end;
              end;
            end;
            if SaveFocus <> Windows.GetFocus then
              Windows.SetFocus(SaveFocus);
          end;
        except
          on E: Exception do begin
            FMenuBuilder.Action := nil;
          end;
        end;
      finally
        FLastCaption := FMenuBuilder.Caption;
        FLastActiveControl := FMenuBuilder.ActiveControl;
        FLastMenuItem := GetMenuItem(FMenuBuilder.ActiveControl, False);
      end;
    end;
  end;
end;

{ TOMenuEditor }

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

{$IFNDEF MNUBUILD_AVAILABLE}
resourcestring
  SMenuDesigner = 'Menu Designer...';
{$ENDIF}

function TOMenuEditor.GetVerb(Index: Integer): string;
begin
  Result := SMenuDesigner;
end;

procedure TOMenuEditor.ExecuteVerb(Index: Integer);
var
  MenuBuilder: TCustomForm;
begin
  EditPropertyWithDialog(Component, 'Items', Designer);
  MenuBuilder := GetMenuBuilder;
  if Assigned(MenuBuilder) then begin
    if (MenuBuilderChecker = nil) or (MenuBuilderChecker.FMenuBuilder <> MenuBuilder) then begin
      MenuBuilderChecker.Free;
      MenuBuilderChecker := TMenuBuilderChecker.Create(MenuBuilder);
    end;
    EditPropertyWithDialog(Component, 'Items', Designer); // update menu builder caption
  end;
end;

initialization

finalization
  if Assigned(MenuBuilderChecker) then
    FreeAndNil(MenuBuilderChecker); // design package might be recompiled

end.

ODesignEditors_Design.pas：

{*****************************************************************************}
{                                                                             }
{    Modified by oxo (http://www.kluug.at)                                    }
{                                                                             }
{    Original Code (ODesignEditors_Design.pas)                                }
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
{                                                                             }
{*****************************************************************************}

unit ODesignEditors_Design;

interface

uses
  Classes, Forms, TypInfo, DesignIntf, DesignEditors;

procedure EditPropertyWithDialog(Component: TPersistent; const PropName: String; const Designer: IDesigner);

implementation

uses
  SysUtils;

{ TPropertyEditorWithDialog }
type
  TPropertyEditorWithDialog = class
  private
    FPropName: String;
    procedure CheckEditProperty(const Prop: IProperty);
    procedure EditProperty(Component: TPersistent; const PropName: String; const Designer: IDesigner);
  end;

procedure TPropertyEditorWithDialog.CheckEditProperty(const Prop: IProperty);
begin
  if Prop.GetName = FPropName then
    Prop.Edit;
end;

procedure TPropertyEditorWithDialog.EditProperty(Component: TPersistent; const PropName: String; const Designer: IDesigner);
var
  Components: IDesignerSelections;
begin
  FPropName := PropName;
  Components := TDesignerSelections.Create;
  Components.Add(Component);
  GetComponentProperties(Components, [tkClass], Designer, CheckEditProperty);
end;

procedure EditPropertyWithDialog(Component: TPersistent; const PropName: String; const Designer: IDesigner);
begin
  with TPropertyEditorWithDialog.Create do
  try
    EditProperty(Component, PropName, Designer);
  finally
    Free;
  end;
end;

end.
相关问题
最新问题