regmenudesign.pas

一个DELPHI下的菜单构件

{*******************************************************}
{                                                       }
{ 应用系统主界面，主菜单动态生成模块.                   }
{                                                       }
{ 菜单项描述在一个xml文件中 XML Document Support 。     }
{ 本单元最后有应用举例。                                }
{                                                       }
{ 版本v1.0                    Copyright (c) 2003 ICSS   }
{*******************************************************}
//修改纪录： 每次修改 版本号加1
// 修改人   修改日期     修改内容
//
//------------------------------------------------------
unit RegMenuDesign;

interface

uses
  Windows, Classes, Forms, Dialogs, Controls, ImgList, SysUtils, Menus,
  ActiveX, xmldom, XMLIntf, msxmldom, XMLDoc, TypInfo, Variants,
  DesignIntf, DesignEditors;

type
  TCreateMenuItemEvent = procedure(sMunuID, sCaption: String; iTag: Integer; var bVisible: Boolean) of object;  //wangji 20030901

  TMenuDesign = class(TComponent)
  private
    { Private declarations }
    FDllsList: TStringList; //记录所有dll的handle
    FImages: TImageList;
    FXMLMenuFile: string;
    FMainMenu: TMainMenu;
    FPopupMenu: TPopupMenu;
    FOnMenuItemClick: TNotifyEvent;
    FOnCreateMenuItemEvent: TCreateMenuItemEvent;

    //wangji 20030606: 应用主菜单响应事件，调用相应的应用程序的接口
    procedure AppMenuEventClick(Sender: TObject);  

    procedure SetImages(const Value: TImageList);
    procedure SetXMLMenuFile(const Value: string);
    procedure SetMainMenu(const Value: TMainMenu);
    procedure SetPopupMenu(const Value: TPopupMenu);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DyXMLMainMenu: Boolean;
    function DyXMLPopupMenu: Boolean;
    function MainMenuFromStreem(XMLStream: TStream): Boolean;
    function PopupMenuFromStreem(XMLStream: TStream): Boolean;

    function CreateMenuFromStream(mMenu: TMenu; XMLStream: TStream): Boolean;
    function XMLCreateMenu(mMenu: TMenu; FXMLFile: string): Boolean;
    procedure XML2Menu(mMenu: TMenu; FXMLDoc: TXMLDocument);
    procedure DynamicMenuItem(mMenu: TMenu; CurItem: TMenuItem; CurNode: IXMLNode);

    //wangji 20030606:
    function GetFarProcFunc(sDllName, sFuncName: String): FARPROC;
  published
    { Published declarations }
    property Images: TImageList read FImages write SetImages;
    property XMLMenuFile: string read FXMLMenuFile write SetXMLMenuFile;
    property MainMenu: TMainMenu read FMainMenu write SetMainMenu;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnMenuItemClick: TNotifyEvent read FOnMenuItemClick write FOnMenuItemClick;
    property OnCreateMenuItemEvent: TCreateMenuItemEvent read FOnCreateMenuItemEvent write FOnCreateMenuItemEvent;
  end;

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

procedure Register;

implementation

uses unt_FrmMenuDesign, unt_XMLMenu;

procedure Register;
begin
  RegisterComponents('MenuDesign', [TMenuDesign]);
  RegisterComponentEditor(TMenuDesign, TMenuDesignEditor);
end;

{ TMenuDesignEditor }

procedure TMenuDesignEditor.ExecuteVerb(Index: Integer);
var
  fMD: TFrmMenuDesign;
  TempImageList: TImageList;
  TempFile: string;
begin
  case Index of
    0:
    begin
      fMD := TFrmMenuDesign.Create(Application); // wangji modify 20030606:  Component  nil
      try
        fMD.Tag := LongInt(Component);

        TempImageList := (Component as TMenuDesign).FImages;
        if Assigned(TempImageList) then
          fMD.ImageList1 := TempImageList;
        TempFile := (Component as TMenuDesign).FXMLMenuFile;
        fMD.CurXMLFile := TempFile;
        fMD.ShowModal;
      finally
        fMD.Free;
      end;
    end;
  end;
  inherited;
end;

function TMenuDesignEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'MenuDesignEditor';
  end;
end;

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






{ TMenuDesign }
//private routine
procedure TMenuDesign.AppMenuEventClick(Sender: TObject);
begin
  if Assigned(FOnMenuItemClick) then FOnMenuItemClick(Sender);
end;

procedure TMenuDesign.SetImages(const Value: TImageList);
begin
  FImages := Value;
end;

procedure TMenuDesign.SetXMLMenuFile(const Value: string);
begin
  FXMLMenuFile := Value;
end;

