regmenudesign.pas

一个DELPHI下的菜单构件

      if not bVisible then Continue;

      TempMenu := TMenuItem.Create(mMenu);
      with TempMenu, MenuNode do
      begin
        try
          AutoCheck := StrToBool(Attributes[menuAutoCheck]);
        except
          AutoCheck := False;
        end;
        try
          AutoHotkeys := TMenuItemAutoFlag(GetEnumValue(TypeInfo(TMenuItemAutoFlag), Attributes[menuAutoHotkeys]));
        except
          AutoHotkeys := maParent;
        end;
        try
          AutoLineReduction := TMenuItemAutoFlag(GetEnumValue(TypeInfo(TMenuItemAutoFlag), Attributes[menuAutoLineReduction]));
        except
          AutoLineReduction := maParent;
        end;
        try
          Break := TMenuBreak(GetEnumValue(TypeInfo(TMenuBreak), Attributes[menuBreak]));
        except
          Break := mbNone;
        end;
        try
          Caption := Attributes[menuCaption];
        except
          Caption := '新菜单项';
        end;
        try
          Checked := StrToBool(Attributes[menuChecked]);
        except
          Checked := False;
        end;
        try
          Default := StrToBool(Attributes[menuDefault]);
        except
          Default := False;
        end;
        try
          Enabled := StrToBool(Attributes[menuEnabled]);
        except
          Enabled := True;
        end;
        try
          GroupIndex := StrToInt(Attributes[menuGroupIndex]);
        except
          GroupIndex := 0;
        end;
        try
          HelpContext := StrToInt(Attributes[menuHelpContext]);
        except
          HelpContext :=0;
        end;
        try
          Hint := Attributes[menuHint];
        except
          Hint := '';
        end;
        try
          ImageIndex := StrToInt(Attributes[menuImageIndex]);
        except
          ImageIndex := -1;
        end;
        try
          RadioItem := StrToBool(Attributes[menuRadioItem]);
        except
          RadioItem := False;
        end;
        try
          ShortCut := TextToShortCut(Attributes[menuShortCut]);
        except
          ShortCut := TextToShortCut('(None)');
        end;
        try
          Tag := StrToInt(Attributes[menuTag]);
        except
          Tag := 0;
        end;
        try
          Visible := StrToBool(Attributes[menuVisible]);
        except
          Visible := True;
        end;
      end;

      mMenu.Items.Add(TempMenu);
      if MenuNode.HasChildNodes then
        DynamicMenuItem(mMenu, TempMenu, MenuNode)
      else
        TempMenu.OnClick := AppMenuEventClick;
    end;
  end;
end;

procedure TMenuDesign.DynamicMenuItem(mMenu: TMenu; CurItem: TMenuItem;
  CurNode: IXMLNode);
var
  j: Integer;
  TempMenu: TMenuItem;//临时创建的菜单项
  MenuNode: IXMLNode; //临时使用的XML节点

  //wangji 20030901
  sMenuID, sCaption: String;
  iTag: Integer;
  bVisible: Boolean;
