delphi windows操作、窗口、句柄、鼠标

输入


procedure TypeKeyString(s: string);
var
  c: Char;
  i: integer;
  off: integer;
  vkw: Word;
begin
  for i := 1 to Length(s) do
  begin
    c := s[i];
    if (c < #128) then
    begin
      vkw := VkKeyScan(c);
      off := 0;
      if vkw and $100 = $100 then
        keybd_event(VK_SHIFT, 0, off, 0);
      if vkw and $200 = $200 then
        keybd_event(VK_CONTROL, 0, off, 0);
      if vkw and $400 = $400 then
        keybd_event(VK_MENU, 0, off, 0);

      off := 0;
      keybd_event(Byte(vkw), 0, off, 0);
      //sleep(20);
      off := off or KEYEVENTF_KEYUP;
      keybd_event(Byte(vkw), 0, off, 0);

      off := off or KEYEVENTF_KEYUP;
      if vkw and $100 = $100 then
        keybd_event(VK_SHIFT, 0, off, 0);
      if vkw and $200 = $200 then
        keybd_event(VK_CONTROL, 0, off, 0);
      if vkw and $400 = $400 then
        keybd_event(VK_MENU, 0, off, 0);
    end;
  end;
end;

procedure SendKeys(focushld:hwnd;sSend:string);//发送中英文混合文本
var
    i,returnint:integer;
    ch: byte;
begin
  if focushld = 0 then Exit;
  i := 1;
  while i <= Length(sSend) do
  begin
    ch := byte(sSend[i]);
    if Windows.IsDBCSLeadByte(ch) then
    begin
      Inc(i);
      returnint:=SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[i]), ch), 0);
    end
    else
      returnint:=SendMessage(focushld, WM_IME_CHAR, word(ch), 0);
    Inc(i);
  end;
if returnint=0 then
begin
TypeKeyString(sSend);
end;
  //postmessage(focushld,WM_keydown,13,0); //输入回车
end;

procedure Poststring(str:string)
var
a:TPoint; //用来存放坐标
hw:HWND; //用来存放窗口句柄
begin
sleep(1000);
GetCursorPos(a);  //取得鼠标坐标,并存放进a中
hw := WindowFromPoint(a); //取得变量a 对应的 窗口句柄
SendKeys(hw,str);
end;

View Code
windows版本信息


Function TFrmVersion.GetWinVersion:integer;
var
  version:TOSVersionInfo;
begin
//result 0 is Winxp
//result 1 is Windows NT
//result 2 is Windows 98
//result 3 is windows 2000
  result:=-1;
  Version.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
  Getversionex(version);
  case  Version.dwPlatformId  of
  VER_PLATFORM_WIN32_NT:
    begin
      if (version.dwMajorVersion=5) and (version.dwMinorVersion=1) then
      result:=0;
      if (version.dwMajorVersion=4) and (version.dwMinorVersion=0) then
      result:=1;
      if (version.dwMajorVersion=5) and (version.dwMinorVersion=0) then
      result:=3;
    end;
  VER_PLATFORM_WIN32_WINDOWS:
    begin
      result:=2;
    end;
  end;
end;

procedure TFrmVersion.BtnGetVersionClick(Sender: TObject);
begin
  RGPVersion.ItemIndex:=GetWinVersion;
end;

procedure TFrmVersion.BtnCloseClick(Sender: TObject);
begin
  Close;
end;

View Code
delphi中获取光标句柄代码


{
 当光标被另外一个线程掌握时,就无法用GetCursor()应用接口获得光标句柄。
 本文阐述如何在任何线程掌握光标时都能够获取光标句柄。
 例如,想在屏幕截取程序中放置光标时该如何做。
}

function GetCursorHandle: HCURSOR;
var
  hWindow: HWND;
  pt: TPoint;
  pIconInfo: TIconInfo;
  dwThreadID, dwCurrentThreadID: DWORD;
begin
  // 检查哪个窗体掌握光标
  GetCursorPos(pt);
  hWindow := WindowFromPoint(pt);

  // 获得光标所有者的线程ID
  dwThreadID := GetWindowThreadProcessId(hWindow, nil);

  // 获得当前线程的ID
  dwCurrentThreadID := GetCurrentThreadId;

  // 如果光标所有者的线程不是当前线程,就要把光标所有者的线程配属到当前线程。
  //然后调用GetCursor()来获得正确的光标句柄(hCursor)。

  if (dwCurrentThreadID <> dwThreadID) then
  begin
    if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
    begin
      // 获得光标句柄
      Result := GetCursor;
      AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
    end;
  end else
  begin
    Result := GetCursor;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  CurPosX, CurPoxY: Integer;
  MyCursor: TIcon;
  pIconInfo: TIconInfo;
