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.