打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
(1)delphi,用delphi制作类似按键精灵的功能
//以前用XP,使用按键精灵还是不错的,但至从换成64位的win7平台后,按键精灵9在不开启神盾的情况下无法启动脚本。
//为了能在64位的win7下继续使用类似按键精灵的功能,现改用delphi来制作,最大的好处是灵活,而且不收费
//以下内容为网络上摘抄,暂时还未验证,如有同类爱好的朋友可以共同探讨
unit kbKernel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = ARRAY[0..32767] OFTRGBTriple;
TRGBTriple =
PACKED RECORD
rgbtBlue :BYTE;
rgbtGreen:BYTE;
rgbtRed :BYTE;
END;
procedureCloseWindows;
procedure LeftClick(x, y: integer);
procedure RightClick(x, y: integer);
procedure DoubleClick(x, y: integer);
procedure MoveTo(x, y: integer);
procedure Presskey(vk: integer);
procedure PressTwoKey(key1, key2:integer);
function GetPixelColor(x, y: integer):integer;
function Findcolor(iLeft, iTop, iRight, iBottom,Acolor: integer;
var iX, iY:integer):boolean;
function Findpicture(iLeft, iTop, iRight,iBottom: integer;
strPic:string; var iX, iY: integer):boolean;
procedure inputNum(num:integer);
function GetXY(var x, y: integer): boolean;
implementation
procedureCloseWindows();
var
hdlProcessHandle : Cardinal;
hdlTokenHandle : Cardinal;
tmpLuid : Int64;
//tkpPrivilegeCount : Int64;
tkp : TOKEN_PRIVILEGES;
tkpNewButIgnored : TOKEN_PRIVILEGES;
lBufferNeeded : Cardinal;
Privilege : array[0..0] of_LUID_AND_ATTRIBUTES;
begin
hdlProcessHandle := GetCurrentProcess;
OpenProcessToken(hdlProcessHandle,
(TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),
hdlTokenHandle);
// Get theLUID for shutdown privilege.
LookupPrivilegeValue('', 'SeShutdownPrivilege',tmpLuid);
Privilege[0].Luid := tmpLuid;
Privilege[0].Attributes :=SE_PRIVILEGE_ENABLED;
tkp.PrivilegeCount :=1;   // One privilege toset
tkp.Privileges[0] := Privilege[0];
// Enable the shutdown privilege in the accesstoken of this
// process.
AdjustTokenPrivileges(hdlTokenHandle,
False,
tkp,
Sizeof(tkpNewButIgnored),
tkpNewButIgnored,
lBufferNeeded);
ExitWindowsEx((EWX_SHUTDOWN Or EWX_FORCE),$FFFF);
end;
//点击鼠标左键
procedure LeftClick(x,y:integer);
begin
mouse_event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_LEFTDOWN,round(x*65535/1024),round(y*65535/768),0,0);
sleep(20);
mouse_event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_LEFTUP,round(x*65535/1024),round(y*65535/768),0,0);
end;
//点击鼠标右键
procedure RightClick(x,y:integer);
begin
mouse_event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_RIGHTDOWN,round(x*65535/1024),round(y*65535/768),0,0);
sleep(20);
mouse_event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_RIGHTUP,round(x*65535/1024),round(y*65535/768),0,0);
end;
//双击鼠标左键
procedure DoubleClick(x,y:integer);
begin
LeftClick(x,y);
sleep(50);
LeftClick(x,y);
end;
//移动鼠标到指定位置
procedure MoveTo(x,y:integer);
begin
mouse_event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_MOVE,round(x*65535/1024),round(y*65535/768),0,0);
end;
//按下一个键
procedure Presskey(vk:integer);
begin
keybd_event(vk,MapVirtualKey(vk, 0),0,0);
sleep(20);
keybd_event(vk,MapVirtualKey(vk,0),KEYEVENTF_KEYUP,0);
end;
ProcedurePressTwoKey(key1,key2:integer);
begin
keybd_event(key1,MapVirtualKey(key1,0),0,0);
sleep(50);
PressKey(key2);
sleep(50);
keybd_event(key1,MapVirtualKey(key1,0),KEYEVENTF_KEYUP,0);
end;
//得到屏幕上的某点的颜色
function GetPixelColor(x,y:integer):integer;
var
aDc:HDC;
begin
aDc:=getdc(0);
result:=getpixel(aDc,x,y);
releasedc(0,aDc);
end;
//在指定范围内查找一个点,找到返回TRUE,失败为FALSE
function findcolor(iLeft,iTop,iRight,iBottom,Acolor:integer;variX,iY:integer):boolean;
var
aDc:HDC;
i,j:integer;
bitmap:Tbitmap;
row,row1 : pRGBTripleArray;
ScanlineBytes: INTEGER;
begin
iX := -1;
iY := -1;
bitmap:=Tbitmap.Create;
bitmap.PixelFormat := pf24bit;
bitmap.Width := iRight-iLeft+1;
bitmap.Height := iBottom-iTop+1;
aDc:= getdc(0);
bitblt(bitmap.Canvas.Handle,0,0,bitmap.Width-1,bitmap.Height-1,aDc,iLeft,iTop,srccopy);
releasedc(0,aDc);
row := Bitmap.Scanline[0];
row1 := Bitmap.Scanline[1];
ScanlineBytes := Integer(row1) -Integer(row);
for j := 0 to Bitmap.Height-1 do
begin
for i := 0to Bitmap.Width-1 do
begin
if(row[i].rgbtRed=getRvalue(Acolor))and(row[i].rgbtGreen=getGvalue(Acolor))and(row[i].rgbtBlue=getBvalue(Acolor))then
begin
iX:= i;
iY:= j;
break;
end;
end;
ifiX<>-1 then break;
inc(Integer(Row), ScanlineBytes);
end;
result := iX<>-1;
bitmap.Free;
end;
functionfindpicture(iLeft,iTop,iRight,iBottom:integer;strPic:string;variX,iY:integer):boolean;
var
aDc:HDc;
bitmap,bitmap1:Tbitmap;
arrPoint:array[1..20] of Tpoint;
iColors:array[1..20] of integer;
i,j,k,x,y:integer;
finded:boolean;
row,row1 :pRGBTripleArray;
ScanlineBytes: INTEGER;
begin
iX := -1;
iY := -1;
result:=false;
if not fileexists(strPic) thenexit;//文件不存在,则退出;
bitmap1 := Tbitmap.Create;
bitmap1.LoadFromFile(strPic);
for i:= 1 to 20 do
begin
repeat
x := random(bitmap1.Width);
y := random(bitmap1.Height);
while bitmap1.Canvas.Pixels[x,y]= 16777215 do
begin
x := random(bitmap1.Width);
y := random(bitmap1.Height);
end;
finded:= false;
for j:= i-1 downto 1 do
begin
if (arrPoint[j].X = x) and (arrPoint[j].Y = y) then
begin
finded := true;
break;
end;
end;
until notfinded;
arrPoint[i].X := x;
arrPoint[i].Y := y;
iColors[i]:= bitmap1.Canvas.Pixels[arrPoint[i].X,arrPoint[i].Y];
end;
bitmap:= Tbitmap.Create;
bitmap.PixelFormat := pf24bit;
bitmap.Width := iRight-iLeft+1;
bitmap.Height := iBottom-iTop+1;
aDc:= getdc(0);
bitblt(bitmap.Canvas.Handle,0,0,bitmap.Width-1,bitmap.Height-1,aDc,iLeft,iTop,srccopy);
releasedc(0,aDc);
row := Bitmap.Scanline[0];
row1 := Bitmap.Scanline[1];
ScanlineBytes := Integer(row1) -Integer(row);
for j := 0to Bitmap.Height-bitmap1.Height do
begin
for i := 0to Bitmap.Width-bitmap1.Width do
begin
finded := true;
for k:= 1 to 20 do
begin
integer(row1):= integer(row)+ arrPoint[k].Y*ScanlineBytes;
if(abs(row1[i+arrPoint[k].X].rgbtRed-getRvalue(iColors[k]))>255*(1-0.9))or(abs(row1[i+arrPoint[k].X].rgbtGreen-getGvalue(iColors[k]))>255*(1-0.9))or(abs(row1[i+arrPoint[k].X].rgbtBlue-getBvalue(iColors[k]))>255*(1-0.9))then
begin
finded := false;
break;
end;
end;
if finded then
begin
iX := iLeft+i+round(bitmap1.Width/2);
iY := iTop+j+round(bitmap1.Height/2);
break;
end;
end;
ifiX<>-1 then break;
inc(Integer(Row), ScanlineBytes);
end;
result:=iX<>-1;
bitmap.Free;
bitmap1.Free;
end;
procedureinputNum(num:integer);
var
i:integer;
aStr:string;
begin
aStr:= inttostr(num);
for i:=1 to length(aStr) do
begin
PressKey(ord(aStr[i]));
sleep(50);
end;
PressKey(VK_RETURN);
sleep(50);
end;
//读取当前游戏坐标
function GetXY(var x, y: integer): boolean;
var
aDc:HDC;
i,j,newX,TZCount:integer;
PXCount:integer;//象素数量
EmptyLine,EmptyContent,negtiveX,negtiveY,XorY:boolean;
bitmap:Tbitmap;
row,row1 : pRGBTripleArray;
ScanlineBytes: INTEGER;
begin
bitmap:= Tbitmap.Create;
bitmap.PixelFormat := pf24bit;
bitmap.Width := 950-870+1;
bitmap.Height := 34-22+1;
aDc:= getdc(0);
bitblt(bitmap.Canvas.Handle,0,0,bitmap.Width-1,bitmap.Height-1,aDc,870,22,srccopy);
releasedc(0,aDc);
row := Bitmap.Scanline[0];
row1 := Bitmap.Scanline[1];
ScanlineBytes := Integer(row1) -Integer(row);
EmptyContent:=true;
EmptyLine:=true;
TZCount:=0;//累加一个数字的所有想素的坐标总和
PXCount:= 0;
negtiveX:=false;//x坐标负数标记
negtiveY:=false;//y坐标负数标记
XorY:=false;//表示扫描X还是Y,先扫描X
newX:=0;//该语句多余,仅仅为了不产生警告错误而已
result:=false;
x:=0;
y:=0;
for i:=0to bitmap.Width-1 do
begin
if (notEmptyContent)and(EmptyLine) then
begin
case TZCount of
111:;//     [ 125
127:result:=true;//     ] 141
11:XorY:=true;//     . 12  开始扫描 Y
45: if XorY then negtiveY:=true elsenegtiveX:=true;//     - 50
171:if XorY then y:=y*10 elsex:=x*10;//     0 189
97:if XorY then y:=y*10+1 elsex:=x*10+1;//     1 108
153:if XorY then y:=y*10+2 elsex:=x*10+2;//     2 169
149:if XorY then y:=y*10+3 elsex:=x*10+3;//     3 164
163:if PXCount = 16 then
if XorY then y:=y*10+4 elsex:=x*10+4//     4 179
else
if XorY then y:=y*10+5 elsex:=x*10+5;//     5 181
176:if XorY then y:=y*10+6 elsex:=x*10+6;//     6 195
107:if XorY then y:=y*10+7 elsex:=x*10+7;//     7 120
180:if XorY then y:=y*10+8 elsex:=x*10+8;//     8 199
185:if XorY then y:=y*10+9 elsex:=x*10+9;//     9 204
end;
EmptyContent:=true;
TZCount:=0;
PXCount:= 0;
end;
EmptyLine:=true;
for j:=0 tobitmap.Height-1 do
begin
integer(row1) :=integer(row)+j*ScanlineBytes;
if(abs(row1[i].rgbtRed-getRvalue(198))<20)and(abs(row1[i].rgbtGreen-getGvalue(198))<20)and(abs(row1[i].rgbtBlue-getBvalue(198))<20)then
begin
if EmptyContent then newX := i; //保存新数字的开始横坐标
TZCount:=TZCount+i-newX+1+j+1; //把像素点的横纵坐标累加
inc(PXCount);
EmptyContent:=false;
EmptyLine:=false;
end;
end;
end;
if negtiveX then x:=0-x;
if negtiveY then y:=0-y;
bitmap.Free;
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
delphi 图象旋转
FireMonkey 源码学习(6)
delphi 在RxRichEdit中插入图片的完美解决方法
delphi WebBrowser控件上网页验证码图片识别教程(一)
Inno Setup详细教程
一个实用的Delphi屏幕截图程序的设计
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服