begin
  MyCursor := TIcon.Create;
  try
    MyCursor.Handle := GetCursorHandle;
    // 获得光标位置
    GetIconInfo(MyCursor.Handle, pIconInfo);
    CurPosX := pIconInfo.xHotspot;
    CurPoxY := pIconInfo.yHotspot;
    // 在窗体上画出光标
    Canvas.Draw(CurPoxY, CurPoxY, MyCursor);
  finally

当光标被另外一个线程掌握时,就无法用GetCursor()应用接口获得光标句柄。本文阐述如何在任何线程掌握光标时都能够获取光标句柄。

=========================================================

{
 当光标被另外一个线程掌握时,就无法用GetCursor()应用接口获得光标句柄。
 本文阐述如何在任何线程掌握光标时都能够获取光标句柄。
 例如,想在屏幕截取程序中放置光标时该如何做。
}

function GetCursorHandle: HCURSOR;
var
  hWindow: HWND;
  pt: TPoint;
  pIconInfo: TIconInfo;
  dwThreadID, dwCurrentThreadID: DWORD;
begin
  // 检查哪个窗体掌握光标
  GetCursorPos(pt);
  hWindow := WindowFromPoint(pt);

  // 获得光标所有者的线程ID
  dwThreadID := GetWindowThreadProcessId(hWindow, nil);

  // 获得当前线程的ID
  dwCurrentThreadID := GetCurrentThreadId;

  // 如果光标所有者的线程不是当前线程,就要把光标所有者的线程配属到当前线程。
  //然后调用GetCursor()来获得正确的光标句柄(hCursor)。

  if (dwCurrentThreadID <> dwThreadID) then
  begin
    if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
    begin
      // 获得光标句柄
      Result := GetCursor;
      AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
    end;
  end else
  begin
    Result := GetCursor;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  CurPosX, CurPoxY: Integer;
  MyCursor: TIcon;
  pIconInfo: TIconInfo;
begin
  MyCursor := TIcon.Create;
  try
    MyCursor.Handle := GetCursorHandle;
    // 获得光标位置
    GetIconInfo(MyCursor.Handle, pIconInfo);
    CurPosX := pIconInfo.xHotspot;
    CurPoxY := pIconInfo.yHotspot;
    // 在窗体上画出光标
    Canvas.Draw(CurPoxY, CurPoxY, MyCursor);
  finally
    MyCursor.ReleaseHandle;
    MyCursor.Free;
  end;
end;

// 另外一种解决办法:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  CI: TCursorInfo;
begin
  CI.cbSize := SizeOf(CI);
  GetCursorInfo(CI);
  Image1.Picture.Icon.Handle := CI.hCursor;
end;
    MyCursor.ReleaseHandle;
    MyCursor.Free;
  end;
end;

// 另外一种解决办法:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  CI: TCursorInfo;
begin
  CI.cbSize := SizeOf(CI);
  GetCursorInfo(CI);
  Image1.Picture.Icon.Handle := CI.hCursor;
end;

View Code
向其他程序发送模拟按键


向其他程序发送模拟按键:

1、用keybd_event:

