在主线程中创建4个线程,每个线程实时监控窗口中的4个区域的实验数据(while循环)。给每个线程分配了一个hdc,线程里头主要用到的就是getpixel函数。现在碰到的问题是运行一段时间之后有时会出现access violation错误,提示在内存0x00401C01处出错,查到为deletefree模块。
这个模块不是我代码里头的模块。刚学不久。不知道这时候要怎么知道是在哪一行代码中出了问题?要怎么设置断点,怎么操作才能定位错误所在?
这个模块不是我代码里头的模块。刚学不久。不知道这时候要怎么知道是在哪一行代码中出了问题?要怎么设置断点,怎么操作才能定位错误所在?
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
Edit1: TEdit;
Timer1: TTimer;
Timer2: TTimer;
procedure Timer2Timer(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
其他多个控件定义略去
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure DoVisible;
procedure DoInvisible;
public
{ Public declarations }
end;var
Form1: TForm1;
FullRgn, ClientRgn, CtlRgn : THandle;
zdc:hdc;
hThread1,hThread2,hThread3,hThread4,hThread5,hThread6,hThread7:Thandle;//定义一个句柄
ThreadID:DWord;
win1start,win2start,win3start,win4start:integer;
win1cc,win2cc,win3cc,win4cc:integer;
win1nowvalue, win2nowvalue,win3nowvalue,win4nowvalue:integer;
timebool:bool;
line2nd:longint;//定义第一行和第二行的时间
timecount:integer;//计时器
click1num,click2num,click3num,click4num:integer;
win1end,win2end,win3end,win4end:integer;
win1case1,win1case2,win1case3,win1case4:integer;
const//一些坐标略去
win1xL=63; win1yL=67; win2xL=589; win2yL=67;win3xL=63; win3yL=360;win4xL=589; win4yL=360; win5xL=63;win5yL=648;win6xL=589;win6yL=648;
win1xR=290; win1yR=72; win2xR=814; win2yR=72;win3xR=290; win3yR=365;win4xR=814; win4yR=365;
网上抄下来的让窗口透明化的
procedure TForm1.DoInvisible;
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
begin
Margin := ( Width - ClientWidth ) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );
for A := 0 to ControlCount - 1 do begin
AControl := Controls[A];
if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
then with AControl do begin
if Visible then begin
CtlX := X + Left;
CtlY := Y + Top;
CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
end;
end;
end;
SetWindowRgn(Handle, FullRgn, TRUE);
end;
procedure TForm1.DoVisible;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, TRUE);
end;定义一个动作
procedure Leftclick(dc:hdc;const x,y:integer);
begin
setcursorpos(x,y);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
end;
再定义一个函数
procedure fangxiang(dc:hdc;x,y,endnum,ccnum:integer;pingzhong:string); //反向操作
var
nowvalue,j:integer;
winname:string;
zhengfu:real;
begin
try
zhengfu:=getupdown(dc,x,y);
nowvalue:=getnowvalue(dc,x,y);
if ((timecount<4496) and (timecount>0)) then
timebool:=true else timebool:=false; // 限制了操作时间
if ((abs(nowvalue-endnum)/endnum)<0.3)and(zhengfu<4.9)and(zhengfu>-4.9)and timebool then
begin
for j:=0 to 6 do
begin
winname:=getpingzhong(dc,winx,winy+j*21);
if (pingzhong=winname)and(((nowvalue-endnum)*ccnum)<=0) then
begin
leftclick(dc,winx+10,winy+j*21+10);
sleep(30);
leftclick(dc,kjfsx,kjfsy);
end;//if pinzhong=winname
end;//for j:=1 to 6 end; //if abs(nowprice-
finally
sleep(10);
end;//of try
end;procedure stop(dc,x,y,endnum,ccnum:integer;pingzhong:string);
该动作和方向动作基本架构相同,不贴了定义一个根据颜色取值的函数
function getend(dc:hdc;x,y:integer):integer;
var
number,num,p:integer;
color:longint;
const
wid=7; black=$000000; white=$FFFFFF; blue=$EE5800;green=$007F00; brown=$1C344C;
grey=$E7E7E7; yellow=$55BFFF;orange=$00AAFF; red=$00FF00; purple=$FF9FAA;
numx=1;numy=5;
begin
number:=0;
for p:=0 to 4 do
begin
color:=getpixel(dc,numx+x+wid*p,numy+y);
case COLOR of
black: num:=1;
white: num:=2;
blue: num:=3;
green: num:=4;
brown: num:=5;
grey: num:=6;
yellow: num:=7;
orange: num:=8;
red: num:=9;
purple: num:=0;
end; {of case}
number:=number*10+num;
end;{ for p}
result:=number;
end;function getupdown(dc:hdc;x,y:integer):real;
function getnowvalue(dc:hdc;x,y:integer):integer;
function getpingzhong(dc:hdc;x,y:integer):string;
这几个函数和getend函数基本上完全相同,为了缩减篇幅,就不贴了。
function win1click(P:pointer):Longint;stdcall;
var
updown1:real;
dc1:hdc;
begin
dc1:=getwindowdc(0);
win1start:=getstart(dc1,win1xR,win1yR);
sleep(50);
if win1cc=1 then win1case1:=100
else begin
if win1cc=0 then win1case1:=200 else win1case1:=300;
end;
if win1start>win1end then win1case2:=10
else begin
if win1start=win1end then win1case2:=20 else win1case2:=30;
end;
while timecount<6050 do
begin
sleep(50);//增加此句可以防止过于机器资源占用过多
try//win1
application.ProcessMessages;
win1nowvalue:=getnowvalue(dc1,win1xR,win1yR);
if win1nowvalue>win1end then win1case3:=1
else
begin
if win1nowvalue=win1end then win1case3:=2 else win1case3:=3
end;
labelCap:=inttostr(win1case1+win1case2+win1case3)+' '+inttostr(win1cc)+' '+inttostr(click1num);//显示状态,用于调试
sleep(2);
case win1case1+win1case2+win1case3 of
331,332:begin
if click1num=0 then
begin
if not(win1bool) then
begin
fangxiang(dc1,win1mmx,win1mmy,win1end,win1cc,'rb');
click1num:=click1num+1;//click次数+1
win1cc:=1;
win1case1:=100;//方向改变
end
else
begin
stop(dc1,win1mmx,win1mmy,win1end,win1cc,'rb');
sleep(2000);
click1num:=click1num+1;//click次数+1
win1cc:=0;
win1case1:=200;//方向停止
end; //if not(win1bool)
end; //if click1num=0
end;
231,232:其他case类似略去 end; //of case
finally
sleep(100);
end;//try
end; //if timecount<end;
procedure TForm1.FormCreate(Sender: TObject);begin
zdc:=getwindowdc(0);
Formstyle:=fsStayOnTop;
timer1.Enabled:=false;
click1num:=0;
click2num:=0;
click3num:=0;
click4num:=0;
timecount:=0; //初始化timecount=0,对应的timebool=falsestartbool:=false;
end;启动线程的控件
procedure TForm1.BitBtn1Click(Sender: TObject);
label 10;
const
jiange=6; white=$FFFFFF; black=$000000;
begin
timecount:=0;
bitbtn1.Font.Color:=clred;
showmessage('请勿动鼠标');
sleep(2000);
leftclick(zdc,win1endx,win1endy);//双击第一个子窗口
leftclick(zdc,win1endx,win1endy);
sleep(100);
win1end:=getend(zdc,win1xL,win1yL);
edit1.Text:=inttostr(win1end); //取得第一窗口最后的数值
sleep(50);
leftclick(zdc,win2C4x,win2C4y); //双击第二子窗口
leftclick(zdc,win2C4x,win2C4y);
sleep(100);
win2end:=getend(zdc,win2xL,win2yL);
edit2.Text:=inttostr(win2end); //取得第二窗口最后的数值
sleep(50);
leftclick(zdc,win3C3x,win3C3y); //双击第三子窗口
leftclick(zdc,win3C3x,win3C3y);
sleep(100);//经常执行到此处的时候窗口变成非透明化,导致第三第4个小窗口获取到的win3end不正确
win3end:=getend(zdc,win3xL,win3yL);
edit3.Text:=inttostr(win3end); //取得第三窗口最后的数值
sleep(50);
leftclick(zdc,win4C3x,win4C3y); //双击第四子窗口
leftclick(zdc,win4C3x,win4C3y);
sleep(100);
win4end:=getend(zdc,win4xL,win4yL);
edit4.Text:=inttostr(win4end); //取得第四窗口最后的数值
sleep(300);//执行到此处,窗口会变成非置顶
showmessage('请确认各窗口的数据是否正确');
sleep(1000); //
10: line2nd:=getpixel(zdc,win1xR+6,win1yR+180);
while line2nd=black do
begin
sleep(100);
line2nd:=getpixel(zdc,win1xR+6,win1yR+180);//窗口软件开始启动
application.ProcessMessages;
end; //of while time1st
if (line2nd<>grey) then goto 10; // 因为是采用0的左边的像素,而在9:59之前为1,这时候不会有像素
startbool:=true;//确认开始交易
timer1.Enabled:=true;//开始计时
timecount:=1;//用于让timebool启动,同时补充timecount1秒的延时
//开始启动程序
if win1bool then hThread1:=CreateThread(nil,0,@win1click,nil,0,ThreadID);
if win2bool then hThread2:=CreateThread(nil,0,@win2click,nil,0,ThreadID);
if win3bool then hThread3:=CreateThread(nil,0,@win3click,nil,0,ThreadID);
if win4bool then hThread4:=CreateThread(nil,0,@win4click,nil,0,ThreadID);end;控制窗体透明化的
procedure TForm1.BitBtn35Click(Sender: TObject);
begin
if bitbtn35.Caption='透明它' then
begin
doinvisible;
bitbtn35.Caption:='去透明';
end
else
begin
dovisible;
bitbtn35.Caption:='透明它' ;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
vStr:string;
begin
vStr:=formatdatetime('hh:nn:ss',time);
label6.Caption:=vstr;
timecount:=timecount+1;
label5.Caption:=inttostr(timecount);
end;现在碰到的问题主要有几点
1、代码中红色字体显示的问题
2、运行一段时间之后有时会出现access violation错误,提示在内存0x00401C01附近处出错,查到为deletefree模块。
labelcap为string类型。
在其中一个timer中有用到
label5.caption:=labelcap;
具体有谁能再给我解释一下为什么?送80分了。