Регистрация Главная Пользователи Все разделы прочитаны
Сообщения за день Справка Регистрация
Старый 27.12.2013, 09:47   #1
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Delphi - Lazarus Компонент Lineage

Выкладываю исходник компонента 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
Вложения
Тип файла: zip Lineage Component Lazarus.zip (33.1 Кб, 50 просмотров)

Последний раз редактировалось RenatPro; 23.06.2014 в 20:16. Причина: Полный исходник
  Ответить с цитированием
Пользователь сказал cпасибо:
Павел.DO (27.12.2013)
Старый 27.12.2013, 23:11   #2
 Сержант
Аватар для Павел.DO
 
Павел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака НоррисаПавел.DO троюродный дядя Чака Норриса
Регистрация: 09.04.2010
Сообщений: 142
Популярность: 9521
Сказал(а) спасибо: 570
Поблагодарили 304 раз(а) в 197 сообщениях
Отправить сообщение для Павел.DO с помощью Skype™
 
По умолчанию Re: Delphi Компонент Lineage

Вечный респект тебе будет, если реализуешь жду с нетерпением)
________________
скайп pashok.do
OnlineUser for Darkorbit
ProfiBotTool for Darkorbit
  Ответить с цитированием
Старый 10.01.2014, 15:22   #3
 Разведчик
Аватар для zoomcat3939
 
zoomcat3939 никому не известный тип
Регистрация: 19.06.2013
Сообщений: 8
Популярность: 10
Сказал(а) спасибо: 0
Поблагодарили 2 раз(а) в 2 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

ждем на дельфи, спасибо большое
  Ответить с цитированием
Старый 10.01.2014, 21:31   #4
Reaper
 Фельдмаршал
Аватар для Dinmaite
 
Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(
Регистрация: 13.08.2009
Сообщений: 1,004
Популярность: 25098
Золото Zhyk.Ru: 350
Сказал(а) спасибо: 110
Поблагодарили 830 раз(а) в 395 сообщениях
Отправить сообщение для Dinmaite с помощью ICQ
 
По умолчанию Re: Delphi Компонент Lineage

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

Удачи.
  Ответить с цитированием
Старый 12.01.2014, 09:16   #5
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

Спасибо постараюсь все учесть)
  Ответить с цитированием
Старый 14.01.2014, 19:29   #6
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

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

Удачи.

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

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

CursHandle
CursColorPixel
CursPixelCalculating
CursPosition
Key

И вызов функций сделал проще к приме чтобы посчитать пиксели
достаточно вызвать функцию
LINEAGE1.CursPixelCalculating;
Чтобы получить информацию о кординатах и результат подсчета
достаточно Lebal1.Caption := LINEAGE1.CursPixelCalculating;
  Ответить с цитированием
Старый 14.01.2014, 20:28   #7
Reaper
 Фельдмаршал
Аватар для Dinmaite
 
Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(
Регистрация: 13.08.2009
Сообщений: 1,004
Популярность: 25098
Золото Zhyk.Ru: 350
Сказал(а) спасибо: 110
Поблагодарили 830 раз(а) в 395 сообщениях
Отправить сообщение для Dinmaite с помощью ICQ
 
По умолчанию Re: Delphi Компонент Lineage

Лучше HandleUnderCursor. и аналогично остальные. Все равно автодополнение будет работать и не придется запоминать название.
Касаемо вопроса о интервале. Самый удобный способ - цикл в потоке, приостанавливаемый слипами.
Кстати как задается интервал? Случайно или сразу на всю тысячу раз один и тот же?
  Ответить с цитированием
Старый 14.01.2014, 20:44   #8
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

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

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

Пример

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

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

Но есть одно но или даже это хорошо))
пользователь для каждой клавиши и каждому окну может задать 1-одну
одинаковую клавишу соответсвено и время повтора.
  Ответить с цитированием
Старый 14.01.2014, 21:07   #9
Reaper
 Фельдмаршал