var
h : THandle;
begin
h := FindWindow('TFitForm', '1stOpt - [Untitled1]');
SetForegroundWindow(h);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(VK_F9, MapVirtualKey(VK_F9, 0), 0, 0);
keybd_event(VK_F9, MapVirtualKey(VK_F9, 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
end;

选找到目标程序的句柄h,在应用Keybd_event之前必须先把目标程序设为当前活动窗口。(如果不想看见的话,把目标程序的位置用SetWindowLong设置在屏幕之外.)

2、用SendMessage、PostMessage:不需目标置为最前。

SendMessage(h,WM_KEYDOWN,VK_F9,0);

PostMessage(h,WM_KEYDOWN,VK_F9,0);

发送组合键:PostMessage(h,WM_SYSKEYDOWN,VK_F9,$10000000);//试验不成功

Ctrl : $10000000; 
Shift: $08000000; 
Alt: $20000000

如打开菜单ALT-F,则要WM_SYSKEYDOWM,:PostMessage(h,WM_SYSKEYDOWN,70,$20000000);才行。(//试验成功)

3、CTL键组合发送不成功。

4、向后台应用程序发送按键总结:

4.1 单个按健:PostMessage(h,WM_KEYDOWN,VK_F9,0);

4.2ALT+按键:PostMessage(h,WM_SYSKEYDOWN,70,$20000000);

4.3CTL+按键:暂时模仿如下,基本可行。但不用sleep(10),有时行,有时不行。换用SendMessage却不行,WHY?

if hwnd<>0 then
begin
keybd_event(VK_CONTROL,0,0,0);
PostMessage(hwnd,WM_KEYDOWN,VK_F9,0);
PostMessage(hwnd,WM_KEYUP,VK_F9,0);
sleep(10);
keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
end;


说明:

键盘事件消息可以分为“击键”和“字符”两类。对于可以显示字符的击键组合,Windows不仅向程序发送击键消息,还发送字符消息。有些键不产生字符,这些键包括shift键、Fn功能键、光标移动键和特殊字符如Insert和Delete。

击键消息包括WM_KEYDOWN、WM_KEYUP、WM_SYSKEYDOWN、WM_SYSKEYUP四种类型。WM_KEYDOWN和WM_KEYUP消息通常是在按下或释放不带Alt键的键时产生;WM_SYSKEYDOWN和WM_SYSKEYUP消息通常由与Alt组合的击键产生,这些键激活程序菜单或系统菜单上的选项,或切换活动窗口,也可以用作系统菜单加速键。由于Windows处理所有Alt键的功能,应用程序无需捕获这些消息。对于4类击键消息,wParam是虚拟键代码,代表按下或释放的键,而lParam包含击键的其他数据。如果按住一个键不放使得自动重复功能生效,那么该键最后被释放时,Windows会给窗口过程发送一系列的WM_KEYDOWN(或WM_SYSKEYDWON)消息和一个WM_KEYUP(或WM_SYSKEYUP)消息。

View Code
delphi 获取文件版本


function GetFileVersion(FileName: string): string;
const
InfoNum = 9;
InfoStr: array[1..InfoNum] of string = (
'ProductName',
'ProductVersion',
'FileDescription',
'LegalCopyright',
'FileVersion',
'CompanyName',
'LegalTradeMarks',
'InternalName',
'OriginalFileName'
);
var
S: string;
BufSize, Len: DWORD;
Buf: PChar;
Value: PChar;
begin
  S := FileName;
  BufSize := GetFileVersionInfoSize(PChar(S), BufSize);
  if BufSize > 0 then begin
      Buf := AllocMem(BufSize);
      GetFileVersionInfo(PChar(S), 0, BufSize, Buf);
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[1]), Pointer(Value), Len) then
//        result := Value;
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[2]), Pointer(Value), Len) then
//        result := Value; //产品版本:
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[3]), Pointer(Value), Len) then
//        result := Value;//'文件说明: '
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[4]), Pointer(Value), Len) then
//        result :=  Value; //'合法版权: ' +
      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[5]), Pointer(Value), Len) then
        result :=  Value; //'文件版本: ' +
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[6]), Pointer(Value), Len) then
//        result :=  Value; //'公司名称: ' +
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[7]), Pointer(Value), Len) then
//        result :=  Value;// '合法商标: ' +
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[8]), Pointer(Value), Len) then
//        result :=  Value;// '内部名称: ' +
//      if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[9]), Pointer(Value), Len) then
//        result :=  Value; //'原文件名: ' +
      FreeMem(Buf, BufSize);
  end
  else begin
//     Application.MessageBox('获取产品信息时遇到致命错误,请尝试重新启动软件。'+ #13 + '若仍未能解决问题,请联系产品服务人员。','错误',MB_OK + MB_ICONSTOP);
    result := '0.0.0.0';
  end;
end;

View Code
Delphi中限制鼠标的移动区域


下面把鼠标的移动区域限制在(100,100,200,200)

var
rect:TRect;
begin
rect.Left:=100;
rect.Top:=100;
rect.Bottom:=200;
rect.Right:=200;
windows.ClipCursor(@rect);
end;

恢复鼠标的移动区域
windows.ClipCursor(0);

var 
P: tpoint; 
h: thandle; 

getCursorpos(p); //鼠标点击位置
h:= windowFromPoint(p); 

if h= wincontrol.handle then 
  showmessage('在某一控键上');

procedure TForm2.Timer1Timer(Sender: TObject);
var
p: TPoint;
h: HWND;
r:trect;
begin
GetCursorPos(p);
h := WindowFromPoint(p);
GetWindowRect(h,r);//得到窗口的左上角坐标
label4.Caption:=format('x: %d, y: %d',[r.left,r.top]);
Windows.ScreenToClient(h, p);
label1.Caption:=format('x: %d, y: %d',[p.X,p.y]);//鼠标在窗口里的相对位置坐标

end;

View Code
Delphi模拟按键精灵操作网页


一、让Webbrowser响应回车事件!

