003.Delphi插件之QPlugins，菜单插件加强
相比上一篇的菜单插件，这个在创建和销毁时候，做了增强，同时做了2个菜单对应的窗口
unit MenuSvc; interface uses windows, classes, SysUtils, Graphics, ImgList, menus, qstring, QPlugins, qplugins_params, qplugins_base; const MN_CLICK = 0; type // 注册的菜单项Name属性会自动加上'mi'前缀，防止控件名称与保留关键字冲突 // 这里只实现了菜单服务的部分接口，如果要实现更多的接口，请自己扩展实现 IQMenuItem = interface ['{83323919-93DE-4D40-87FB-7266AE804D6C}'] function GetCaption: PWideChar; procedure SetCaption(const S: PWideChar); function GetHint: PWideChar; procedure SetHint(const S: PWideChar); function GetParams: IQParams; procedure SetParams(AParams: IQParams); function SetImage(AHandle: HBITMAP): Boolean; function GetParentMenu: IQMenuItem; // 菜单的四个属性，标题/Hint/父菜单/参数，在接口中定义，子类来实现它 property Caption: PWideChar read GetCaption write SetCaption; property Hint: PWideChar read GetHint write SetHint; property ParentMenu: IQMenuItem read GetParentMenu; property Params: IQParams read GetParams write SetParams; end; IQMenuService = interface ['{667BD198-2F9A-445C-8A7D-B85C4B222DFC}'] // 注册, 在接口中定义，子类来实现它 function RegisterMenu(const APath: PWideChar; AOnEvent: IQNotify; ADelimitor: WideChar = '/'): IQMenuItem; // 注销, 在接口中定义，子类来实现它 procedure UnregisterMenu(const APath: PWideChar; AOnEvent: IQNotify; ADelimitor: WideChar = '/'); end; TQMenuService = class(TQService, IQMenuService) private // 主菜单 FMainMenu: TMainMenu; FQMenuItems: TList; protected // 注册的实现部分 function RegisterMenu(const APath: PWideChar; AOnEvent: IQNotify; ADelimitor: WideChar): IQMenuItem; // 注销的实现部分 procedure UnregisterMenu(const APath: PWideChar; AOnEvent: IQNotify; ADelimitor: WideChar); public constructor Create(aMainMenu: TMainMenu); destructor Destroy; override; end; TQMenuItem = class(TQInterfacedObject, IQMenuItem) private protected FMenuItem: TMenuItem; FOnClick: IQNotify; FName: string; FParams: IQParams; // 菜单的四个属性，标题/Hint/父菜单/参数，在接口中定义，实现部分 function GetCaption: PWideChar; procedure SetCaption(const S: PWideChar); function GetHint: PWideChar; procedure SetHint(const S: PWideChar); function SetImage(AHandle: HBITMAP): Boolean; function GetParams: IQParams; procedure SetParams(AParams: IQParams); function GetParentMenu: IQMenuItem; procedure DoClick(ASender: TObject); public constructor Create(AMenuItem: TMenuItem; AOnClick: IQNotify); overload; destructor Destroy; override; property Name: string read FName write FName; property Params: IQParams read GetParams write SetParams; end; implementation { TQMenuService } const // 菜单前缀，防止重名 MENUITEMNAME_PREFIX = 'mi'; constructor TQMenuService.Create(aMainMenu: TMainMenu); begin // 创建菜单服务 inherited Create(IQMenuService, 'QMenuService'); // 主菜单赋值 FMainMenu := aMainMenu; FQMenuItems := TList.Create; end; destructor TQMenuService.Destroy; var i: Integer; aIdx: Integer; aMenu: TMenuItem; procedure RemoveAQMenuItem(AMenuItem: TMenuItem); var k: Integer; begin if AMenuItem.Count = 0 then begin // 删除自己 // 判断是否是注册的菜单项 , 暂时用Tag 是否大于0 作为识别标志 // 但是这样就无法利用菜单项的Tag属性用于其他用途,需要优化. if AMenuItem.Tag > 0 then begin IQMenuItem(Pointer(AMenuItem.Tag)).Params._Release; IQMenuItem(Pointer(AMenuItem.Tag))._Release; end; AMenuItem.Free; end else begin for k := AMenuItem.Count - 1 downto 0 do begin RemoveAQMenuItem(AMenuItem[k]); end; end; end; begin // 清理所有未注销的菜单对象 aMenu := FMainMenu.Items; for i := aMenu.Count - 1 downto 0 do begin RemoveAQMenuItem(aMenu[i]); end; // 清除所有注册的菜单 // FQMenuItems { for i := FQMenuItems.Count - 1 downto 0 do begin TQMenuItem(FQMenuItems[i]).Free; end; FQMenuItems.Free; } inherited; end; // 注册菜单 function TQMenuService.RegisterMenu(const APath: PWideChar; AOnEvent: IQNotify; ADelimitor: WideChar): IQMenuItem; var p: PWideChar; AName: QStringW; aMenu, ANewMenu: TMenuItem; AItem: IQMenuItem; AChildMenu: TQMenuItem; aIdx: Integer; // 根据名字，找到这个菜单 function IndexOfMenuName: Integer; var i: Integer; AIntf: IQMenuItem; begin Result := -1; for i := 0 to aMenu.Count - 1 do begin if SameText(aMenu.Items[i].Name, MENUITEMNAME_PREFIX + AName) then begin Result := i; Break; end; end; end; begin // 菜单赋值到本地变量 aMenu := FMainMenu.Items; p := PWideChar(APath); while p^ <> #0 do begin AName := DecodeTokenW(p, [ADelimitor], #0, true); // 判断真实菜单名，长度大于0 if Length(AName) > 0 then begin aIdx := IndexOfMenuName; // 如果没有找到这个菜单，则创建 if aIdx = -1 then begin // 创建菜单 ANewMenu := TMenuItem.Create(FMainMenu); // TQMenuItem if p^ = #0 then AChildMenu := TQMenuItem.Create(ANewMenu, AOnEvent) else begin AChildMenu := TQMenuItem.Create(ANewMenu, nil); end; // 往菜单中插入新创建的菜单 FQMenuItems.Add(AChildMenu); // AChildMenu.Name:= MENUITEMNAME_PREFIX + AName; //添加命名前缀'mi_'，避免保留字冲突 Result := AChildMenu; Result._AddRef; // TMenuItem // 设置菜单属性 ANewMenu.Name := MENUITEMNAME_PREFIX + AName; ANewMenu.Tag := IntPtr(Pointer(AChildMenu)); ANewMenu.Caption := AName; aMenu.Add(ANewMenu); aMenu := ANewMenu; end else begin // 如果找到这个菜单，就释放 Result := IQMenuItem(Pointer(aMenu.Items[aIdx].Tag)); aMenu := aMenu.Items[aIdx]; end; end; end; end; // 注销菜单 procedure TQMenuService.UnregisterMenu(const APath: PWideChar; AOnEvent: IQNotify; ADelimitor: WideChar); // 找到菜单项并删除之 // 逐级查找从叶到枝 var MenuItemIndexs: TList; k: Integer; p: PWideChar; AName: QStringW; aMenu: TMenuItem; AQMenuItem: TQMenuItem; aIdx: Integer; i: Integer; // 根据名字，找到这个菜单 function IndexOfMenuName: Integer; var i: Integer; AIntf: IQMenuItem; begin Result := -1; for i := 0 to aMenu.Count - 1 do begin if SameText(aMenu.Items[i].Name, MENUITEMNAME_PREFIX + AName) then begin Result := i; Break; end; end; end; begin aMenu := FMainMenu.Items; { for k := FMainMenu.Items.Count - 1 downto 0 do begin Debugout(FMainMenu.Items[k].Caption); end; } MenuItemIndexs := TList.Create; try p := PWideChar(APath); while p^ <> #0 do begin AName := DecodeTokenW(p, [ADelimitor], #0, true); if Length(AName) > 0 then begin aIdx := IndexOfMenuName; if aIdx = -1 then begin Break; end else begin MenuItemIndexs.Add(Pointer(aMenu.Items[aIdx])); aMenu := aMenu.Items[aIdx]; end; end; end; // 开始倒序删除 MenuItemIndexs 中的菜单项 for k := MenuItemIndexs.Count - 1 downto 0 do begin if TMenuItem(MenuItemIndexs[k]).Count = 0 then begin if TMenuItem(MenuItemIndexs[k]).Tag > 0 then begin AQMenuItem := TQMenuItem(Pointer(TMenuItem(MenuItemIndexs[k]).Tag)); // 清除内部列表中对象的引用 for i := 0 to FQMenuItems.Count - 1 do begin if FQMenuItems[i] = AQMenuItem then begin FQMenuItems[i] := nil; FQMenuItems.Delete(i); Break; end; end; FreeAndNil(AQMenuItem); TMenuItem(MenuItemIndexs[k]).Free; // MenuItemIndexs.Delete(k); end; end; end; AOnEvent := nil; finally MenuItemIndexs.Free; end; end; { TQMenuItem } constructor TQMenuItem.Create(AMenuItem: TMenuItem; AOnClick: IQNotify); var ATemp: Pointer; begin inherited Create; FMenuItem := AMenuItem; // 替换菜单的点击事件 FMenuItem.OnClick := DoClick; FOnClick := AOnClick; end; destructor TQMenuItem.Destroy; begin FOnClick := nil; // FMenuItem.Free; inherited; end; procedure TQMenuItem.DoClick(ASender: TObject); var AFireNext: Boolean; begin AFireNext := true; if Assigned(FOnClick) then begin // 在通知发生时，通知响应函数接口 FOnClick.Notify(MN_CLICK, Params, AFireNext); end; end; function TQMenuItem.GetCaption: PWideChar; begin Result := PWideChar(FMenuItem.Caption); end; function TQMenuItem.GetHint: PWideChar; begin Result := PWideChar(FMenuItem.Hint); end; function TQMenuItem.GetParams: IQParams; begin Result := FParams; end; function TQMenuItem.GetParentMenu: IQMenuItem; begin // 父菜单存于Tag中 if Assigned(FMenuItem.Parent) then Result := IQMenuItem(FMenuItem.Parent.Tag) else begin Result := nil; end; end; procedure TQMenuItem.SetCaption(const S: PWideChar); begin FMenuItem.Caption := S; end; procedure TQMenuItem.SetHint(const S: PWideChar); begin FMenuItem.Hint := S; end; // 设置图标 function TQMenuItem.SetImage(AHandle: HBITMAP): Boolean; var ABitmap: TBitmap; AIcon: TBitmap; AImages: TCustomImageList; begin // 取菜单图片 AImages := (FMenuItem.Owner as TMenu).Images; // 初始化ICON AIcon := nil; // 创建位图 ABitmap := TBitmap.Create; try // 位图赋值 ABitmap.Handle := AHandle; // 图标尺寸如果不对，则生成临时的位图，否则ImageList会添加失败 if (ABitmap.Width <> AImages.Width) or (ABitmap.Height <> AImages.Height) then begin // 创建 AIcon := TBitmap.Create; AIcon.SetSize(AImages.Width, AImages.Height); // 是否启用透明色 AIcon.Canvas.Brush.Color := ABitmap.TransparentColor; AIcon.Canvas.FillRect(Rect(0, 0, AImages.Width, AImages.Height)); AIcon.Canvas.Draw((AImages.Width - ABitmap.Width) shr 1, (AImages.Height - ABitmap.Height) shr 1, ABitmap); AIcon.Transparent := true; // AddMasked向图像列表中加入一个图像 FMenuItem.ImageIndex := AImages.AddMasked(AIcon, ABitmap.TransparentColor); end else begin // 如果图片尺寸一样，则直接添加菜单图片 FMenuItem.ImageIndex := AImages.AddMasked(ABitmap, ABitmap.TransparentColor); end; finally // 释放 FreeAndNil(AIcon); FreeAndNil(ABitmap); end; Result := FMenuItem.ImageIndex <> -1; end; procedure TQMenuItem.SetParams(AParams: IQParams); begin FParams := AParams; end; end.
unit Frm_Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, QPlugins, MenuSvc; type TMainForm = class(TForm) MainMenu1: TMainMenu; miFile: TMenuItem; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var MainForm: TMainForm; implementation {$R *.dfm} procedure TMainForm.FormCreate(Sender: TObject); begin // TQMenuService, 传入界面主菜单 RegisterServices('/Services/Menus', [TQMenuService.Create(MainMenu1)]); end; end.
unit Frm_About; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ShellAPI, QPlugins, qplugins_base, qplugins_params, MenuSvc; type TForm_About = class(TForm) bvl1: TBevel; btn1: TButton; procedure FormCreate(Sender: TObject); procedure btn1Click(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } procedure GetFileVersion; public { Public declarations } end; type TFileVersionInfo = packed record FixedInfo: TVSFixedFileInfo; { 版本信息 } CompanyName: string; { 公司名称 } FileDescription: string; { 说明 } FileVersion: string; { 文件版本 } InternalName: string; { 内部名称 } LegalCopyright: string; { 版权 } LegalTrademarks: string; { 合法商标 } OriginalFilename: string; { 源文件名 } ProductName: string; { 产品名称 } ProductVersion: string; { 产品版本 } Comments: string; { 备注 } LocalPort: string; end; implementation {$R *.dfm} procedure TForm_About.btn1Click(Sender: TObject); begin Close(); end; procedure TForm_About.FormCreate(Sender: TObject); begin Caption := '关于 ' + Application.Title; GetFileVersion(); end; procedure TForm_About.FormShow(Sender: TObject); begin // 检测更新 // if FileExists(ExtractFilePath(Application.ExeName) + APPFILE_Update_exe) then // begin // ShellExecute(Application.Handle, PChar('open'), // PChar(ExtractFilePath(Application.ExeName) + APPFILE_Update_exe), // PChar('/s'), nil, SW_SHOWNORMAL); // end; end; procedure TForm_About.GetFileVersion; var FileVersionInfo: TFileVersionInfo; begin // if GetFileVerInfo(Application.ExeName, FileVersionInfo) then // begin // lblVersion.Caption := '当前版本: ' + // IntToStr(HIWORD(FileVersionInfo.FixedInfo.dwFileVersionMS)) + '.' + // IntToStr(LOWORD(FileVersionInfo.FixedInfo.dwFileVersionMS)); // end; end; type // 通知响应接口，关注某个通知时，应实现IQNotify接口，以便接收相关的通知 TShowFormAction = class(TQInterfacedObject, IQNotify) protected // 在通知发生时，通知响应函数接口 procedure Notify(const AId: Cardinal; AParams: IQParams; var AFireNext: Boolean); stdcall; end; { TShowFormAction } // 通知响应函数 procedure TShowFormAction.Notify(const AId: Cardinal; AParams: IQParams; var AFireNext: Boolean); var F: TForm_About; begin // 如果存在 if Assigned(AParams) and (ParamAsString(AParams.ByName('Name')) = 'About') then begin // 创建自身 F := TForm_About.Create(Application); F.ShowModal; F.Free; end; end; var AFormAction: IQNotify; // 服务注册完成时的通知回调 procedure DoMenuServiceReady2(const AService: IQService); stdcall; begin // with AService as IQMenuService do begin AFormAction := TShowFormAction.Create; // 注册菜单 with RegisterMenu('/Help/About', AFormAction) do begin // 设置菜单属性 Caption := '关于(&S)'; // F := TForm_About.Create(nil); // SetImage(TBitmap(F.img1.Picture.Graphic).Handle); // 参数'Name'，值为'About' Params := NewParams([]); Params.Add('Name', ptUnicodeString).AsString := NewString('About'); // F.Free; end; end; end; initialization AFormAction := nil; // 等待指定的服务注册，DoMenuServiceReady2为服务注册完成时的通知回调 PluginsManager.WaitService(IQMenuService, DoMenuServiceReady2); // DoMenuServiceReady2; finalization // 如果菜单存在，则注销 if Assigned(AFormAction) then begin with PluginsManager as IQMenuService do begin // 注销 UnregisterMenu('/Help/About', AFormAction); end; AFormAction := nil; end; end.
unit Frm_Show; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, QPlugins, qplugins_base, qplugins_params, MenuSvc, StdCtrls, ExtCtrls; type TForm_Show = class(TForm) mmo1: TMemo; img1: TImage; private { Private declarations } public { Public declarations } end; { var Form3: TForm_Show; } implementation {$R *.dfm} type // 通知响应接口，关注某个通知时，应实现IQNotify接口，以便接收相关的通知 TShowFormAction = class(TQInterfacedObject, IQNotify) protected // 在通知发生时，通知响应函数接口 procedure Notify(const AId: Cardinal; AParams: IQParams; var AFireNext: Boolean); stdcall; end; { TShowFormAction } // 在通知发生时，通知响应函数接口 procedure TShowFormAction.Notify(const AId: Cardinal; AParams: IQParams; var AFireNext: Boolean); var F: TForm_Show; I: Integer; begin if Assigned(AParams) and (ParamAsString(AParams.ByName('Name')) = 'Exit') then Application.Terminate else begin // 创建窗口 F := TForm_Show.Create(Application); // Memo输出 with F.mmo1.Lines do begin BeginUpdate; try for I := 0 to AParams.Count - 1 do begin // 窗口输出参数 Add(IntToStr(I) + ': ' + AParams[I].Name + '=' + ParamAsString(AParams[I])); end; finally EndUpdate; end; end; F.ShowModal; F.Free; end; end; var // 通知响应接口，关注某个通知时，应实现IQNotify接口，以便接收相关的通知 AFormAction: IQNotify; // 添加菜单相关内容 procedure DoMenuServiceReady(const AService: IQService); stdcall; begin // 菜单回调函数 with AService as IQMenuService do begin // 通知响应接口 AFormAction := TShowFormAction.Create; // 注册菜单 with RegisterMenu('/File/ShowForm', AFormAction) do begin // 窗口信息 Caption := '显示窗体(&S)'; // F := TForm_Show.Create(nil); // SetImage(TBitmap(F.img1.Picture.Graphic).Handle); Params := NewParams([1, 'Hello,world']); // F.Free; end; // 注册第二个菜单 with RegisterMenu('/File/Exit', AFormAction) do begin Caption := '退出(&X)'; // 参数名字为Exit Params := NewParams([]); Params.Add('Name', ptUnicodeString).AsString := NewString('Exit'); end; end; end; initialization // 通知响应接口 AFormAction := nil; // 等待指定的服务注册，DoMenuServiceReady为服务注册完成时的通知回调 PluginsManager.WaitService(IQMenuService, DoMenuServiceReady); // 在单元中放在 initialization 和 end. 之间，包含了单元退出时的代码。在程序退出时运行并且只运行一次。 finalization // 检查菜单接口是否存在，存在则释放菜单功能 if Assigned(AFormAction) then begin // 释放菜单功能 with PluginsManager as IQMenuService do begin UnregisterMenu('/File/ShowForm', AFormAction); end; AFormAction := nil; end; end.
