Delphi Компонент Lineage

[RenatPro]

Выкладываю исходник компонента LINEAGE;
Не супер пупер но пиксельного бота вполне можно написать без особых усилий.
Описание: Можно управлять неограниченным количества окон из 1 программы, Авто рыбалка любая, Эмуляция мыши и клавиш!
Все работает на динамически созданных таймерах в исходнике есть не большое описание, если есть явные косяки в коде прошу отписать а так пользуйтесь!)

Работу компонента можно посмотреть тут:[Ссылки могут видеть только зарегистрированные пользователи. ]

Большое спасибо за помощь! Dinmaite)

Тут полный исходник для Delphi и Lazarus

unit LINEAGE;

{Автор: Зинатуллин Ренат Айратович Nick: BIT, BIT Hack, RenatPro}

{
LINEAGE.key(Handle, 'F1');//Отправляем
LINEAGE.CursHandle; //Получаем под курсором;
LINEAGE.CursColorPixel; //Получаем под курсором;
LINEAGE.CursPosition.x; //Получаем под курсором;
LINEAGE.CursPosition.y; //Получаем под курсором;
LINEAGE1.CursPixelCalculating;//Подсчет пикселей

//Создание таймера для каждой клавиши
var
  i:integer;
begin
   for i:=0 to StringGrid1.RowCount -1 do
LINEAGE1.Key(strtoint(StringGrid1.Cells[0,i]),strtoint(StringGrid1.Cells[1,i] )* 1000,StringGrid1.Cells[2,i],i);

}



{$mode objfpc}{$H+}

interface

uses
  Windows, ExtCtrls, Classes, SysUtils, LResources, Forms, Controls,
  Graphics, Dialogs, Buttons;

type

  { TLINEAGE }

  TLINEAGE = class(TComponent)
  private
    FComparet: string;  //Свойство компонента
    procedure ComparetString(Value: string);
    { Private declarations }
  protected
    { Protected declarations }
  public


    function CursHandle: integer;
    function CursColorPixel: hdc;
    function CursPosition: TPoint;
    function TimKey(Handle: integer; keyl: string): integer;
    function CursPixelCalculating: string; //X: integer; Y: integer;
    procedure Tim(Sender: TObject);
    function Key(Handle: integer; keyReceived: string; time: integer;
      Count: integer; Color: string; Replace: integer; Xv: integer;
      Yv: integer): integer;
    procedure Timestop(stop: boolean);

    procedure TimFree;


    function log(lg: string): string;
    function key_log(k_lg: string): string;

    { Public declarations }
  published
    constructor Create(Aowner: TComponent); override;
    property Activation: string read FComparet write ComparetString;
    //Свойство компонента

    { Published declarations }
  end;

procedure Register;

implementation


var
  Wnd: variant;
  p: TPoint;
  dc: hdc;
  keyh: integer;
  X: integer;
  Y: integer;
  po: string;
  Timer: array of TTimer;
  Time_Key: array of string;
  Time_Wnd: array of integer;
  Time_Color: array of string;
  Time_Replace: array of integer;
  Time_Real: array of integer;

  PositionColorX: array of integer; //Координаты цвета
  PositionColorY: array of integer; //Координаты цвета


  Timstop: boolean = True;

  Logtx: string;


  StringgridSave: string;

procedure Register;
begin
  {$I lineage_icon.lrs}
  RegisterComponents('LINEAGE', [TLINEAGE]);
end;

{ TLINEAGE }

//*
procedure TLINEAGE.ComparetString(Value: string);
begin
  StringgridSave := Value;
  FComparet := Value;
end;

constructor TLINEAGE.Create(Aowner: TComponent);
begin
  inherited Create(Aowner);

end;

//CursHandle Окно под курсором
function TLINEAGE.CursHandle: integer;
begin
  Wnd := WindowFromPoint(Mouse.CursorPos);
  Result := Wnd;
end;
//CursColor Цвет под курсором
function TLINEAGE.CursColorPixel: hdc;
begin

  dc := GetDC(0);
  Result := GetPixel(dc, CursPosition.x, CursPosition.y);
  X := CursPosition.x;
  Y := CursPosition.y;
  ReleaseDC(0, dc);
end;
//CursPosition  Позиция курсора
function TLINEAGE.CursPosition: TPoint;
begin
  GetCursorPos(p);
  Result := p;