在窗体中放入一个ApplicationEvents1,然后定义事件:

private
    procedure  ApplicationEvents1Message(var Msg: tagMSG;var Handled: Boolean); //响应回车事件(Alt+Enter)

//程序实现:只需改动webForm.wb1.Handle即可

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);

{fixesthemalfunctionofsomekeyswithinwebbrowsercontrol}
   const
    StdKeys=[VK_TAB,VK_RETURN];{standardkeys}
    ExtKeys=[VK_DELETE,VK_BACK,VK_LEFT,VK_RIGHT];{extendedkeys}
    fExtended=$01000000;{extendedkeyflag}
begin
  Handled   :=   False;
  with   Msg   do
  if ((Message>= WM_KEYFIRST) and (Message<=WM_KEYLAST))  and
     ( (wParam   in   StdKeys) or {$IFDEF   VER120}(GetKeyState(VK_CONTROL)<0 ) or {$ENDIF}
     (wParam   in   ExtKeys) and ( (lParam   and   fExtended)= fExtended) )
  then
  try
    if   IsChild(webForm.wb1.Handle,   hWnd)   then
    {   handles   all   browser   related   messages   }
    begin
      with  webForm.wb1.Application   as   IOleInPlaceActiveObject   do
          Handled   :=   TranslateAccelerator(Msg)   =   S_OK;
      if   not   Handled   then
      begin
        Handled   :=   True;
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  except

  end;

end;

二、delphi模拟按键精灵鼠标、键盘操作

procedure TForm1.wjLoginClick(Sender: TObject);

var

  login_user : string;

  login_password : string;

  oldPt,newPt : TPoint;

begin

//  webForm.Show;

  //获取当前光标位置,并赋值给oldPt

  GetCursorPos(OldPt);

  //设置新光标位置

  NewPt:=Point(wb1.Left+1,wb1.Top+1);

  //是把坐标从当前窗体转化成全屏幕的!!!

  Windows.ClientToScreen(wb1.Handle, NewPt);

  //设置鼠标指针位置并点击

  SetCursorPos(NewPt.X, NewPt.Y);

  mouse_event(MOUSEEVENTF_LEFTDOWN, NewPt.X, NewPt.Y, 0, 0);

  mouse_event(MOUSEEVENTF_LEFTUP, NewPt.X, NewPt.Y, 0, 0); 

  //还原鼠标位置

  SetCursorPos(oldPt.X, oldPt.Y);

  //模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);

  //再次模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);

  //再次模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0); 

//------------------------开始密码输入------------------------------

  Clipboard.Clear;

  //将用户名存入剪切板

  login_user := Trim(edt1.text);

  Clipboard.SetTextBuf(PChar(login_user));

  //模拟按下ctrl+v        

//  ShowMessage(Clipboard.AsText);

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),0,0);

  keybd_event(86,0,0,0);

  keybd_event(86,0,KEYEVENTF_KEYUP,0);

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);

//------------------------开始密码输入------------------------------

  delay(500);

  Clipboard.Clear;

  //模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);

  //再次模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);

  login_password := Trim(edt2.text);

  Clipboard.AsText := login_password;

  //模拟按下ctrl+v

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),0,0);

  keybd_event(86,0,0,0);

  keybd_event(86,0,KEYEVENTF_KEYUP,0);

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);

//------------------------开始按下登录按钮------------------------------

  delay(500);

  //模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);

  //模拟按下回车键不管用,只能用空格键

  keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,0),0,0);

  keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,0),KEYEVENTF_KEYUP,0);

end;

三、在指定位置单击保存验证码图片

function TForm1.getcheckcode :string;

var

  oldPt : Tpoint;

  NewPt : TPoint;

  i,N   : Integer;

  myhkl : hkl;

  h     : HWND;

  r     : TRect;

  yzmPath : String;

begin

  //获取当前光标位置,并赋值给oldPt

  GetCursorPos(OldPt);

  //设置新光标位置

  NewPt:=Point(540,445);

  //是把坐标从当前窗体转化成全屏幕的!!!

  Windows.ClientToScreen(wb1.Handle, NewPt);

  //设置鼠标指针位置并右击

  SetCursorPos(NewPt.X, NewPt.Y);

  mouse_event(MOUSEEVENTF_RIGHTDOWN, NewPt.X, NewPt.Y, 0, 0);

  mouse_event(MOUSEEVENTF_RIGHTUP, NewPt.X, NewPt.Y, 0, 0);

  yzmPath := GetShellFolder('Personal')+'My Pictures\无标题.bmp';

  if FileExists(yzmPath) then

    DeleteFile(yzmPath);

  SetCursorPos(NewPt.X+85, NewPt.Y+105);   //鼠标移动到“图像另存为(s)...”

  //单击ENTER键,保存图片

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),0,0);

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),KEYEVENTF_KEYUP,0);

  //单击ENTER键,关闭保存图片窗口

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),0,0);

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),KEYEVENTF_KEYUP,0);

  //监听窗口是否关闭掉

  timer_Listen_PopuForm.Enabled := True;

  delay(500);

  kGetCodeFromFile(PChar(yzmPath), '', '1', 'dv', pCode, Length(code), '');

  Result := code;

