Показать сообщение отдельно
  #5  
Старый 24.07.2025, 13:06
Dreammaster Dreammaster вне форума
Прохожий
 
Регистрация: 11.06.2014
Сообщения: 39
Версия Delphi: RAD Studio XE3
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Ну а если не должно - зачем пишешь так?
Инициализация переменных из описании работает нормально. Куча файлов есть, где так же делал и всё работает. Не должно быть ошибки. Но она есть...
upd.
Всё оказалось очень просто. hHook переобозвал в MyHook и всё заработало.

Код:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Windows;

const
  WH_KEYBOARD_LL = 13;

type
  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
  TKBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;

  { TForm1 }
  TForm1 = class(TForm)
    ClickTimer: TTimer;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    MoveTimer: TTimer;
    StatusLabel: TLabel;
    procedure ClickTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure MoveTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function LLKeyProc(nCode: integer; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;

var
  Form1: TForm1;
  MyHook: HHOOK = 0;      // Не нравилось название переменной!
  isEmulationActive: Boolean = False;
  moveDirection: Integer = 1;
  originalPos: TPoint;

implementation

{$R *.lfm}

{ TForm1 }


function LLKeyProc(nCode: integer; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
var
  keyInfo: PKBDLLHOOKSTRUCT;
  vk: DWORD;
begin
  Result := 0;
  if nCode = HC_ACTION then
  begin
    keyInfo := PKBDLLHOOKSTRUCT(lp);
    if Assigned(keyInfo) then
    begin
        vk := keyInfo^.vkCode;
        if (wp = WM_KEYDOWN) or (wp = WM_SYSKEYDOWN) then
        begin
          case vk of
            VK_F3:
              begin
                if not isEmulationActive then
                begin
                  isEmulationActive := True;
                  Form1.StatusLabel.Caption := 'Статус: РАБОТАЕТ (F4 - стоп)';
                  Form1.StatusLabel.Font.Color := clGreen;
                  GetCursorPos(originalPos);
                  moveDirection := 1;
                  Form1.ClickTimer.Interval := StrToIntDef(Form1.Edit1.Text, 120);
                  Form1.MoveTimer.Interval := StrToIntDef(Form1.Edit3.Text, 1000);
                  Form1.ClickTimer.Enabled := True;
                  Form1.MoveTimer.Enabled := True;
                end;
              end;
            VK_F4:
              begin
                if isEmulationActive then
                begin
                  isEmulationActive := False;
                  Form1.StatusLabel.Caption := 'Статус: ОСТАНОВЛЕНО (F3 - старт)';
                  Form1.StatusLabel.Font.Color := clRed;
                  Form1.ClickTimer.Enabled := False;
                  Form1.MoveTimer.Enabled := False;
                end;
              end;
          else
            Result := CallNextHookEx(MyHook, nCode, wp, lp);
          end;
        end
        else
          Result := CallNextHookEx(MyHook, nCode, wp, lp);
    end
    else
        Result := CallNextHookEx(MyHook, nCode, wp, lp);
  end
  else
    Result := CallNextHookEx(MyHook, nCode, wp, lp);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  StatusLabel.Caption := 'Статус: ОСТАНОВЛЕНО (F3 - старт)';
  StatusLabel.Font.Color := clRed;
  MyHook := SetWindowsHookEx(WH_KEYBOARD_LL, @LLKeyProc, HInstance, 0);
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if MyHook <> 0 then
    UnhookWindowsHookEx(MyHook);
end;

procedure TForm1.ClickTimerTimer(Sender: TObject);
begin
  if isEmulationActive then
  begin
    mouse_event(MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, GetMessageExtraInfo);
  end;
end;

procedure TForm1.MoveTimerTimer(Sender: TObject);
var
  distance: Integer;
  currentPos: TPoint;
begin
  if not isEmulationActive then
    Exit;
  distance := StrToIntDef(Edit2.Text, 100);
  GetCursorPos(currentPos);

  if moveDirection = 1 then
  begin
    SetCursorPos(originalPos.X + distance, currentPos.Y);
    moveDirection := -1;
  end
  else
  begin
    SetCursorPos(originalPos.X, currentPos.Y);
    moveDirection := 1;
    SetCursorPos(originalPos.X, currentPos.Y + 5);
    GetCursorPos(originalPos);
  end;
end;

end.
Ответить с цитированием