end;
//send Key Отправить клавишу в окно игры
function TLINEAGE.TimKey(Handle: integer; keyl: string): integer;
var
  i: integer;
  s: string;
begin
  //log(keyl);
  //ShowMessage(' Отработала');
  case keyl of
    'F1':
    begin
      PostMessage(handle, WM_KEYDOWN, VK_F1, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, VK_F1, 0);
    end;
    'F2':
    begin
      PostMessage(handle, WM_KEYDOWN, 113, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 113, 0);
      keyh := 0;
    end;
    'F3':
    begin
      PostMessage(handle, WM_KEYDOWN, 114, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 114, 0);
    end;
    'F4':
    begin
      PostMessage(handle, WM_KEYDOWN, 115, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 115, 0);
    end;
    'F5':
    begin
      PostMessage(handle, WM_KEYDOWN, 116, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 116, 0);
    end;
    'F6':
    begin
      PostMessage(handle, WM_KEYDOWN, 117, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 117, 0);
    end;
    'F7':
    begin
      PostMessage(handle, WM_KEYDOWN, 118, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 118, 0);
    end;
    'F8':
    begin
      PostMessage(handle, WM_KEYDOWN, 119, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 119, 0);
    end;
    'F9':
    begin
      PostMessage(handle, WM_KEYDOWN, 120, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 120, 0);
    end;
    'F10':
    begin
      PostMessage(handle, WM_KEYDOWN, 121, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 121, 0);
    end;
    'F11':
    begin
      PostMessage(handle, WM_KEYDOWN, 122, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 122, 0);
    end;
    'F12':
    begin
      PostMessage(handle, WM_KEYDOWN, 123, 0);
      sleep(3);
      PostMessage(handle, WM_KEYUP, 123, 0);
    end;
    else
    begin
      s := keyl;
      for i := 1 to length(s) do
        keyh := Ord(s[i]);
      PostMessage(handle, WM_KEYDOWN, byte(keyh), 0);
      sleep(10);
     PostMessage(handle, WM_KEYUP, byte(keyh), 0);
    end;
  end;
end;

//Подсчет пикселей под курсором
function TLINEAGE.CursPixelCalculating: string;
var
  PixelColor: hdc;
  Pixel: hdc;
  i: integer;
  r: integer;
  li: integer;
  min: integer;
begin
  //Подсчет в лево
  Pixel := CursColorPixel;
  PixelColor := CursColorPixel;
  for i := 1 to Pixel do
    if PixelColor <> Pixel then
    begin
      break;

    end
    else
    begin
      SetCursorPos(x - i, y);
      dc := GetDC(0);
      // это мы получаем контекст экрана
      PixelColor := GetPixel(dc, x - i, y);
      // присваиваем панели цвет
      li := i;
      ReleaseDC(0, dc);
    end;
  min := CursPosition.x;
  //Подсчет в право
  if i = Pixel then

    r := i;
  i := 0;

  PixelColor := Pixel;

  for r := 1 to Pixel do
    if PixelColor <> Pixel then
    begin
      break;
    end
    else
    begin

      SetCursorPos(x + r, y);
      dc := GetDC(0);
      // это мы получаем контекст экрана
      PixelColor := GetPixel(dc, x + r + 1, y);
      // присваиваем панели цвет
      ReleaseDC(0, dc);

    end;

  //минимум кордината цвет максимум
  //Result := IntToStr(min) + ':' + IntToStr(CursPosition.x);
  Result := IntToStr(min);
end;

// Application.ProcessMessages;
//ShowMessage(' Отработало');
//Обработка таймеров посылка клавиш в процедуру Key
procedure TLINEAGE.Tim(Sender: TObject);
var
  DCl: HDC;
  i, j: integer;
  CompareColor: HDC;

  s: string;
  VolumeNameTime, SystemTime: array [0..MAX_PATH - 1] of char;
  VolumeTime: DWord;
  MaxTime, FlagsTime: cardinal;

  PLenTime: array [0..MAX_COMPUTERNAME_LENGTH + 1] of char;
  LenTime: cardinal;
  RowSav: string;


