现在的位置: 首页 > 综合 > 正文

Delphi Edit右键系统菜单加自定义菜单项

2018年02月11日 ⁄ 综合 ⁄ 共 1720字 ⁄ 字号 评论关闭

闲言少叙,详见代码!

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  oldEditWndProc: Pointer;
  hk: HHOOK;
  hm: HMENU;
  r: TRect;
  bSelected: Boolean;

function GetMsgProc(c, w: Integer; l: PMSG): Integer stdcall;
begin
  if c=HC_ACTION then
    if l^.message=WM_LBUTTONUP then
    begin
      if l^.hwnd = Form1.Edit1.Handle then
        if PtInRect(r, Point(LOWORD(l^.lParam), HIWORD(l^.lParam))) then
        begin
          OutputDebugString(pchar(format('click: %d,%d,%d,%d------%d,%d',[r.Left,r.Top,r.Right,r.Bottom,LOWORD(l^.lParam), HIWORD(l^.lParam)])));
          bSelected := True;
        end
    end else if l^.message = WM_KEYDOWN then
      if l^.hwnd = Form1.Edit1.Handle then
        if l^.wParam = VK_RETURN then
        begin
          OutputDebugString('enter');
          bSelected := True;
        end;

  Result := CallNextHookEx(0, c, w, Integer(l));
end;

function newEditWndProc(h,m,w,l: Integer): Integer stdcall;
const
  MN_GETHMENU=$1E1;
begin
  Result := CallWindowProc(oldEditWndProc, h,m,w,l);

  if m=WM_ENTERIDLE then
  begin
    if w=MSGF_MENU then
      if hm=0 then
      begin
        outputdebugstring('menu pop up');
        hm := SendMessage(l, MN_GETHMENU, 0, 0);
        AppendMenu(hm, MF_SEPARATOR, 0, nil);
        AppendMenu(hm, MF_STRING, 1017, '我的菜单项');
        GetMenuItemRect(0, hm, GetMenuItemCount(hm)-1, r);
        hk:=SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, hInstance, MainThreadId);
      end
  end else if m=WM_CONTEXTMENU then
    if hk<>0 then
    begin
      outputdebugstring('menu closed');
      UnHookWindowsHookEx(hk);
      hk:=0;
      hm := 0;
      if bSelected then
      begin
        bSelected:=False;
        Application.MessageBox('你好,世界!', '提示', MB_OK);
      end
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  oldEditWndProc:=Pointer(SetWindowLong(Edit1.Handle, GWL_WNDPROC, Integer(@newEditWndProc)));
end;

end.

源码打包下载

抱歉!评论已关闭.