//  if ImmIsIME(myhkl) then     //判断是否在中文状态,若是则关闭它

//    immsimulateHotkey(handle,IME_CHotKey_IME_NonIME_Toggle);

  SetCursorPos(oldPt.x,oldPt.Y);

end;
View Code
Delphi 全局鼠标钩子的简单演程序


dll源代码:
---------------------------------------------------------------------------

library Project2;

uses
  SysUtils,
  Classes,
  Windows,Messages;


{$R *.res}
var
  hHook1:HHOOK;

function hookProc(
  nCode:Integer;      // hook code
  wParam:WPARAM;  // message identifier消息标识
  lParam:LPARAM   // mouse coordinates鼠标坐标
):LRESULT;stdcall;
begin
  if wParam=WM_LBUTTONDOWN then //只处理鼠标的左键按下消息
  begin
    MessageBeep(0);
  end;
  Result:=CallNextHookEx(hHook1,nCode,wParam,lParam);

end;

//设置鼠标钩子
function setHook:Boolean;stdcall;
begin

  hHook1:=SetWindowsHookEx(WH_MOUSE,@hookProc,HInstance,0);
  Result:=hHook1<>0;
end;

//删除鼠标钩子
function delHook:Boolean;stdcall;
begin
  Result:=UnhookWindowsHookEx(hHook1);
end;

exports        //导出函数
  setHook name 'setHook',
  delHook name 'delHook',
  hookProc name 'hookProc';

begin

end.

调用源代码:
---------------------------------------------------------------------------

 unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  Private
    { Private declarations }
  public
    constructor Create(AOwner: TComponent); override;

    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function setHook:Boolean;external 'project2.dll' name 'setHook';
function delHook:Boolean;external 'project2.dll' name 'delHook';

procedure TForm1.Button1Click(Sender: TObject);
begin
  if sethook then
    Label1.Caption:='钩子安装成功,按鼠标左键会发出声音';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if delHook then
    Label1.Caption:='勾子已经删除';
end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  form1.Label1.Caption:='';
end;

end.

又一个delphi键盘钩子用法及代码,可以截获几乎所有键值,例如:shift ?,ctrl ?,alt ?,F1~F12,shift或者ctrl或者alt F1~F12,单独的 shift、ctrl、alt 键值,特殊键ins、del、caps lock、num lock、小键盘数字 等等,你只要稍作修改,也可以截获 ctrl alt ?等键值,没有截获不到的键值,本程序不使用dll方式,使用常规方式,方便你编译调试修改,支持xp、vista、win7,是最强悍的键盘钩子控件, 在delphi7下通过。   myshiftchar:string;//返回shift状态 例如 ctrl   mypresschar:string;//返回整个键值 例如 ctrl g   dulictrl:string;//返回 ctrl 和 alt 单独状态, =ctrl or =alt   安装方法:   本控件的核心源代码在 unit2   首先 创建调用主窗体,假定是form1,在form1上放一个 memo控件(必须),然后创建一个新单元 如unit2,把我的unit2 单元的源代码全部复制过去,做以下修改,首先确保form1使用 新单元 如unit2,并且unit2也使用form1。   在新单元unit2中 ,找到 函数 function KeyBHkHandle 过程,在其中找到以下两条语句:    // 在这里根据自己的情况修改    form1.Memo1.Lines.Add(mypresschar);   // 在这里根据自己的情况修改    if mypresschar'' then form1.Memo1.Lines.Add(mypresschar);   如果你的调用主窗体就叫form1,则不用修改,否则把这两条语句的form1修改为你的调用主窗体的名字。   在 memo编辑框的onChange事件中编写自己的 键盘消息接受主控制过程,其中 字符串mypresschar 返回总键值,它跟memo编辑框中显示值是一样的 ,例如 g、shift g、ctrl 2、F9、alt F9、 等等,其中 字符串shiftstr 返回 控制键 shift ctrl alt 的状态,例如按下ctrl,则 shiftstr=‘ctrl’ ,否则=''。   最后不要忘记在程序退出时卸载键盘钩子!
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

再创世纪

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值