begin
   //Привязка к железу номер жесткого получаем аналогично
  GetVolumeInformation('C:', VolumeNameTime, MAX_PATH, @VolumeTime,
  MaxTime, FlagsTime, SystemTime, MAX_PATH);
  ZeroMemory(@PLenTime, SizeOf(PLenTime));
  LenTime := MAX_COMPUTERNAME_LENGTH + 1;
  GetComputerName(@PLenTime, LenTime);
  for i := 0 to High(PLenTime) - 1 do
    for j := 0 to Length(IntToHex(VolumeTime, 8)) - 1 do
      RowSav := RowSav + IntToStr(Ord(PLenTime[i]) xor j);

  if StringgridSave = RowSav then
  else
  begin
    TimFree;
  end;


  if Timstop = False then
  begin
    TimFree; //Убиваем таймеры
  end
  else

    for i := 1 to High(Timer) do
    begin

      //Читаем из массива цвет если массив цвета не пуст то делаем
      if (Time_Color[i] <> '0') and ((Sender as TTimer).Name = Timer[i].Name) and
        (PositionColorX[i] <> 0) then
      begin
        DCl := GetDC(0);
        CompareColor := GetPixel(DCl, PositionColorX[i], PositionColorY[i]); //RGB
        ReleaseDC(0, DCl);
      end;


      //Если цвет совпал перепишем время на реал
      if (IntToStr(CompareColor) = Time_Color[i]) and (Time_Color[i] <> '0') and
        ((Sender as TTimer).Name = Timer[i].Name) and (PositionColorX[i] <> 0) and
        (Time_Replace[i] = 0) then
      begin
        // TimKey(Time_Wnd[i], Time_Key[i]); //Процедура клавиш
        (Sender as TTimer).Interval := Time_Real[i]; //Реальное время
        log(Time_Key[i]);
        break;
      end;

      //Если цвет не совпал то повтор
      if (IntToStr(CompareColor) <> Time_Color[i]) and (Time_Color[i] <> '0') and
        ((Sender as TTimer).Name = Timer[i].Name) and (Time_Replace[i] = 0) and
        (PositionColorX[i] <> 0) then
      begin
        TimKey(Time_Wnd[i], Time_Key[i]); //Процедура клавиш
        (Sender as TTimer).Interval := Time_Real[i]; //Реальное время
        log(Time_Key[i]);
        break;
      end;



      //Если не совпал это пауза
      if (IntToStr(CompareColor) <> Time_Color[i]) and (Time_Color[i] <> '0') and
        ((Sender as TTimer).Name = Timer[i].Name) and (PositionColorX[i] <> 0) and
        (Time_Replace[i] <> 0) then
      begin
        (Sender as TTimer).Interval := Time_Replace[i];
        //Тут переписываем время повтор таймера
        log(Time_Key[i] + ' :Пауза');
        break;
      end;



      //Выпоняем если массив Time_Color пуст
      if (Time_Real[i] = (Sender as TTimer).Interval) and (Time_Color[i] = '0') and
        (Time_Replace[i] = 0) and ((Sender as TTimer).Name = Timer[i].Name) and
        (PositionColorX[i] = 0) then
      begin
        TimKey(Time_Wnd[i], Time_Key[i]);
        log(Time_Key[i]);
        break;
      end;

    end;

end;


//Создаем таймер и массивы с Handle Key Time
function TLINEAGE.Key(Handle: integer; keyReceived: string; time: integer;
  Count: integer; Color: string; Replace: integer; Xv: integer; Yv: integer): integer;
begin
  Timstop := True;
  SetLength(Timer, Count + 1);// Timer - размерность массива
  SetLength(Time_Key, Count + 1);// Timekey - размерность массива
  SetLength(Time_Wnd, Count + 1);// Timewnd - размерность массива
  SetLength(Time_Color, Count + 1);// Timer - размерность массива
  SetLength(Time_Replace, Count + 1);// Timer - размерность массива
  SetLength(PositionColorX, Count + 1);// X - координата
  SetLength(PositionColorY, Count + 1);// Y - координата
  SetLength(Time_Real, Count + 1);// Timer - размерность массива

  Timer[Count] := TTimer.Create(Timer[Count]);//Создаем таймер
  Timer[Count].Name := 'name' + IntToStr(Count);//Имя таймера
  Time_Wnd[Count] := Handle;//Time_Wnd Окно игры
  Timer[Count].Interval := time;//Timer Интервал таймера

  Time_Key[Count] := keyreceived;//Time_KeyКлавиша
  Time_Real[Count] := time; //Time_Real копия текущего времени

  Time_Color[Count] := Color;
  Time_Replace[Count] := Replace; //Пауза время
  PositionColorX[Count] := Xv;
  PositionColorY[Count] := Yv;


  Timer[Count].OnTimer := @Tim;  //Процедура обработки таймера
end;


//удаляем все таймеры из памяти
procedure TLINEAGE.TimFree;
var
  i: integer;
begin
  Time_Key := nil;
  Time_Wnd := nil;
  Time_Replace := nil;
  Time_Real := nil;
  Time_Color := nil;
  for i := 1 to High(Timer) do
  begin
    Timer[i].Enabled := False;
    Timer[i].Destroy;
  end;
  Timer := nil;

end;

//Лог
function TLINEAGE.log(lg: string): string;
begin
  Logtx := lg;
  key_log(lg);
end;
//Лог
function TLINEAGE.key_log(k_lg: string): string;
begin
  Result := Logtx;
end;


//Стоп таймеры
procedure TLINEAGE.Timestop(stop: boolean);
begin
  Timstop := stop;
end;

end.

Готовый компонент прикреплен ниже для Lazarus

[Павел.DO]

Вечный респект тебе будет, если реализуешь жду с нетерпением)

[zoomcat3939]

ждем на дельфи, спасибо большое

[Dinmaite]

Ну что я могу сказать.
Во первых - поиск в выделенной процессу памяти стоит вынести в отдельный поток, т.к. это долговременный процесс.
Во вторых я бы отказался от использования типа variant.
В третьих - стоило бы называть функции более говорящими именами. TL.color это цвет компонента, но не цвет под курсором, если следовать принятой логике именования. Все компоненты рассчитывают на то, что ими будут пользоваться люди.
В четвертых - передача названия клавиши строкой - просто плохая идея, ведь позволяет сделать ошибку на которую не отреагирует компилятор. К тому же можно будет оптимизировать код за счет использования предопределенных констант. Я не знаю как оно в Лазарусе, но делфи предлагает полный набор констант для функциональных клавиш. В любом случае можно определить их и самому. В той же функции стоит использовать локальную константу keyh, вместо глобальной. Насколько помню L2 не требует отсылки сообщения WM_KeyUp в обязательном порядке.

Удачи.

[RenatPro]

Спасибо постараюсь все учесть)

[RenatPro]

Цитата: Сообщение от Dinmaite Ну что я могу сказать. Во первых - поиск в выделенной процессу памяти стоит вынести в отдельный поток, т.к. это долговременный процесс. Во вторых я бы отказался от использования типа variant. В третьих - стоило бы называть функции более говорящими именами. TL.color это цвет компонента, но не цвет под курсором, если следовать принятой логике именования. Все компоненты рассчитывают на то, что ими будут пользоваться люди. В четвертых - передача названия клавиши строкой - просто плохая идея, ведь позволяет сделать ошибку на которую не отреагирует компилятор. К тому же можно будет оптимизировать код за счет использования предопределенных констант. Я не знаю как оно в Лазарусе, но делфи предлагает полный набор констант для функциональных клавиш. В любом случае можно определить их и самому. В той же функции стоит использовать локальную константу keyh, вместо глобальной. Насколько помню L2 не требует отсылки сообщения WM_KeyUp в обязательном порядке. Удачи.

Спасибо еще раз и сразу вопрос как сделать отправку клавиш с интервалом но для 1 клавиши может быть до 1000 повторв с разным интервалом я сам пробовал и в потоках и в массивах и что только в голову не лезло так и несмог помогите)

По названием функций думаю сейчас все ясно?)

CursHandle
CursColorPixel
CursPixelCalculating
CursPosition
Key

И вызов функций сделал проще к приме чтобы посчитать пиксели
достаточно вызвать функцию
LINEAGE1.CursPixelCalculating;
Чтобы получить информацию о кординатах и результат подсчета
достаточно Lebal1.Caption := LINEAGE1.CursPixelCalculating;

[Dinmaite]

Лучше HandleUnderCursor. и аналогично остальные. Все равно автодополнение будет работать и не придется запоминать название.
Касаемо вопроса о интервале. Самый удобный способ - цикл в потоке, приостанавливаемый слипами.
Кстати как задается интервал? Случайно или сразу на всю тысячу раз один и тот же?

[RenatPro]

Цитата: Сообщение от Dinmaite Лучше HandleUnderCursor. и аналогично остальные. Все равно автодополнение будет работать и не придется запоминать название. Касаемо вопроса о интервале. Самый удобный способ - цикл в потоке, приостанавливаемый слипами. Кстати как задается интервал? Случайно или сразу на всю тысячу раз один и тот же?

Рассмотрим на StringGrid пользователь заполняет рандомна клавиши, время.
Хорошо я пробегаю по ячейкам собираю информацию о клавишах окнах и
времени повтора!
И где обработать время повтора для каждой клавиши?

Пример

F1 Окно 1 время повтора 10 мин
F1 Окно 2 время повтора 10 милесекунд
F1 Окно 3 время повтора 10 сек

И такдалие до F12

Но есть одно но или даже это хорошо))
пользователь для каждой клавиши и каждому окну может задать 1-одну
одинаковую клавишу соответсвено и время повтора.

[Dinmaite]

Действия для каждого отдельного окна удобно комбинировать в отдельный поток. Тогда можно будет остановить работу в конкретном окне. Тогда касаемо клавишь с разным интервалом можно использовать конструкцию case или разветвитель if.

while true do
begin
case sleepinterval of
1000:use_F1;
2000:use_F2;
3000:use_F3;
end;
sleep(1)
inc(sleepinterval)
end;

F1 - 1 секундный интервал, F2 - 2 секундный интервал, F3 - 3 секундный интервал.

while true do
begin
if sleepinterval=interval_for_f1 then use_f1;
if sleepinterval=interval_for_f2 then use_f2;
sleep(1);
inc(sleepinterval)
end;

Этот код позволяет задавать интервалы динамически.


Лучше использовать задержку как минимум в 200 мс. 1 мс здесь только для наглядности.

[RenatPro]

Цитата: Сообщение от Dinmaite while true do begin case sleepinterval of 1000:use_F1; 2000:use_F2; 3000:use_F3; end; sleep(1) inc(sleepinterval) end; F1 - 1 секундный интервал, F2 - 2 секундный интервал, F3 - 3 секундный интервал. while true do begin if sleepinterval=interval_for_f1 then use_f1; if sleepinterval=interval_for_f2 then use_f2; sleep(1); inc(sleepinterval) end; Этот код позволяет задавать интервалы динамически. Лучше использовать задержку как минимум в 200 мс. 1 мс здесь только для наглядности.

Как я понял мне в переменую sleepinterval нужно передать время повтора?

Так хорошо а если я незнаю сколько клавиш будет создано?

Допостим я проганяю цикл передаю в sleepinterval значение времини

Тут я бегаю в потоке бесконечным циклом

while true do

begin

case sleepinterval of

1000: begin
//Типо мое время выполняю действие
//......
end

sleep(1)
inc(sleepinterval)
end;

А нет перечитал я тебя не правильно понял ну не могу догнать я сам алгоритм не пойму объясни пожалуйста на пальцах))

Добавлено через 9 минут
И непонятно для чего inc(sleepinterval) что мне в нем подсчитывать сколько раз обработался цикл но зачем?

Получается что по твоему коду то же самое что я немогу сделать

var
interval_for_f1, interval_for_f2 :integer;
l:integer;
sleepinterval:integer;

while true do
begin
interval_for_f1:=StringGrid1.Cells[1, l] // 100 сек
interval_for_f2:=StringGrid1.Cells[1, l] // 50 сек

if sleepinterval=interval_for_f1 then
use_f1;
if sleepinterval=interval_for_f2 then
use_f2;
sleep(1);
inc(sleepinterval)
end;
end;

end.


Так можно и вот так но это не то


procedure TForm1.Timer1Timer(Sender: TObject);
var
interval_for_f1, interval_for_f2 :integer;
l:integer;
sleepinterval:integer;

begin
interval_for_f1:=StringGrid1.Cells[1, l] = '100';//сек
interval_for_f1:=StringGrid1.Cells[1, l] = '50';//сек

if sleepinterval=interval_for_f1 then
begin
Sleep(sleepinterval);
PostMessage(wndh, WM_KEYDOWN, vk_f1, 0);
end;

if sleepinterval=interval_for_f2 then
Sleep(sleepinterval);
PostMessage(wndh, WM_KEYDOWN, vk_f2, 0);
end;

inc(sleepinterval) Тут еще надо сбрасывать счетчик

end;

С ошибками написал код ну неважно смысел понятен)

Идея заключается в том что бы пользователь мог подключить хоть сколько окон и клавиш к ним от F1 до F12 ну не буду же я писать код 1000 раз такой)