procedure TMenuDesign.SetMainMenu(const Value: TMainMenu);
begin
  FMainMenu := Value;
end;

procedure TMenuDesign.SetPopupMenu(const Value: TPopupMenu);
begin
  FPopupMenu := Value;
end;

//public routine
constructor TMenuDesign.Create(AOwner: TComponent);
begin
  inherited;

  FDllsList := TStringList.Create;
end;

destructor TMenuDesign.Destroy;
var
  i: Integer;
  hMod: THandle; //dll的handle
  OwnerForm: TForm;
begin
  //1.释放当前所有没有关闭的MDI窗体
  if (Owner is TForm) then
  begin
    OwnerForm := Owner as TForm;
    for i := OwnerForm.MDIChildCount - 1 downto 0 do
    begin
      OwnerForm.MDIChildren[I].Close;
      OwnerForm.MDIChildren[I].Release;

      //OwnerForm.MDIChildren[I].Free;
    end;
  end;

  //2.释放当前所有Load的DLL
  for i := 0 to FDllsList.Count - 1 do
  begin
    hMod := StrToInt(FDllsList.Strings[i]);
    FreeLibrary(hMod);
  end;

  //3.释放记录记录所有dll的handle的StringList
  FDllsList.Free;

  inherited;
end;

function TMenuDesign.DyXMLMainMenu: Boolean;
begin
  Result := XMLCreateMenu(FMainMenu, FXMLMenuFile);
end;

function TMenuDesign.DyXMLPopupMenu: Boolean;
begin
  Result := XMLCreateMenu(FPopupMenu, FXMLMenuFile);
end;

function TMenuDesign.MainMenuFromStreem(XMLStream: TStream): Boolean;
begin
  Result := CreateMenuFromStream(FMainMenu, XMLStream);
end;

function TMenuDesign.PopupMenuFromStreem(XMLStream: TStream): Boolean;
begin
  Result := CreateMenuFromStream(FPopupMenu, XMLStream);
end;

function TMenuDesign.CreateMenuFromStream(mMenu: TMenu;
  XMLStream: TStream): Boolean;
var
  TempXML: TXMLDocument;
begin
  TempXML := TXMLDocument.Create(Application);
  try
    TempXML.Active := False;
    TempXML.Options := [doNodeAutoCreate,doAttrNull,doAutoPrefix,doNamespaceDecl];
    try
      TempXML.LoadFromStream(XMLStream);
      TempXML.Active := True;
      XML2Menu(mMenu, TempXML);
      Result := True;
    except
      Result := False;
    end;
  finally
    TempXML.Free;
  end;
end;

function TMenuDesign.XMLCreateMenu(mMenu: TMenu;
  FXMLFile: string): Boolean;
var
  TempXML: TXMLDocument;
begin
  TempXML := TXMLDocument.Create(Application);
  try
    TempXML.Active := False;
    TempXML.Options := [doNodeAutoCreate,doAttrNull,doAutoPrefix,doNamespaceDecl];
    try
      TempXML.LoadFromFile(FXMLFile);
      TempXML.Active := True;
      XML2Menu(mMenu, TempXML);
      Result := True;
    except
      Result := False;
    end;
  finally
    TempXML.Free;
  end;
end;

procedure TMenuDesign.XML2Menu(mMenu: TMenu; FXMLDoc: TXMLDocument);
var
  i: Integer;
  TempMenu: TMenuItem;       //临时创建的菜单项
  MyNode, MenuNode: IXMLNode;//临时使用的XML节点

  //wangji 20030901
  sMenuID, sCaption: String;
  iTag: Integer;
  bVisible: Boolean;

begin
  if not FXMLDoc.Active then FXMLDoc.Active := True; //开启菜单XML文件
  MyNode := FXMLDoc.DocumentElement; //获得菜单XML文件的节点元素
  if (not MyNode.HasChildNodes) or (MyNode.NodeType <> ntElement) then Exit;

  mMenu.Items.Clear; //清除当前应用程序菜单
  for i := 0 to MyNode.ChildNodes.Count - 1 do
  begin
    if (MyNode.ChildNodes[i].NodeType = ntElement) and
      (UpperCase(MyNode.ChildNodes[i].NodeName) = UpperCase(MyMenu)) then
    begin
      MenuNode := MyNode.ChildNodes[i];

      //wangji 20030901:
      sMenuID := MenuNode.Attributes[menuMenuID];
      sCaption := MenuNode.Attributes[menuCaption];
      iTag := StrToInt(MenuNode.Attributes[menuTag]);
      bVisible := True;
      if Assigned(FOnCreateMenuItemEvent) then FOnCreateMenuItemEvent(sMenuID, sCaption, iTag, bVisible);