begin
  CurItem.Clear;
  for j := 0 to CurNode.ChildNodes.Count - 1 do
  begin
    if CurNode.ChildNodes[j].NodeType = ntElement then
    begin
      MenuNode := CurNode.ChildNodes[j];

      //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);
      if not bVisible then Continue;

      TempMenu := TMenuItem.Create(mMenu);
      with TempMenu, MenuNode do
      begin
        try
          AutoCheck := StrToBool(Attributes[menuAutoCheck]);
        except
          AutoCheck := False;
        end;
        try
          AutoHotkeys := TMenuItemAutoFlag(GetEnumValue(TypeInfo(TMenuItemAutoFlag), Attributes[menuAutoHotkeys]));
        except
          AutoHotkeys := maParent;
        end;
        try
          AutoLineReduction := TMenuItemAutoFlag(GetEnumValue(TypeInfo(TMenuItemAutoFlag), Attributes[menuAutoLineReduction]));
        except
          AutoLineReduction := maParent;
        end;
        try
          Break := TMenuBreak(GetEnumValue(TypeInfo(TMenuBreak), Attributes[menuBreak]));
        except
          Break := mbNone;
        end;
        try
          Caption := Attributes[menuCaption];
        except
          Caption := '新菜单项';
        end;
        try
          Checked := StrToBool(Attributes[menuChecked]);
        except
          Checked := False;
        end;
        try
          Default := StrToBool(Attributes[menuDefault]);
        except
          Default := False;
        end;
        try
          Enabled := StrToBool(Attributes[menuEnabled]);
        except
          Enabled := True;
        end;
        try
          GroupIndex := StrToInt(Attributes[menuGroupIndex]);
        except
          GroupIndex := 0;
        end;
        try
          HelpContext := StrToInt(Attributes[menuHelpContext]);
        except
          HelpContext :=0;
        end;
        try
          Hint := Attributes[menuHint];
        except
          Hint := '';
        end;
        try
          ImageIndex := StrToInt(Attributes[menuImageIndex]);
        except
          ImageIndex := -1;
        end;
        try
          RadioItem := StrToBool(Attributes[menuRadioItem]);
        except
          RadioItem := False;
        end;
        try
          ShortCut := TextToShortCut(Attributes[menuShortCut]);
        except
          ShortCut := TextToShortCut('(None)');
        end;
        try
          Tag := StrToInt(Attributes[menuTag]);
        except
          Tag := 0;
        end;
        try
          Visible := StrToBool(Attributes[menuVisible]);
        except
          Visible := True;
        end;
      end;
      CurItem.Add(TempMenu);
      if MenuNode.HasChildNodes then
        DynamicMenuItem(mMenu, TempMenu, MenuNode)
      else
        TempMenu.OnClick := AppMenuEventClick;
    end;
  end;
end;

function TMenuDesign.GetFarProcFunc(sDllName, sFuncName: String): FARPROC;
var
  hMod: THandle;         //dll的handle
  aFARPROC: FARPROC;
begin
  //取得应用程序的Event调用接口
  hMod := LoadLibrary(PChar(sDllName));
  if (hMod = 0) then
    Raise Exception.Create('无法装载DLL:' + sDllName);

  if FDllsList.IndexOf(IntToStr(hMod)) < 0 then
    FDllsList.Add(IntToStr(hMod));

  aFARPROC := GetProcAddress(hMod , PChar(sFuncName));
  if (aFARPROC = nil) then
    Raise Exception.Create('无法取得入口函数:' + sFuncName);

  Result := aFARPROC;
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

  
{///////////////////////////////////////////////////////////////////////////////
//应用举例：
将主界面中TMainMenu控件，带入本功能中：
主界面中声明部分：
Type
  TRunAppEvn = function(SysInfo: TSystemInfo): Integer; stdcall;
  TFrmMain = class(TForm)
    CurMenu: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    //Private declarations
    RunAppEvn: TRunAppEvn; //统一的应用程序Menu的Event调用接口
    。。。。。

主界面中实现部分：
procedure TForm1.FormShow(Sender: TObject);
begin
  MenuDesign1.XMLMenuFile := 'menu.XML';
  MenuDesign1.DyXMLMainMenu;
end;

procedure TForm1.MenuDesign1MenuItemClick(Sender: TObject);
var
  CurAppFile: string;      //当前菜单关联的应用的文件名
  CurActParam: Integer;    //当前菜单关联的标识
  CurActInfo: TSystemInfo; //传递给应用的记录集
begin
  //应用主菜单响应事件，调用相应的应用程序的接口
  CurActParam := TMenuItem(Sender).Tag;//当前菜单关联的标识
  CurAppFile := TMenuItem(Sender).Hint;//当前菜单关联的应用的文件名
  with CurActInfo do
  begin
    AOApp     := Application;//平台Application
    AOScr     := Screen;     //平台Screen
    AOAppID   := -1;         //应用在平台注册的AppID
    AOActParam:= CurActParam;//平台调用模块在其应用中的标识
    AOResID   := -1;         //当前使用的资源在项目数据库中的ResID
    AOResInfo := '';         //当前使用的资源信息（可以唯一定位到该资源）
  end;

  //调用功能
  @RunAppEvn := MenuDesign1.GetFarProcFunc(CurAppFile, 'RunAppEvn'); //dll名称， 接口函数名
  try
    RunAppEvn(CurActInfo);
  except
    Showmessage('RunAppEvn Error!');
  end;
end;
////////////////////////////////////////////////////////////////////////////////}

end.