[Dinmaite]

Весь цикл останавливается на 1мс. Значит за секунду цикл отрабртает 1000 раз, значит выполнится функция use_f1. Я знемного неверно написал. Нужно:

if (sleepinterval mod interval_for_f1)=0 then
use_f1;


Кроме того, sleepinterval нужно обнулять иногда, чтобы не было переполнения.

[RenatPro]

Цитата: Сообщение от Dinmaite Весь цикл останавливается на 1мс. Значит за секунду цикл отрабртает 1000 раз, значит выполнится функция use_f1. Я знемного неверно написал. Нужно: if (sleepinterval mod interval_for_f1)=0 then use_f1; Кроме того, sleepinterval нужно обнулять иногда, чтобы не было переполнения.

Я как понял этот код для 1 окна ну или клавиши?

Повтарюсь

F1 Окно 1 время повтора 10 мин
F1 Окно 2 время повтора 10 милесекунд
F1 Окно 3 время повтора 10 сек

Так же может быть

F1 Окно 1 время повтора 10 мин
F1 Окно 2 время повтора 10 милесекунд
F1 Окно 3 время повтора 10000000 сек
F1 Окно 4 время повтора 400мин
F1 Окно 5 время повтора 800 милесекунд
F1 Окно 6 время повтора 1 сек
F1 Окно 7 время повтора 10000 мин
F1 Окно 8 время повтора 1089 милесекунд
F1 Окно 9 время повтора 163 сек

И тогдалие на 1 клавишу разный повтор времини и Handle

Так тоже не удобно

while true do
begin
case sleepinterval of
1000:use_F1;
2000:use_F1;
3000:use_F1;
1000:use_F1;
2000:use_F1;
4000:use_F1;
5000:use_F1;
6000:use_F1;
7000:use_F1;
8000:use_F1;
9000:use_F1;
10000:use_F1;
11000:use_F1;
12000:use_F1;
13000:use_F1;

и тогдалие.................

end;
sleep(1)
inc(sleepinterval)
end;

[Dinmaite]

Первый поток. Первое окно.

...................................
описание потока
...................................
public
interval_for_any_key:integer;
key:byte;
...................................
описание потока
...................................

var 
  sleepinterval:integer;
  begin
  while true do
  begin
    if (sleepinterval mod interval_for_any_key)=0 then
      use_any_key;
    sleep(1000);
    if sleepinterval>(maxint-2000) then 
    sleepinterval:=0;  //обнуление переменной воизбежание переполнения.
    sleepinterval:=sleepinterval+1000;
  end;
end;

, где sleepinterval - инкрементируемая переменная.
interval_for_any_key - интервал для любой клавиши, задается динамически при создании потока.
use_any_key(key) - функция в которой указано действие клавиши (функцией для краткости обозначил), key здесь код клавиши.

Конкретно для варианта
F1 Окно 1 время повтора 10 мин

interval_for_any_key = 600 000 мс = 10 мин.
key = VK_F1

Аналогично создаем поток для второго окна, для третьего, и так далее.

[RenatPro]

Цитата: Сообщение от Dinmaite Первый поток. Первое окно. ................................... описание потока ................................... public interval_for_any_key:integer; key:byte; ................................... описание потока ................................... var sleepinterval:integer; begin while true do begin if (sleepinterval mod interval_for_any_key)=0 then use_any_key; sleep(1000); if sleepinterval>(maxint-2000) then sleepinterval:=0; //обнуление переменной воизбежание переполнения. sleepinterval:=sleepinterval+1000; end; end; , где sleepinterval - инкрементируемая переменная. interval_for_any_key - интервал для любой клавиши, задается динамически при создании потока. use_any_key(key) - функция в которой указано действие клавиши (функцией для краткости обозначил), key здесь код клавиши. Конкретно для варианта F1 Окно 1 время повтора 10 мин interval_for_any_key = 600 000 мс = 10 мин. key = VK_F1 Аналогично создаем поток для второго окна, для третьего, и так далее.

Окей спасиб большое завтра постараюсь разобрать у нас уже ноч спать пойду)!

Добавлено через 21 час 51 минуту
Скажу честно не стал голову ломать над твоим кодом посидел подумал и сделал как надо 5 строчек кода получилось но всеровно тебе спасибо!
Без потоков и лишних компонентов) При 100 задач нагрузга на процессор 1%))

[Dinmaite[Work]]

А показать как сделал?