expmenu.pas

Delphi高级开发指南是开发程序的好帮手

unit ExpMenu;

interface

uses
  Windows, Classes, Dialogs, ExptIntf, ToolIntf,
  FileCtrl, SysUtils;

type
  // standard expert
  TExpMenu = class (TIExpert)
  public
    function GetStyle: TExpertStyle; override;
    function GetName: string; override;
    function GetAuthor: string; override;
    function GetComment: string; override;
    function GetPage: string; override;
    function GetGlyph: HICON; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;
    procedure Execute; override;
    procedure AddSubItems (StrOut: TStrings;
      Item: TIMenuItemIntf; Level: Integer);
  end;

procedure Register;

implementation

function TExpMenu.GetStyle: TExpertStyle;
begin
  // show up in the Help menu
  Result := esStandard;
end;

function TExpMenu.GetName: String;
begin
  // official name
  Result := 'Delphi Menu Wizard'
end;

function TExpMenu.GetAuthor: string;
begin
  Result := 'Marco and Tim';
end;

function TExpMenu.GetComment: String;
begin
  Result := 'Delphi Menu Wizard';
end;

function TExpMenu.GetPage: string;
begin
  Result := '';
end;

function TExpMenu.GetGlyph: HICON;
begin
  Result := 0;
end;

function TExpMenu.GetState: TExpertState;
begin
  // always enabled, never checked
  Result := [esEnabled];
end;

function TExpMenu.GetIDString: String;
begin
  // must be unique
  Result := 'DDHandbook.MenuWizard'
end;

function TExpMenu.GetMenuText: String;
begin
  // the text of the menu item
  Result := '&Delphi Menu Wizard'
end;

procedure TExpMenu.Execute;
var
  MainMenu: TIMenuItemIntf;
  StrOut: TStrings;
  SaveDial: TSaveDialog;
begin
  MainMenu := ToolServices.GetMainMenu.GetMenuItems;
  StrOut := TStringList.Create;
  try
    AddSubItems (StrOut, MainMenu, 0);
    SaveDial := TSaveDialog.Create (nil);
    try
      SaveDial.DefaultExt := 'txt';
      SaveDial.Filter := 'Text file (*.txt)|*.txt';
      if SaveDial.Execute then
        StrOut.SaveToFile (SaveDial.FileName);
    finally
      SaveDial.Free;
    end;
  finally
    StrOut.Free;
  end;
end;

procedure TExpMenu.AddSubItems (StrOut: TStrings;
  Item: TIMenuItemIntf; Level: Integer);
var
  I: Integer;
  NewItem: TIMenuItemIntf;
begin
  for I := 0 to Item.GetItemCount - 1 do
  begin
    Newitem := Item.GetItem (I);
    // if there are subitems insert a blank line
    if NewItem.GetItemCount > 0 then
      StrOut.Add ('');
    StrOut.Add (Format ('%s%d'#9'%s'#9'%s',
      [StringOfChar (' ', Level*2),
      NewItem.GetIndex,
      NewItem.GetCaption,
      NewItem.GetName]));
    AddSubItems (StrOut, NewItem, Level + 1);
  end;
end;

procedure Register;
begin
  RegisterLibraryExpert(TExpMenu.Create);
end;

end.