⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码
💻 PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Button4: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses ShellAPI;
{$R *.DFM}

procedure SendShift(H: HWnd; Down: Boolean);
var
   vKey, ScanCode: Word;
   lParam: longint;
begin
    vKey:= $10;
    ScanCode:= MapVirtualKey(vKey, 0);
    lParam:= longint(ScanCode) shl 16 or 1;
    if not(Down) then
       lParam:= lParam or $C0000000;
    SendMessage(H,WM_KEYDOWN, vKey, lParam);
end;

procedure SendCtrl(H: HWnd; Down: Boolean);
var
   vKey, ScanCode: Word; //wParam
   lParam: longint;
begin
    vKey:= $11;
    ScanCode:= MapVirtualKey(vKey, 0);{虚拟键转换为扫描码}
    lParam:= longint(ScanCode) shl 16 or 1;
    if not(Down) then
       lParam:= lParam or $C0000000;
    SendMessage(H,WM_KEYDOWN, vKey, lParam);
end;

procedure SendKey(H: Hwnd; Key: char);
var
  vKey, ScanCode, wParam: Word;
  lParam, ConvKey: longint;
  Shift, Ctrl: boolean;
begin
    ConvKey:= OemKeyScan(ord(Key));
    Shift:= (ConvKey and $00020000) <> 0;
    Ctrl:= (ConvKey and $00040000) <> 0;
    ScanCode:= ConvKey and $000000FF or $FF00;
    vKey:= ord(Key);
    wParam:= vKey;
    lParam:= longint(ScanCode) shl 16 or 1;
    if Shift then SendShift(H, true);
    if Ctrl then SendCtrl(H, true);
    SendMessage(H, WM_KEYDOWN, vKey, lParam);
    SendMessage(H, WM_CHAR, vKey, lParam);
    lParam:= lParam or $C0000000;
    SendMessage(H, WM_KEYUP, vKey, lParam);
    if Shift then SendShift(H, false);
    if Ctrl then SendCtrl(H, false);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  pt: TPoint;
begin
    pt:= edit1.ClientToScreen( Point( 4,4 ));
    SetCursorPos( pt.x, pt.y );
    mouse_event( MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 );
    mouse_event( MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 );  
    mouse_event( MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 );
    mouse_event( MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    SendMessage(edit1.Handle,WM_LBUTTONDOWN ,0,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
    SendKey(edit1.handle, 'T');
    SendKey(edit1.handle, 'e');
    SendKey(edit1.handle, 's');
    SendKey(edit1.handle, 't');
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
   SendKey(edit2.Handle, Key);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -