scontextmenu.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sContextMenu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms, Graphics,
  sSkinProvider, sSkinManager, Menus, sSkinMenus;

type

  TsPopupList = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  public
  end;

  TsMenuItem = class(TMenuItem)
  public
    UID : Cardinal;
  end;

  TsContextMenu = class(TPopupMenu)
  public
    function FindItemByUid(UID : Cardinal) : TsMenuItem;
  end;

  procedure HookContextMenu;
  procedure ProcessContextMenu(var Message : TMessage);

var
 HookHandle: DWORD = 0;
 ContextMenu : TsContextMenu;

implementation

uses sStyleSimply, sMaskData, sVCLUtils, sMessages, sGraphUtils, sAlphaGraph, acntUtils, sSKinProps;

function ContextMenuHookProc(Code: Integer; WParam: Integer; LParam: PCWPStruct): Integer; stdcall;
var
  Menu: HMENU;
  ItemCount, I: Integer;

  procedure SetOwnerDraw(Menu : HMENU; Item : integer);
  var
    MenuItemInfo: TMenuItemInfo;
    Buffer: array[0..79] of Char;

  begin
    MenuItemInfo.cbSize := 44; // Required for Windows 95
    MenuItemInfo.fMask := MIIM_TYPE;
    MenuItemInfo.dwTypeData := Buffer;
    MenuItemInfo.cch := SizeOf(Buffer);
    if GetMenuItemInfo(Menu, Item, True, MenuItemInfo) then begin
      MenuItemInfo.fType := MenuItemInfo.fType and not MFT_STRING;
      MenuItemInfo.fType := MenuItemInfo.fType or MFT_OWNERDRAW;
      SetMenuItemInfo(Menu, Item, True, MenuItemInfo);
    end;
  end;

  procedure AddContextMenu(Item : TMenuItem; Menu : HMENU; Index : integer);
  var
    MenuItemInfo: TMenuItemInfo;
    Buffer: array[0..79] of Char;
    MI : TsMenuItem;
    Buffer2: array[0..255] of Char;
    Caption : string;
    ItemCount, I: Integer;

  begin
    MenuItemInfo.cbSize := 44; // Required for Windows 95
    MenuItemInfo.fMask := MIIM_TYPE or MIIM_ID or MIIM_STATE or MIIM_SUBMENU;
    MenuItemInfo.dwTypeData := Buffer;
    MenuItemInfo.cch := SizeOf(Buffer);
    if GetMenuItemInfo(Menu, Index, True, MenuItemInfo) then begin
      MI := TsMenuItem.Create(ContextMenu);
      i := GetMenuString(Menu, Index, Buffer2, SizeOf(Buffer2), MF_BYPOSITION);
      SetString(Caption,Buffer2,i);
      if (MenuItemInfo.fType and MFT_SEPARATOR) = MFT_SEPARATOR then
        MI.Caption := cLineCaption
      else begin
        MI.Caption := Caption;

//      MI.Enabled := (MenuItemInfo.fState and MFS_ENABLED) = MFS_ENABLED;
      MI.Enabled := (MenuItemInfo.fState and (MFS_DISABLED or MFS_GRAYED)) = 0;
      MI.Default := (MenuItemInfo.fState and MFS_DEFAULT) = MFS_DEFAULT;
      MI.RadioItem := (MenuItemInfo.fState and MFT_RADIOCHECK) = MFT_RADIOCHECK;
      MI.Checked := (MenuItemInfo.fState and MFS_CHECKED) = MFS_CHECKED;

      end;
      MI.UID := MenuItemInfo.wID;
      Item.Add(MI);

      if MenuItemInfo.hSubMenu > 0 then begin
        ItemCount := GetMenuItemCount(MenuItemInfo.hSubMenu);
        for I := 0 to ItemCount - 1 do
          AddContextMenu(MI, MenuItemInfo.hSubMenu, I);
      end;
//      MenuItemInfo.fType := MenuItemInfo.fType and not MFT_STRING;
//      MenuItemInfo.fType := MenuItemInfo.fType or MFT_OWNERDRAW;
//      SetMenuItemInfo(Menu, Item, True, MenuItemInfo);
    end;
  end;

begin
  if (Code = HC_ACTION) then
    case LPARAM.message of
      WM_MENUSELECT:
      begin
        Menu := LParam^.lParam; // 骂