Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Утечка памяти в потоке 
:(
    Опции темы
stlcrash
Дата 14.5.2016, 09:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 1.12.2009

Репутация: нет
Всего: нет
Ссылка на проект:https://yadi.sk/d/3pDHnzCLrhVEP

Проблема: создаю поток, в нем все ресурсы которые создаю, освобождаю. Но возникает утечка. Не один день ее ищу, безрезультатно.

Код потока:
Код

unit uMonThread;

interface

uses
  Forms,System.Classes, Windows, Messages, SysUtils, Variants, Graphics, Controls, Dialogs, ExtCtrls, StdCtrls, ComCtrls, mmsystem;

  type FRes = record found: boolean; x,y: integer; end;

  type
  //Для сравнения изображений (чб)
  pRGBLine=^TRGBLine;
  TRGBLine=array[word] of RGBTriple;
  TIMGData=array[word] of pRGBLine;

type
  TMonDirThread = class(TThread)
  private
    procedure checkall();
    Procedure BrowserScreen(imgW,imgH,X,Y,BlackToWhite:integer;BMP:TBitmap);
    procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
    Procedure BMPFromDLL(bmp:TBitmap; ResName: string;BlackToWhite:integer);
    function CompareIMG(bmp1, bmp2:TBitMap): FRes;
    function ResName(Monster:string): string;
  public
  next,              //Для остановки процесса
  MonDirHello,       //здороваемся
  MonDirLS,          //ЛС
  MonDirGiExit,      //Игрок покинул гильдию
  MonDirInviteClose, //Отклонять приглашения в группы
  MonDirExitParty,   //Отряд расформирован
  MonDirDied,        //если умер
  MonDirParalich,    //контроль паралича
  MonDirMorf,        //контроль перевоплощения
  MonDirMorfSec,     //контроль перевоплощения(почти закончился)
  MonDirTotem,       //('тотем');
  MonDirRampage,     //проверка на буйство
  MonDirTimeValk,    //проверка на искажение времени
  MonDirSpeed,       //проверка на скорость
  MonDirDisconnect   //Дисконнект
  :boolean;

  nickName:string;
  n:integer;

  protected
    procedure Execute; override;
  end;

  var
  AModule: THandle;
  maxerr:integer;

implementation

procedure TMonDirThread.BMPFromDLL(bmp: TBitmap; ResName: string;
  BlackToWhite: integer);
begin
    bmp.LoadFromResourceName(AModule,ResName);
    if BlackToWhite<>900 then Threshold(bmp, BlackToWhite, clWhite, clBlack);
end;

function TMonDirThread.CompareIMG(bmp1, bmp2: TBitMap): FRes;
var
  i,y, x, yy, xx, err: integer;
  IMG1,IMG2: TIMGData;
begin
  for i:=0 to bmp1.Height-1 do IMG1[i]:=bmp1.ScanLine[i];
  for i:=0 to bmp2.Height-1 do IMG2[i]:=bmp2.ScanLine[i];
  //основной цикл по всему изображению
  y:=0;
  repeat
    x:=0;
    repeat
      //вложеный цикл по искомому фрагменту
      Result.found:=true;
      yy:=0;
      repeat
        xx:=0;
        repeat
          //если нужно точное соответствие достаточно проверить только одну компоненту
          if maxerr=0 then begin

            if IMG1[y+yy, x+xx].rgbtGreen<>IMG2[yy,xx].rgbtGreen then Result.found:=false;
          //в противном случае сначала считаем ошибку (сумму абсолютных разниц)
          end else begin
            err:=abs(IMG1[y+yy, x+xx].rgbtBlue - IMG2[yy,xx].rgbtBlue)+
                 abs(IMG1[y+yy, x+xx].rgbtGreen - IMG2[yy,xx].rgbtGreen)+
                 abs(IMG1[y+yy, x+xx].rgbtRed - IMG2[yy,xx].rgbtRed);
            //если ошибка больше допустимой, сбрасываем флаг, дальше просматривать фрагмент нету смысла
            if err>maxerr then Result.found:=false;
          end;
          inc(xx);
        until (xx>=bmp2.Width) or (Not Result.found);
        inc(yy);
      until (yy>=bmp2.Height) or (Not Result.found);
      inc(x);
    until (x>bmp1.Width-bmp2.Width) or (Result.found);
    inc(y);
  until (y>bmp1.Height-bmp2.Height) or (Result.found);
  //если флаг установлен, значит есть результат, записываем координаты верхнего левого пиксела
  if Result.found then begin
    Result.x:=x-1;
    Result.y:=y-1;
  end;

end;

procedure TMonDirThread.BrowserScreen(imgW, imgH, X, Y, BlackToWhite: integer;
  BMP: TBitmap);
var
  vDesktopDC: HDC;
begin
  vDesktopDC := GetWindowDC(GetDesktopWindow);
  try
      bmp.PixelFormat := pf24bit;
      bmp.Height := imgH;
      bmp.Width := imgW;
      BitBlt(bmp.Canvas.Handle, 0,0,imgW,imgH,vDesktopDC,X,Y,SRCCOPY);
      if BlackToWhite<>900 then Threshold(bmp,BlackToWhite,clWhite, clBlack);
  finally
    ReleaseDC(GetDesktopWindow, vDesktopDC);
end;

end;

procedure TMonDirThread.checkall;
var
  FindResult: FRes;
  s:string;
  HelloChekerBMP1,HelloChekerBMP2:TBitmap;
begin

HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;


  //ЛС
  begin
    BrowserScreen(70,13,15, 644, 160, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'ls',160);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirLS:=true else MonDirLS:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;


    //Игрок покинул гильдию
  begin
    BrowserScreen(160,10,650, 410, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'gildia',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirGiExit:=true else MonDirGiExit:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

//здороваемся
  begin
  BrowserScreen(200,12,20, 644, 165, HelloChekerBMP1);
  BMPFromDLL(HelloChekerBMP2,'hi',165);
  FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
  if FindResult.found then
      begin

        HelloChekerBMP1.free; HelloChekerBMP2.free;
        HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
      
        BrowserScreen(200,12,20, 644, 250, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,ResName(nickName),250);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
         if not FindResult.found then MonDirHello:=true else MonDirHello:=false;
      end;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //Отклонять приглашения в группы
  begin
    BrowserScreen(160,10,630, 360, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'InviteClose',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirInviteClose:=true else MonDirInviteClose:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //Отряд расформирован
  begin
    BrowserScreen(110,15,585, 365, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'group',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirExitParty:=true else MonDirExitParty:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //если умер
  begin
    BrowserScreen(40,10,540, 340, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'died',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirDied:=true else MonDirDied:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //контроль паралича
    begin
      BrowserScreen(303,35,970, 60, 120, HelloChekerBMP1);
      BMPFromDLL(HelloChekerBMP2,'paralich',120);
      FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
      if FindResult.found then MonDirParalich:=true else MonDirParalich:=false;
    end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //контроль перевоплощения
  begin
        BrowserScreen(600,32,676, 12, 200, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'voplot',200);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then  MonDirMorf:=true else
          begin

            HelloChekerBMP1.free; HelloChekerBMP2.free;
            HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
            MonDirMorf:=false;
            BrowserScreen(50,10,676+FindResult.x-12, 12+FindResult.y+35, 250, HelloChekerBMP1);
            BMPFromDLL(HelloChekerBMP2,'voplottime',250);
            FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
            if FindResult.found then MonDirMorfSec:=true else MonDirMorfSec:=false;
          end;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //тотем
  begin
        BrowserScreen(600,32,676, 12, 220, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'totem',220);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then MonDirTotem:=true else MonDirTotem:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
    //проверка на буйство
  begin
        BrowserScreen(600,32,676, 12, 120, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'rampage1',120);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then MonDirRampage:=true else MonDirRampage:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //проверка на искажение времени
  begin
        BrowserScreen(600,32,676, 12, 220, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'timevalk',220);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then MonDirTimeValk:=true else MonDirTimeValk:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //проверка на скорость
  begin
        BrowserScreen(600,32,676, 12, 180, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'speed',180);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then  MonDirSpeed:=true else  MonDirSpeed:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //Дисконнект
  begin
    s:='discinnect';
    BrowserScreen(90,10,650, 410, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,s,250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if not FindResult.found then
    begin

    HelloChekerBMP1.free; HelloChekerBMP2.free;
    HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
    
      s:='discinnect1';
      BrowserScreen(90,10,650, 410, 250, HelloChekerBMP1);
      BMPFromDLL(HelloChekerBMP2,s,250);
      FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    end;
    if FindResult.found then  MonDirDisconnect:=true else  MonDirDisconnect:=false
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
end;

procedure TMonDirThread.Execute;
begin
  { Place thread code here }
  maxerr:=0;
  AModule := LoadLibrary('res.dll');
  next:=true;

  MonDirHello:=false;       //здороваемся
  MonDirLS:=false;          //ЛС
  MonDirGiExit:=false;      //Игрок покинул гильдию
  MonDirInviteClose:=false; //Отклонять приглашения в группы
  MonDirExitParty:=false;   //Отряд расформирован
  MonDirDied:=false;        //если умер
  MonDirParalich:=false;    //контроль паралича
  MonDirMorf:=false;        //контроль перевоплощения
  MonDirMorfSec:=false;     //контроль перевоплощения(почти закончился)
  MonDirTotem:=false;       //('тотем');
  MonDirRampage:=false;     //проверка на буйство
  MonDirTimeValk:=false;    //проверка на искажение времени
  MonDirSpeed:=false;       //проверка на скорость
  MonDirDisconnect:=false;   //Дисконнект

  while next do begin
    checkall;
    n:=n+1;
    sleep(100);
  end;

  FreeLibrary(AModule);
end;

function TMonDirThread.ResName(Monster: string): string;
begin
  if Monster='Гоблин-шахтер' then begin result:='goblinshacter'; exit; end;
  if Monster='Ящер огня' then begin result:='yasherogna'; exit; end;
  if Monster='Мантикора' then begin result:='manticora'; exit; end;
  if Monster='Дикарь' then begin result:='dicar'; exit; end;
  if Monster='Камень чакры' then begin result:='chacra'; exit; end;
  if Monster='Слизь' then begin result:='sliz'; exit; end;
  if Monster='Рак-отшельник' then begin result:='rakotshel'; exit; end;
  if Monster='Личинка' then begin result:='lichinka'; exit; end;

  if Monster='Внешний лагерь' then begin result:='homeHM'; exit; end;
  if Monster='Дом Гильдии' then begin result:='home'; exit; end;
  if Monster='Деревня Эшборн' then begin result:='eshborn'; exit; end;
  if Monster='Деревня Байрон' then begin result:='bairon'; exit; end;
  if Monster='Деревня Роден' then begin result:='roden'; exit; end;
  if Monster='Деревня Темных земель' then begin result:='darkearth'; exit; end;
  if Monster='Арена Гильдий' then begin result:='arena'; exit; end;

  if Monster='Сум основа' then begin result:='crash'; exit; end;
  if Monster='Сум твинк' then begin result:='crash1'; exit; end;
  if Monster='Маг' then begin result:='nick'; exit; end;
end;

procedure TMonDirThread.Threshold(Bitmap: TBitmap; Value: Byte; Color1,
  Color2: TColor);
type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB;
function ColorToRGB(Color: TColor): TRGB;
  begin
  with Result do
    begin
      R := Lo(Color);
      G := Lo(Color shr 8);
      B := Lo((Color shr 8) shr 8);
    end;
  end;
var x, y: Word; C1, C2: TRGB; Dest: pRGB;
begin
Bitmap.PixelFormat := pf24Bit;
C1 := ColorToRGB(Color1);
C2 := ColorToRGB(Color2);
for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
      begin
        if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value then Dest^ := C1 else Dest^ := C2; Inc(Dest);
      end;
  end;
end;
end.
PM MAIL   Вверх
Alexeis
Дата 14.5.2016, 11:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 34
Всего: 459
Вот тут скорее всего утечка BMPFromDLL(HelloChekerBMP2,'paralich',120);
Передача VCL объектов за границу модуля это раз (просто нельзя в общем случае), а второе, что менеджер памяти должен быть общий чтобы можно было в одной единице выделить, а в другой удалить память. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
stlcrash
Дата 14.5.2016, 20:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 1.12.2009

Репутация: нет
Всего: нет
Вытащил из процедуры checkall все BMPFromDLL();
Запихал их перед циклом, который забивает память. Ничего не изменилось :(

Пробовал закомментить Threshold в процедуре BrowserScreen тоже ничего не изменилось.


Код

procedure TMonDirThread.Execute;
begin
  { Place thread code here }


  maxerr:=0;
  next:=true;

  MonDirHello:=false;       //здороваемся
  MonDirLS:=false;          //ЛС
  MonDirGiExit:=false;      //Игрок покинул гильдию
  MonDirInviteClose:=false; //Отклонять приглашения в группы
  MonDirExitParty:=false;   //Отряд расформирован
  MonDirDied:=false;        //если умер
  MonDirParalich:=false;    //контроль паралича
  MonDirMorf:=false;        //контроль перевоплощения
  MonDirMorfSec:=false;     //контроль перевоплощения(почти закончился)
  MonDirTotem:=false;       //('тотем');
  MonDirRampage:=false;     //проверка на буйство
  MonDirTimeValk:=false;    //проверка на искажение времени
  MonDirSpeed:=false;       //проверка на скорость
  MonDirDisconnect:=false;   //Дисконнект


  nickName:='Сум основа';
  NickSTR:=ResName(nickName);     //crash

   ls:=TBitMap.Create;
   gildia:=TBitMap.Create;
   hi:=TBitMap.Create;
   InviteClose:=TBitMap.Create;
   group:=TBitMap.Create;
   died:=TBitMap.Create;
   paralich:=TBitMap.Create;
   voplot:=TBitMap.Create;
   voplottime:=TBitMap.Create;
   totem:=TBitMap.Create;
   rampage1:=TBitMap.Create;
   timevalk:=TBitMap.Create;
   speed:=TBitMap.Create;
   discinnect:=TBitMap.Create;
   discinnect1:=TBitMap.Create;
   nickNameBMP:=TBitMap.Create;

  AModule := LoadLibrary('res.dll');

  BMPFromDLL(ls,'ls',160);
  BMPFromDLL(gildia,'gildia',250);
  BMPFromDLL(hi,'hi',165);
  BMPFromDLL(nickNameBMP,ResName(nickName),250);
  BMPFromDLL(InviteClose,'InviteClose',250);
  BMPFromDLL(group,'group',250);
  BMPFromDLL(died,'died',250);
  BMPFromDLL(paralich,'paralich',120);
  BMPFromDLL(voplot,'voplot',200);
  BMPFromDLL(voplottime,'voplottime',250);
  BMPFromDLL(totem,'totem',220);
  BMPFromDLL(rampage1,'rampage1',120);
  BMPFromDLL(timevalk,'timevalk',220);
  BMPFromDLL(speed,'speed',180);
  BMPFromDLL(discinnect,'discinnect',250);
  BMPFromDLL(discinnect1,'discinnect1',250);

  while next do begin
  if NickSTR<>ResName(nickName) then
    begin
      nickNameBMP.Free;
      BMPFromDLL(nickNameBMP,ResName(nickName),250);
      NickSTR:=ResName(nickName);
    end;
    checkall;
    n:=n+1;
 //   sleep(100);
  end;

   ls.Free;
   gildia.Free;
   hi.Free;
   InviteClose.Free;
   group.Free;
   died.Free;
   paralich.Free;
   voplot.Free;
   voplottime.Free;
   totem.Free;
   rampage1.Free;
   timevalk.Free;
   speed.Free;
   discinnect.Free;
   discinnect1.Free;
   nickNameBMP.Free;
   FreeLibrary(AModule);

end;


Код потока выглядит так
Код

unit uMonThread;

interface

uses
  Forms,System.Classes, Windows, Messages, SysUtils, Variants, Graphics, Controls, Dialogs, ExtCtrls, StdCtrls, ComCtrls, mmsystem;

  type FRes = record found: boolean; x,y: integer; end;

  type
  //Для сравнения изображений (чб)
  pRGBLine=^TRGBLine;
  TRGBLine=array[word] of RGBTriple;
  TIMGData=array[word] of pRGBLine;

type
  TMonDirThread = class(TThread)
  private
    procedure checkall();
    Procedure BrowserScreen(imgW,imgH,X,Y,BlackToWhite:integer;BMP:TBitmap);
    procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
    Procedure BMPFromDLL(bmp:TBitmap; ResName: string;BlackToWhite:integer);
    function CompareIMG(bmp1, bmp2:TBitMap): FRes;
    function ResName(Monster:string): string;
  public
  next,              //Для остановки процесса
  MonDirHello,       //здороваемся
  MonDirLS,          //ЛС
  MonDirGiExit,      //Игрок покинул гильдию
  MonDirInviteClose, //Отклонять приглашения в группы
  MonDirExitParty,   //Отряд расформирован
  MonDirDied,        //если умер
  MonDirParalich,    //контроль паралича
  MonDirMorf,        //контроль перевоплощения
  MonDirMorfSec,     //контроль перевоплощения(почти закончился)
  MonDirTotem,       //('тотем');
  MonDirRampage,     //проверка на буйство
  MonDirTimeValk,    //проверка на искажение времени
  MonDirSpeed,       //проверка на скорость
  MonDirDisconnect   //Дисконнект
  :boolean;

  nickName:string;
  n:integer;

  protected
    procedure Execute; override;
  end;

  var
  AModule: THandle;
  maxerr:integer;
  ls,gildia,hi,InviteClose,group,died,paralich,voplot,voplottime,totem,rampage1,timevalk,speed,discinnect,discinnect1,nickNameBMP:TBitMap;
 NickSTR:string;


implementation

procedure TMonDirThread.BMPFromDLL(bmp: TBitmap; ResName: string;
  BlackToWhite: integer);
begin
    bmp.LoadFromResourceName(AModule,ResName);
    if BlackToWhite<>900 then Threshold(bmp, BlackToWhite, clWhite, clBlack);
end;

function TMonDirThread.CompareIMG(bmp1, bmp2: TBitMap): FRes;
var
  i,y, x, yy, xx, err: integer;
  IMG1,IMG2: TIMGData;
begin
  for i:=0 to bmp1.Height-1 do IMG1[i]:=bmp1.ScanLine[i];
  for i:=0 to bmp2.Height-1 do IMG2[i]:=bmp2.ScanLine[i];
  //основной цикл по всему изображению
  y:=0;
  repeat
    x:=0;
    repeat
      //вложеный цикл по искомому фрагменту
      Result.found:=true;
      yy:=0;
      repeat
        xx:=0;
        repeat
          //если нужно точное соответствие достаточно проверить только одну компоненту
          if maxerr=0 then begin

            if IMG1[y+yy, x+xx].rgbtGreen<>IMG2[yy,xx].rgbtGreen then Result.found:=false;
          //в противном случае сначала считаем ошибку (сумму абсолютных разниц)
          end else begin
            err:=abs(IMG1[y+yy, x+xx].rgbtBlue - IMG2[yy,xx].rgbtBlue)+
                 abs(IMG1[y+yy, x+xx].rgbtGreen - IMG2[yy,xx].rgbtGreen)+
                 abs(IMG1[y+yy, x+xx].rgbtRed - IMG2[yy,xx].rgbtRed);
            //если ошибка больше допустимой, сбрасываем флаг, дальше просматривать фрагмент нету смысла
            if err>maxerr then Result.found:=false;
          end;
          inc(xx);
        until (xx>=bmp2.Width) or (Not Result.found);
        inc(yy);
      until (yy>=bmp2.Height) or (Not Result.found);
      inc(x);
    until (x>bmp1.Width-bmp2.Width) or (Result.found);
    inc(y);
  until (y>bmp1.Height-bmp2.Height) or (Result.found);
  //если флаг установлен, значит есть результат, записываем координаты верхнего левого пиксела
  if Result.found then begin
    Result.x:=x-1;
    Result.y:=y-1;
  end;

end;

procedure TMonDirThread.BrowserScreen(imgW, imgH, X, Y, BlackToWhite: integer;
  BMP: TBitmap);
var
  vDesktopDC: HDC;
begin
  vDesktopDC := GetWindowDC(GetDesktopWindow);
  try
      bmp.PixelFormat := pf24bit;
      bmp.Height := imgH;
      bmp.Width := imgW;
      BitBlt(bmp.Canvas.Handle, 0,0,imgW,imgH,vDesktopDC,X,Y,SRCCOPY);
      if BlackToWhite<>900 then Threshold(bmp,BlackToWhite,clWhite, clBlack);
  finally
    ReleaseDC(GetDesktopWindow, vDesktopDC);
end;

end;

procedure TMonDirThread.checkall;
var
  FindResult: FRes;
  HelloChekerBMP1:TBitmap;
begin

HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;


  //ЛС
  begin
    BrowserScreen(70,13,15, 644, 160, HelloChekerBMP1);
//    BMPFromDLL(HelloChekerBMP2,'ls',160);
    FindResult:=CompareIMG(HelloChekerBMP1,ls);
    if FindResult.found then MonDirLS:=true else MonDirLS:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;


    //Игрок покинул гильдию
  begin
    BrowserScreen(160,10,650, 410, 250, HelloChekerBMP1);
//    BMPFromDLL(HelloChekerBMP2,'gildia',250);
    FindResult:=CompareIMG(HelloChekerBMP1,gildia);
    if FindResult.found then MonDirGiExit:=true else MonDirGiExit:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;

//здороваемся
  begin
  BrowserScreen(200,12,20, 644, 165, HelloChekerBMP1);
  //BMPFromDLL(HelloChekerBMP2,'hi',165);
  FindResult:=CompareIMG(HelloChekerBMP1,hi);
  if FindResult.found then
      begin

        HelloChekerBMP1.free;// HelloChekerBMP2.free;
        HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;
      
        BrowserScreen(200,12,20, 644, 250, HelloChekerBMP1);
 //       BMPFromDLL(HelloChekerBMP2,ResName(nickName),250);
        FindResult:=CompareIMG(HelloChekerBMP1,nickNameBMP);
         if not FindResult.found then MonDirHello:=true else MonDirHello:=false;
      end;
  end;

  HelloChekerBMP1.free; //HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;
  
  //Отклонять приглашения в группы
  begin
    BrowserScreen(160,10,630, 360, 250, HelloChekerBMP1);
//    BMPFromDLL(HelloChekerBMP2,'InviteClose',250);
    FindResult:=CompareIMG(HelloChekerBMP1,InviteClose);
    if FindResult.found then MonDirInviteClose:=true else MonDirInviteClose:=false;
  end;

  HelloChekerBMP1.free; //HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;
  
  //Отряд расформирован
  begin
    BrowserScreen(110,15,585, 365, 250, HelloChekerBMP1);
//    BMPFromDLL(HelloChekerBMP2,'group',250);
    FindResult:=CompareIMG(HelloChekerBMP1,group);
    if FindResult.found then MonDirExitParty:=true else MonDirExitParty:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;
  
  //если умер
  begin
    BrowserScreen(40,10,540, 340, 250, HelloChekerBMP1);
//    BMPFromDLL(HelloChekerBMP2,'died',250);
    FindResult:=CompareIMG(HelloChekerBMP1,died);
    if FindResult.found then MonDirDied:=true else MonDirDied:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;

  //контроль паралича
    begin
      BrowserScreen(303,35,970, 60, 120, HelloChekerBMP1);
 //     BMPFromDLL(HelloChekerBMP2,'paralich',120);
      FindResult:=CompareIMG(HelloChekerBMP1,paralich);
      if FindResult.found then MonDirParalich:=true else MonDirParalich:=false;
    end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;

  //контроль перевоплощения
  begin
        BrowserScreen(600,32,676, 12, 200, HelloChekerBMP1);
//        BMPFromDLL(HelloChekerBMP2,'voplot',200);
        FindResult:=CompareIMG(HelloChekerBMP1,voplot);
        if not FindResult.found then  MonDirMorf:=true else
          begin

            HelloChekerBMP1.free; //HelloChekerBMP2.free;
            HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;
  
            MonDirMorf:=false;
            BrowserScreen(50,10,676+FindResult.x-12, 12+FindResult.y+35, 250, HelloChekerBMP1);
//            BMPFromDLL(HelloChekerBMP2,'voplottime',250);
            FindResult:=CompareIMG(HelloChekerBMP1,voplottime);
            if FindResult.found then MonDirMorfSec:=true else MonDirMorfSec:=false;
          end;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;
  
  //тотем
  begin
        BrowserScreen(600,32,676, 12, 220, HelloChekerBMP1);
   //     BMPFromDLL(HelloChekerBMP2,'totem',220);
        FindResult:=CompareIMG(HelloChekerBMP1,totem);
        if not FindResult.found then MonDirTotem:=true else MonDirTotem:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;
  
    //проверка на буйство
  begin
        BrowserScreen(600,32,676, 12, 120, HelloChekerBMP1);
  //      BMPFromDLL(HelloChekerBMP2,'rampage1',120);
        FindResult:=CompareIMG(HelloChekerBMP1,rampage1);
        if not FindResult.found then MonDirRampage:=true else MonDirRampage:=false;
  end;

  HelloChekerBMP1.free; //HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;

  //проверка на искажение времени
  begin
        BrowserScreen(600,32,676, 12, 220, HelloChekerBMP1);
    //    BMPFromDLL(HelloChekerBMP2,'timevalk',220);
        FindResult:=CompareIMG(HelloChekerBMP1,timevalk);
        if not FindResult.found then MonDirTimeValk:=true else MonDirTimeValk:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;

  //проверка на скорость
  begin
        BrowserScreen(600,32,676, 12, 180, HelloChekerBMP1);
  //      BMPFromDLL(HelloChekerBMP2,'speed',180);
        FindResult:=CompareIMG(HelloChekerBMP1,speed);
        if not FindResult.found then  MonDirSpeed:=true else  MonDirSpeed:=false;
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create;// HelloChekerBMP2:=TBitmap.Create;

  //Дисконнект
  begin
    BrowserScreen(90,10,650, 410, 250, HelloChekerBMP1);
//    BMPFromDLL(HelloChekerBMP2,s,250);
    FindResult:=CompareIMG(HelloChekerBMP1,discinnect);
    if not FindResult.found then
    begin

    HelloChekerBMP1.free;// HelloChekerBMP2.free;
    HelloChekerBMP1:=TBitmap.Create; //HelloChekerBMP2:=TBitmap.Create;
    
      BrowserScreen(90,10,650, 410, 250, HelloChekerBMP1);
   //   BMPFromDLL(HelloChekerBMP2,s,250);
      FindResult:=CompareIMG(HelloChekerBMP1,discinnect1);
    end;
    if FindResult.found then  MonDirDisconnect:=true else  MonDirDisconnect:=false
  end;

  HelloChekerBMP1.free;// HelloChekerBMP2.free;
end;

procedure TMonDirThread.Execute;
begin
  { Place thread code here }


  maxerr:=0;
  next:=true;

  MonDirHello:=false;       //здороваемся
  MonDirLS:=false;          //ЛС
  MonDirGiExit:=false;      //Игрок покинул гильдию
  MonDirInviteClose:=false; //Отклонять приглашения в группы
  MonDirExitParty:=false;   //Отряд расформирован
  MonDirDied:=false;        //если умер
  MonDirParalich:=false;    //контроль паралича
  MonDirMorf:=false;        //контроль перевоплощения
  MonDirMorfSec:=false;     //контроль перевоплощения(почти закончился)
  MonDirTotem:=false;       //('тотем');
  MonDirRampage:=false;     //проверка на буйство
  MonDirTimeValk:=false;    //проверка на искажение времени
  MonDirSpeed:=false;       //проверка на скорость
  MonDirDisconnect:=false;   //Дисконнект


  nickName:='Сум основа';
  NickSTR:=ResName(nickName);     //crash

   ls:=TBitMap.Create;
   gildia:=TBitMap.Create;
   hi:=TBitMap.Create;
   InviteClose:=TBitMap.Create;
   group:=TBitMap.Create;
   died:=TBitMap.Create;
   paralich:=TBitMap.Create;
   voplot:=TBitMap.Create;
   voplottime:=TBitMap.Create;
   totem:=TBitMap.Create;
   rampage1:=TBitMap.Create;
   timevalk:=TBitMap.Create;
   speed:=TBitMap.Create;
   discinnect:=TBitMap.Create;
   discinnect1:=TBitMap.Create;
   nickNameBMP:=TBitMap.Create;

  AModule := LoadLibrary('res.dll');

  BMPFromDLL(ls,'ls',160);
  BMPFromDLL(gildia,'gildia',250);
  BMPFromDLL(hi,'hi',165);
  BMPFromDLL(nickNameBMP,ResName(nickName),250);
  BMPFromDLL(InviteClose,'InviteClose',250);
  BMPFromDLL(group,'group',250);
  BMPFromDLL(died,'died',250);
  BMPFromDLL(paralich,'paralich',120);
  BMPFromDLL(voplot,'voplot',200);
  BMPFromDLL(voplottime,'voplottime',250);
  BMPFromDLL(totem,'totem',220);
  BMPFromDLL(rampage1,'rampage1',120);
  BMPFromDLL(timevalk,'timevalk',220);
  BMPFromDLL(speed,'speed',180);
  BMPFromDLL(discinnect,'discinnect',250);
  BMPFromDLL(discinnect1,'discinnect1',250);

  while next do begin
  if NickSTR<>ResName(nickName) then
    begin
      nickNameBMP.Free;
      BMPFromDLL(nickNameBMP,ResName(nickName),250);
      NickSTR:=ResName(nickName);
    end;
    checkall;
    n:=n+1;
 //   sleep(100);
  end;

   ls.Free;
   gildia.Free;
   hi.Free;
   InviteClose.Free;
   group.Free;
   died.Free;
   paralich.Free;
   voplot.Free;
   voplottime.Free;
   totem.Free;
   rampage1.Free;
   timevalk.Free;
   speed.Free;
   discinnect.Free;
   discinnect1.Free;
   nickNameBMP.Free;
     FreeLibrary(AModule);

end;

function TMonDirThread.ResName(Monster: string): string;
begin
  if Monster='Гоблин-шахтер' then begin result:='goblinshacter'; exit; end;
  if Monster='Ящер огня' then begin result:='yasherogna'; exit; end;
  if Monster='Мантикора' then begin result:='manticora'; exit; end;
  if Monster='Дикарь' then begin result:='dicar'; exit; end;
  if Monster='Камень чакры' then begin result:='chacra'; exit; end;
  if Monster='Слизь' then begin result:='sliz'; exit; end;
  if Monster='Рак-отшельник' then begin result:='rakotshel'; exit; end;
  if Monster='Личинка' then begin result:='lichinka'; exit; end;

  if Monster='Внешний лагерь' then begin result:='homeHM'; exit; end;
  if Monster='Дом Гильдии' then begin result:='home'; exit; end;
  if Monster='Деревня Эшборн' then begin result:='eshborn'; exit; end;
  if Monster='Деревня Байрон' then begin result:='bairon'; exit; end;
  if Monster='Деревня Роден' then begin result:='roden'; exit; end;
  if Monster='Деревня Темных земель' then begin result:='darkearth'; exit; end;
  if Monster='Арена Гильдий' then begin result:='arena'; exit; end;

  if Monster='Сум основа' then begin result:='crash'; exit; end;
  if Monster='Сум твинк' then begin result:='crash1'; exit; end;
  if Monster='Маг' then begin result:='nick'; exit; end;
end;

procedure TMonDirThread.Threshold(Bitmap: TBitmap; Value: Byte; Color1,
  Color2: TColor);
type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB;
function ColorToRGB(Color: TColor): TRGB;
  begin
  with Result do
    begin
      R := Lo(Color);
      G := Lo(Color shr 8);
      B := Lo((Color shr 8) shr 8);
    end;
  end;
var x, y: Word; C1, C2: TRGB; Dest: pRGB;
begin
Bitmap.PixelFormat := pf24Bit;
C1 := ColorToRGB(Color1);
C2 := ColorToRGB(Color2);
for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
      begin
        if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value then Dest^ := C1 else Dest^ := C2; Inc(Dest);
      end;
  end;
end;
end.
PM MAIL   Вверх
Alexeis
Дата 15.5.2016, 01:45 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 34
Всего: 459
Тогда остается использование всякого рода инструментов http://www.gunsmoker.ru/2009/05/blog-post_24.html


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0743 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.