1. 首頁
  2. 問答
  3. 德爾福XE2中的自定義菜單項目（設計時間）

德爾福XE2中的自定義菜單項目（設計時間）

2012-03-20 39 views
1

我有一個增強的彈出菜單（TOPopupMenu）與定製項目（TOMenuItem）。在Delphi 2007中，我使用TNT的代碼強制delphi設計編輯器在菜單編輯器中創建TOMenuItem。不幸的是，同樣的方法在XE2中不適用於我。德爾福XE2中的自定義菜單項目（設計時間）

有沒有人知道如何在Delphi XE2中做到這一點？

注：

in D2007 TOPopupMenu = class(TTntPopupMenu), TOMenuItem = class(TTntMenuItem) 
in DXE2 TOPopupMenu = class(TPopupMenu), TOMenuItem = class(TMenuItem)
2007年德爾福

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

enter image description here

單位OMenus_Editors在2007年德爾福工作（基本上是從TntUnicodeControls複製）

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

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.

來源

2012-03-20 oxo

回答

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 ([email protected])  } 
{                    } 
{*****************************************************************************} 

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 ([email protected])  } 
{                    } 
{*****************************************************************************} 

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.

來源

2012-03-20 18:49:18 oxo

相關問題

 相關問題