Аватар для Dinmaite
 
Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(
Регистрация: 13.08.2009
Сообщений: 1,004
Популярность: 25098
Золото Zhyk.Ru: 350
Сказал(а) спасибо: 110
Поблагодарили 830 раз(а) в 395 сообщениях
Отправить сообщение для Dinmaite с помощью ICQ
 
По умолчанию Re: Delphi Компонент Lineage

Действия для каждого отдельного окна удобно комбинировать в отдельный поток. Тогда можно будет остановить работу в конкретном окне. Тогда касаемо клавишь с разным интервалом можно использовать конструкцию 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 мс здесь только для наглядности.
  Ответить с цитированием
Старый 14.01.2014, 22:12   #10
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

Цитата:
Сообщение от 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 раз такой)

Последний раз редактировалось RenatPro; 14.01.2014 в 22:47. Причина: Добавлено сообщение
  Ответить с цитированием
Старый 14.01.2014, 22:38   #11
Reaper
 Фельдмаршал
Аватар для Dinmaite
 
Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(
Регистрация: 13.08.2009
Сообщений: 1,004
Популярность: 25098
Золото Zhyk.Ru: 350
Сказал(а) спасибо: 110
Поблагодарили 830 раз(а) в 395 сообщениях
Отправить сообщение для Dinmaite с помощью ICQ
 
По умолчанию Re: Delphi Компонент Lineage

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

if (sleepinterval mod interval_for_f1)=0 then
use_f1;


Кроме того, sleepinterval нужно обнулять иногда, чтобы не было переполнения.
  Ответить с цитированием
Старый 14.01.2014, 22:59   #12
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

Цитата:
Сообщение от 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;

Последний раз редактировалось RenatPro; 14.01.2014 в 23:13.
  Ответить с цитированием
Старый 14.01.2014, 23:46   #13
Reaper
 Фельдмаршал
Аватар для Dinmaite
 
Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(Dinmaite сломал счётчик популярности :(
Регистрация: 13.08.2009
Сообщений: 1,004
Популярность: 25098
Золото Zhyk.Ru: 350
Сказал(а) спасибо: 110
Поблагодарили 830 раз(а) в 395 сообщениях
Отправить сообщение для Dinmaite с помощью ICQ
 
По умолчанию Re: Delphi Компонент Lineage

Первый поток. Первое окно.
Код:
...................................
описание потока
...................................
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

Аналогично создаем поток для второго окна, для третьего, и так далее.
  Ответить с цитированием
Старый 14.01.2014, 23:58   #14
 Старший сержант
Аватар для RenatPro
 
RenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известенRenatPro скоро будет известен
Регистрация: 30.03.2013
Сообщений: 209
Популярность: 377
Сказал(а) спасибо: 7
Поблагодарили 54 раз(а) в 33 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

Цитата:
Сообщение от 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%))

Последний раз редактировалось RenatPro; 15.01.2014 в 22:01. Причина: Добавлено сообщение
  Ответить с цитированием
Старый 15.01.2014, 22:17   #15
 Разведчик
Аватар для Dinmaite[Work]
 
Dinmaite[Work] лучик света в грозовом небеDinmaite[Work] лучик света в грозовом небеDinmaite[Work] лучик света в грозовом небеDinmaite[Work] лучик света в грозовом небеDinmaite[Work] лучик света в грозовом небеDinmaite[Work] лучик света в грозовом небеDinmaite[Work] лучик света в грозовом небе
Регистрация: 05.03.2011
Сообщений: 40
Популярность: 841
Сказал(а) спасибо: 1
Поблагодарили 9 раз(а) в 8 сообщениях
 
По умолчанию Re: Delphi Компонент Lineage

А показать как сделал?
________________
Dinmaite пишет с меня, когда он на работе.
  Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[Помогите!] Динамически созданный компонент NebesaBag Вопросы и ответы, обсуждения 3 04.10.2013 21:00
[Руководство] Настраиваем Delphi 2010/XE, чтобы она выглядела как Delphi 7 RifmoGlas Pascal/Delphi 2 09.02.2013 14:09
[Помогите!] Компонент Chart, MS VS 2010, C++ Windows Forms 0SkYneT0 Вопросы и ответы, обсуждения 0 21.06.2012 19:02
компонент для joomla sasiskavs Вопросы и ответы, обсуждения 0 19.04.2011 15:59

Заявление об ответственности / Список мошенников

Часовой пояс GMT +4, время: 19:19.

Пишите нам: [email protected]
Copyright © 2024 vBulletin Solutions, Inc.
Translate: zCarot. Webdesign by DevArt (Fox)
G-gaMe! Team production | Since 2008
Hosted by GShost.net