Форумчанин
Регистрация: 04.07.2010
Сообщений: 131
|
Запускаю поток, но спустя несколько циклов он вылетает с ошибкой:EOutOfResources with message 'Неверныйй дескриптор.
На строке
if check('ls',169,60,38,20,screen.Heig ht-148) then MonitorResSTR[2]:=1 else MonitorResSTR[2]:=0;
Либо если лезть в саму процедуру, то на
result:=CompareMonochromeIMG(Screen Bmp,SampleBmp);
Как это исправить: В отдельном приложении без потока все это работает прекрасно (в таймере)
Но это костыли, запускать вместо потока отдельным exe файлом, потом из него передавать данные в основное окно другого exe файла
Код:
begin
if assigned(Monitor) then Monitor.Terminate;
Monitor:=Tmonitor.Create(False);
Monitor.Priority:=tpNormal;
Monitor.FreeOnTerminate:=true;
Monitor.PlayerName:=HeroName.Text;
end;
поток в отдельном юните:
Код:
unit monitor;
interface
uses
System.Classes,forms;
type
Tmonitor = class(TThread)
private
procedure checkall;
public
var
PlayerName:string;
protected
procedure Execute; override;
end;
var
MonitorResSTR:array[1..41] of integer=(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
// PlayerName:string;
implementation
uses ScreenScan;
var
xval,yval,xval1,yval1,widthBaff,widthBaff2,HeinghtBaff,hiY:integer;
procedure Tmonitor.checkall;
var
serverBool:boolean;
begin
//оф
if CheckPixel((screen.Width div 2) +1, screen.Height-50,'111.103.86') then serverBool:=true else
//револг
if CheckPixel(screen.Width div 2, screen.Height-59 ,'25.18.8') then serverBool:=true else serverBool:=false;
if serverBool then
begin
if check('ls',169,60,38,20,screen.Height-148) then MonitorResSTR[2]:=1 else MonitorResSTR[2]:=0;
if MonitorResSTR[2]=1 then if check('lsBaf',160,200,13,100,screen.Height-125) then MonitorResSTR[27]:=1 else MonitorResSTR[27]:=0;
end;
end;
procedure Tmonitor.Execute;
begin
widthBaff:=645;
widthBaff2:=300;
HeinghtBaff:=82;
hiY:=screen.Height-124;
xval:=screen.Width-(widthBaff+10);
yval:=12;
xval1:=screen.Width-(widthBaff2+10);
yval1:=62;
while not Terminated do
begin
try
checkall;
finally
end;
sleep(100);
end;
end;
end.
ScreenScan юнит:
Код:
unit ScreenScan;
interface
uses
Vcl.Forms, System.Classes,
Windows, SysUtils, Graphics, unit1;
procedure MakeScreenshot(bmp: TBitmap);
procedure Monochrome(Bitmap: TBitmap;GrayLimit:byte);
function Check(const Name:string;Gray:byte;W,H,X,Y:integer):boolean;
function CheckPixel(x,y:integer; Color:string):boolean;
function CheckPixelRange(x, y, Rmin, Rmax, Gmin, Gmax, Bmin, Bmax :integer):boolean;
function CheckCursor(CursorNane:string):boolean;
threadvar
LastCheckCoord: TPoint;
implementation
//скрин экрана
procedure MakeScreenshot(bmp: TBitmap);
var
vDesktopDC: HDC;
begin
vDesktopDC := GetWindowDC(GetDesktopWindow);
try
bmp.PixelFormat := pf24bit;
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, vDesktopDC, 0, 0, SRCCOPY);
finally
ReleaseDC(GetDesktopWindow, vDesktopDC);
end;
end;
//получаем ЧБ скрин
procedure Monochrome(Bitmap: TBitmap;GrayLimit:byte);
const
White:TRGBTriple=(rgbtBlue:$FF;rgbtGreen:$FF;rgbtRed:$FF);
Black:TRGBTriple=(rgbtBlue:$00;rgbtGreen:$00;rgbtRed:$00);
var
x, y: integer;
Dest: PRGBTriple;
begin
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do
begin
Dest := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do
begin
if ((Dest^.rgbtRed + Dest^.rgbtGreen + Dest^.rgbtBlue) div 3) > GrayLimit then Dest^ := White else Dest^ := Black;
Inc(Dest);
end;
end;
end;
function CompareMonochromeImg(bmp1, bmp2: TBitMap): boolean;
type
PMonoImgData=^TMonoImgData;
TMonoImgData=array[0..4095] of PByteArray;
var
y, x, yy, xx: integer;
IMG1,IMG2: TMonoImgData;
begin
bmp1.PixelFormat:=pf8bit;
bmp2.PixelFormat:=pf8bit;
for y:=0 to bmp1.Height-1 do IMG1[y]:=bmp1.ScanLine[y];
for yy:=0 to bmp2.Height-1 do IMG2[yy]:=bmp2.ScanLine[yy];
//основной цикл по всему изображению
y:=0;
repeat
x:=0;
repeat
//вложеный цикл по искомому фрагменту
yy:=0;
repeat
xx:=0;
repeat
Result:=(IMG1[y+yy, x+xx]=IMG2[yy,xx]);
inc(xx);
until (xx>=bmp2.Width) or (not Result);
inc(yy);
until (yy>=bmp2.Height) or (not Result);
inc(x);
until (x>bmp1.Width-bmp2.Width) or (Result);
inc(y);
until (y>bmp1.Height-bmp2.Height) or (Result);
//если флаг установлен, значит есть результат, записываем координаты верхнего левого пиксела
if Result then
begin
LastCheckCoord.x:=x-1;
LastCheckCoord.y:=y-1;
end else
begin
LastCheckCoord.x:=MaxLongint;
LastCheckCoord.y:=MaxLongint;
end;
end;
//Проверяем картинку на скрине
function Check(const Name:string;Gray:byte;W,H,X,Y:integer):boolean;
var
SampleBmp,ScreenBmp:TBitmap;
hDesktop:hwnd;
DesktopDC: HDC;
begin
try
SampleBmp:=TBitmap.Create;
SampleBmp.LoadFromFile('BITMAP\'+Name+'.bmp');
Monochrome(SampleBmp,Gray);
ScreenBmp:=TBitmap.Create;
ScreenBmp.PixelFormat := pf24bit;
ScreenBmp.Height := H;
ScreenBmp.Width := W;
hDesktop:=GetDesktopWindow;
DesktopDC := GetWindowDC(hDesktop);
BitBlt(ScreenBmp.Canvas.Handle, 0,0,W,H,DesktopDC,X,Y,SRCCOPY);
ReleaseDC(hDesktop, DesktopDC);
Monochrome(ScreenBmp,Gray);
result:=CompareMonochromeIMG(ScreenBmp,SampleBmp);
finally
ScreenBmp.free;
SampleBmp.free;
end;
end;
//Проверяем цвет пикселя
function CheckPixel(x, y: integer; Color: string): boolean;
var s:string; DC: HDC; ColorValue: Cardinal;
begin
DC := GetDC( 0 );
ColorValue := GetPixel( DC, x, y);
s:=intToStr(GetRValue( ColorValue ));
s:=s+'.'+intToStr(GetGValue( ColorValue ));
s:=s+'.'+intToStr(GetBValue( ColorValue ));
ReleaseDC( 0, DC );
result:= s=Color;
end;
//Проверяем цвет пикселя
function CheckPixelRange(x, y, Rmin, Rmax, Gmin, Gmax, Bmin, Bmax :integer): boolean;
var
DC: HDC; ColorValue: Cardinal;
rFinnaly:boolean;
begin
rFinnaly:=false;
DC := GetDC( 0 );
ColorValue := GetPixel( DC, x, y);
{GetRValue( ColorValue );}
if
(Rmin<=GetRValue( ColorValue )) and (Rmax>=GetRValue( ColorValue ))
and
{GetGValue( ColorValue );}
(Gmin<=GetGValue( ColorValue )) and (Gmax>=GetGValue( ColorValue ))
and
{GetBValue( ColorValue );}
(Bmin<=GetBValue( ColorValue )) and (Bmax>=GetBValue( ColorValue ))
then
rFinnaly:=true;
ReleaseDC( 0, DC );
result:= rFinnaly;
end;
//Проверяем курсор
function CheckCursor(CursorNane:string): boolean;
var
IconIMG : TIcon;
CI : TCursorInfo;
F1, F2: TmemoryStream;
BitmapKursor, Bitmap : TBitmap;
begin
try
IconIMG := TIcon.Create;
Bitmap := TBitmap.Create;
BitmapKursor:= TBitmap.Create;
CI.cbSize := SizeOf(CI);
GetCursorInfo(CI);
IconIMG.Handle:=CI.hCursor;
Bitmap.Width := IconIMG.Width;
Bitmap.Height := IconIMG.Height;
BitmapKursor.Width := IconIMG.Width;
BitmapKursor.Height := IconIMG.Height;
BitmapKursor.LoadFromFile('BITMAP\'+CursorNane+'.bmp');
//Image3.Picture.Assign(BitmapKursor);
Bitmap.Canvas.Draw(0, 0, IconIMG);
//Image2.Picture.Assign(Bitmap);
f1:=TmemoryStream.create;
F2:=TmemoryStream.create;
BitmapKursor.SaveToStream(f1);
Bitmap.SaveToStream(f2);
// побайтовое сравнение всего файла
if comparemem(f1.memory, f2.memory, f1.size) then result:=true else result:=false;
finally
f1.free;
f2.free;
IconIMG.Free;
Bitmap.Free;
BitmapKursor.Free;
end;
end;
end.
|