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.
最新文章
- RSA加密
- JS-JQuery(JSONP)调用WebService跨域若干技术点
- SU Demos-05Sorting Traces-03susorty
- gulp构建前端开发环境
- Oracle数据库中的Function调用参数问题
- 编写一段程序,从标准输入读取string对象的序列直到连续出现两个相同的单词或者所有单词都读完为止。使用while循环一次读取一个单词,当一个单词连续出现两次是使用break语句终止循环。输出连续重复出现的单词,或者输出一个消息说明没有人任何单词是重复出现的。
- 动态SQL实现批量删除指定数据库的全部进程
- 介绍一款管理软件Redmine
- android中文字高亮设置案例
- 如何成为一名优秀的UI设计师
- PL/SQL 基础知识简介
- Dynamics CRM 2015Online Update1 new feature之表单页Tabs切换
- SpringMVC返回json是设置编辑等消息头,消息头信息介绍(respone.setHeader,这个从网上获取)
- RecyclerView实现一个页面有多种item,每个item有多个view,并且可以让任意item的任意view自定义监听,通过接口方法进行触发操作
- 根据cid获取哔哩哔哩弹幕
- cf245H Queries for Number of Palindromes (manacher+dp)
- 线上CPU飚高(死循环,死锁……)?帮你迅速定位代码位置
- 如何解决海量数据的Top K问题
- ASP.NET CORE 之 在IIS上部署MVC项目
- java多线程下的所的概念