Delphi制作软键盘

{

作者: han

日期: 2006.06.02

}

unit softkey;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, RxGIF, ExtCtrls;

type

Tkeyfrm = class(TForm)

img0: TImage;

img5: TImage;

img4: TImage;

img3: TImage;

img8: TImage;

img9: TImage;

img7: TImage;

img2: TImage;

img1: TImage;

img6: TImage;

imgtg: TImage;

imgyc: TImage;

procedure WMActivate(var Message: TMessage); message WM_ACTIVATE;

procedure imgtgClick(Sender: TObject);

procedure imgycClick(Sender: TObject);

procedure OnNumClick(Sender: TObject);

private

{ Private declarations }

procedure Sendkeys(Hz: longint; state: longint=0);

public

{ Public declarations }

HActWin,Hself: Longint;

end;

var

keyfrm: Tkeyfrm;

implementation

{$R *.dfm}

{ Tkeyfrm }

{-------------------------------------------------------------------------------

过程名: Tkeyfrm.Sendkeys

参数: Hz: Longint; State: Longint=0

返回值: 无

说明: 发送键盘消息函数

-------------------------------------------------------------------------------}

procedure Tkeyfrm.Sendkeys(Hz: Longint; State: Longint=0);

var

FocusHld,WindowHld: hwnd;

ThreadId: dword;

begin

WindowHld := GetForegroundWindow;

ThreadId := GetWindowThreadProcessId(WindowHld,nil);

AttachThreadInput(GetCurrentThreadId,ThreadId,True);

FocusHld := GetFocus;

if FocusHld = 0 then Exit;

PostMessage(FocusHld,WM_KEYDOWN,$+Hz,0);

end;

{-------------------------------------------------------------------------------

过程名: Tkeyfrm.OnNumClick

参数: Sender: TObject

返回值: 无

说明: 键盘消息

-------------------------------------------------------------------------------}

procedure Tkeyfrm.OnNumClick(Sender: TObject);

var

tmp: string;

i: Integer;

begin

tmp:= Copy(TImage(Sender).Name,Length(TImage(Sender).Name),1);

i:= StrToInt(tmp);

SetActiveWindow(HActWin);

case i of

0: Sendkeys(48);

1: Sendkeys(49);

2: Sendkeys(50);

3: Sendkeys(51);

4: Sendkeys(52);

5: Sendkeys(53);

6: Sendkeys(54);

7: Sendkeys(55);

8: Sendkeys(56);

9: Sendkeys(57);

end;

end;

{-------------------------------------------------------------------------------

过程名: Tkeyfrm.WMActivate

参数: var Message: TMessage

返回值: 无

说明: 消息回调函数

-------------------------------------------------------------------------------}

procedure Tkeyfrm.WMActivate(var Message: TMessage);

begin

if Message.wParam = WA_CLICKACTIVE then

begin

if (HActWin <> message.lParam) and (message.lParam <> Hself) then

HActWin := message.lParam;

end;

end;

procedure Tkeyfrm.imgtgClick(Sender: TObject);

begin

SetActiveWindow(HActWin);

Sendkeys(8);

end;

procedure Tkeyfrm.imgycClick(Sender: TObject);

begin

Self.Hide;

end;

end.