相比上一篇的菜单插件，这个在创建和销毁时候，做了增强，同时做了2个菜单对应的窗口
unit MenuSvc; interface uses
windows,
classes,
SysUtils,
Graphics,
ImgList,
menus,
qstring,
QPlugins,
qplugins_params,
qplugins_base; const
MN_CLICK = ; 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 = then
begin
// 删除自己
// 判断是否是注册的菜单项 , 暂时用Tag 是否大于0 作为识别标志
// 但是这样就无法利用菜单项的Tag属性用于其他用途,需要优化.
if AMenuItem.Tag > then
begin
IQMenuItem(Pointer(AMenuItem.Tag)).Params._Release;
IQMenuItem(Pointer(AMenuItem.Tag))._Release;
end;
AMenuItem.Free;
end
else
begin
for k := AMenuItem.Count - downto do
begin
RemoveAQMenuItem(AMenuItem[k]);
end;
end;
end; begin
// 清理所有未注销的菜单对象
aMenu := FMainMenu.Items;
for i := aMenu.Count - downto 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 := -;
for i := to aMenu.Count - 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^ <> # do
begin
AName := DecodeTokenW(p, [ADelimitor], #, true);
// 判断真实菜单名，长度大于0
if Length(AName) > then
begin
aIdx := IndexOfMenuName;
// 如果没有找到这个菜单，则创建
if aIdx = - then
begin
// 创建菜单
ANewMenu := TMenuItem.Create(FMainMenu);
// TQMenuItem
if p^ = # 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 := -;
for i := to aMenu.Count - 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^ <> # do
begin
AName := DecodeTokenW(p, [ADelimitor], #, true);
if Length(AName) > then
begin
aIdx := IndexOfMenuName;
if aIdx = - then
begin
Break;
end
else
begin
MenuItemIndexs.Add(Pointer(aMenu.Items[aIdx]));
aMenu := aMenu.Items[aIdx];
end;
end;
end; // 开始倒序删除 MenuItemIndexs 中的菜单项
for k := MenuItemIndexs.Count - downto do
begin if TMenuItem(MenuItemIndexs[k]).Count = then
begin
if TMenuItem(MenuItemIndexs[k]).Tag > then
begin
AQMenuItem := TQMenuItem(Pointer(TMenuItem(MenuItemIndexs[k]).Tag));
// 清除内部列表中对象的引用
for i := to FQMenuItems.Count - 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(, , AImages.Width, AImages.Height));
AIcon.Canvas.Draw((AImages.Width - ABitmap.Width) shr , (AImages.Height - ABitmap.Height) shr , 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 <> -;
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 := to AParams.Count - 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([, '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.