Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.04.2021, 14:26   #1
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию Работа с потоками Delphi (получение переменной из потока)

Не могу поправить код, чтоб он работал.
Задача:
Создать поток, который бы проверял несколько есловий и формировал из них массив значений, которые бы можно было получить из основной формы нажатием клавиши.

Код:
type
  TMonitorThread = class(TThread)
  private
    PlayerNick: String;
 
  protected
    procedure Execute; override;
  public
    MonitorSTR:array[1..15] of integer;
    constructor Create( PlayerNick: String);
  end;
 
constructor TMonitorThread.Create(PlayerNick: String);
begin
  inherited Create(True);
  Self.PlayerNick:=PlayerNick;
  Resume;
end;
 
procedure TMonitorThread.Execute;
var
serverBool:boolean;
begin
while not Terminated do
  begin //мониторинг скилов
    sleep(100);
 
    //оф
    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 MonitorSTR[2]:=1 else MonitorSTR[2]:=0;
    end;
 
  end;
end;
Создаю экземпляр класса так:
Код:
TMonitorThread.Create(name.text);
Пытаюсь получить одно значение с массива, но не компилируется.
Код:
procedure TForm1.sButton23Click(Sender: TObject);
var
i:integer;
begin
  i:= TMonitorThread.monitorSTR[2];
end;
;
PS при создании потока необходимо как то потом к нему обратиться, но как я не понимаю (
stlcrash вне форума Ответить с цитированием
Старый 12.04.2021, 16:58   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию

Цитата:
Создаю экземпляр класса так:
Код:
r:=TMonitorThread.Create(name.text);
созданный объект (если его собираются использовать) надо присваивать КУДА-ТО.
где им смогут воспользоваться.
Код:
i:=r.monitorSTR[2];
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 13.04.2021, 12:34   #3
stlcrash
Форумчанин
 
Регистрация: 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.
stlcrash вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Получение данных из потока bilibian Общие вопросы Delphi 33 08.11.2015 11:35
[Delphi XE3] Работа с потоками -Jack- Общие вопросы Delphi 6 03.01.2014 05:31
Delphi работа с потоками -Jack- Общие вопросы Delphi 3 12.09.2013 01:43
Работа с потоками в Delphi TRIZER Общие вопросы Delphi 1 26.06.2010 10:02
Управление потоками. Запуск, остановка, приоритет потока. metamfetamin Помощь студентам 5 11.11.2007 12:45