PDA

Просмотр полной версии : Hot Key для Warcraft3


Aleksandr550
07.02.2014, 20:43
Пишу хот кей для варкрафта.Проблема с функциями Инвокера, не срабатывает автокаст заклинаний. Подскажите в чем проблема и как лучше реализовать.
Компоненты поставлены на форму не совсем в последовательном порядке.
Ссылка на проект: [Ссылки могут видеть только зарегистрированные и активированные пользователи]

сам код:
unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils,Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
Vcl.ComCtrls, System.Classes;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
TabSheet2: TTabSheet;
Edit7: TEdit;
Edit8: TEdit;
Label7: TLabel;
Label8: TLabel;
Edit9: TEdit;
Edit10: TEdit;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
TabSheet3: TTabSheet;
Edit11: TEdit;
Edit12: TEdit;
Edit13: TEdit;
Edit14: TEdit;
Edit15: TEdit;
Edit16: TEdit;
Edit17: TEdit;
Edit18: TEdit;
Edit19: TEdit;
Edit20: TEdit;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
CheckBox13: TCheckBox;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Unregister();

private
{ Private declarations }

public
{ Public declarations }
procedure WMHotKey(var Message:TMessage); message WM_HOTKEY;
procedure QuickMessage1(text:string);
procedure DoMyHotKey(key:word);
function RegisterInvok(key:byte;id:integer;infolabel:Tlabel ):boolean;
procedure InvokerHotKey(k1,k2,k3,k4,K5:byte;AvtoCast:boolean );
end;
const
MyWindowName='Warcraft III'; //имя нашего приложения
MyWindowClass='Warcraft III'; //класс нашего приложения
KeyCount=20 ;//колличество горячих клавиш
//коды клавиш для Инвокера
Q:byte=81;
W:byte=87;
E:byte=69;
R:byte=82;
Y:byte=89;
V:byte=86;
X:byte=88;
G:byte=71;
F:byte=70;
Z:byte=90;
D:byte=68;
C:byte=67;
T:byte=84;
B:byte=66;
var
Form1: TForm1;
MyWindow:Hwnd; //здесь будет указатель на приложение
RegOKArray: array [1..KeyCount] of boolean;//для проверки регистрации горячих клавиш
implementation

{$R *.dfm}

//регистрация Invoker Hot Key
function TForm1.RegisterInvok(key:byte;id:integer;infolabel :Tlabel):boolean;
var
OK:boolean;
begin
ok:=RegisterHotKey(Handle,id, mod_SHIFT , key);
if ok=false then //если что-то пошло не так, то сообщаем
begin
infolabel.Font.Color:=clRed;
showmessage('Error Invoker Key '+inttostr(id));
end
else infolabel.Font.Color:=clGreen;
Result:=ok;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
unregister();//вычистим мусор
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
sleep(1);//костыль(временно)
end;

//Хот кей Invoker
procedure TForm1.InvokerHotKey(k1, k2, k3, k4, k5: byte;AvtoCast:boolean);
Var
wnd:hwnd;
begin
wnd:=FindWindowEx(MyWindow,0,nil,nil);//ищем дочерние окно
keybd_event(k1, 0, 0, 0); //Нажатие
keybd_event(k1, 0, KEYEVENTF_KEYUP, 0); //Отпускание
sleep(1); //костыль (чтобы игра не зависала можно увеличить интервал)
keybd_event(k2, 0, 0, 0); //Нажатие
keybd_event(k2, 0, KEYEVENTF_KEYUP, 0); //Отпускание
sleep(1);
keybd_event(k3, 0, 0, 0); //Нажатие
keybd_event(k3, 0, KEYEVENTF_KEYUP, 0); //Отпускание
sleep(1);
keybd_event(k4, 0, 0, 0); //Нажатие
keybd_event(k4, 0, KEYEVENTF_KEYUP, 0); //Отпускание
if Avtocast=true then //автокаст работает криво
begin
sleep(9);
keybd_event(k5, 0, 0, 0); //Нажатие
keybd_event(k5, 0, KEYEVENTF_KEYUP, 0); //Отпускание
end;
end;

//послать быстрое сообщение, работает если нет других открытых дочерних окон(меню и тд)
procedure TForm1.QuickMessage1(text:string);
var
wnd:hwnd;
i:integer;
begin
wnd:=FindWindowEx(MyWindow,0,nil,nil);//ищем окно
keybd_event(vk_return, 0, 0, 0); //Нажать ентер
keybd_event(vk_return, 0, KEYEVENTF_KEYUP, 0); //отпустить
sleep(50);//задержка до открытия окна диалога(другой интервал не тестил)
wnd:=GetForegroundWindow; //переставим фокус в активное окно
for i := 1 to Length(text) do
begin
sendmessage(wnd,WM_Char,word(Text[i]),0); //посылаем в окно диалога по одной букве
//sleep(10)//если будет большой текст(или будет зависать) можно рас комментировать
end;
wnd:=FindWindowEx(MyWindow,0,nil,nil);//ищем окно
keybd_event(vk_return, 0, 0, 0); //Нажать ентер
keybd_event(vk_return, 0, KEYEVENTF_KEYUP, 0);
end;

procedure TForm1.Unregister; //убрать все горячие клавиши
var
i:integer;
begin
for i:=1 to KeyCount do
begin
if RegOKArray[i]=true then //если была зарегистрирована клавиша
begin
UnregisterHotKey(Handle, i);//убираем горячую клавишу
RegOKArray[i]:=false;//сброс по умолчанию
end;
end;
//оформляем InvokerHotKey
Label17.Font.Color:=clWindowText;
Label18.Font.Color:=clWindowText;
Label19.Font.Color:=clWindowText;
Label20.Font.Color:=clWindowText;
Label21.Font.Color:=clWindowText;
Label22.Font.Color:=clWindowText;
Label23.Font.Color:=clWindowText;
Label24.Font.Color:=clWindowText;
Label25.Font.Color:=clWindowText;
Label26.Font.Color:=clWindowText;
end;


//проверяем ID события
procedure TForm1.WMHotKey(var Message: TMessage);
begin
case Message.WParam of
1: DoMyHotKey(VK_NUMPAD7);
2: DoMyHotKey(VK_NUMPAD4);
3: DoMyHotKey(VK_NUMPAD1);
4: DoMyHotKey(VK_NUMPAD8);
5: DoMyHotKey(VK_NUMPAD5);
6: DoMyHotKey(VK_NUMPAD2);
7: QuickMessage1(Edit7.text);
8: QuickMessage1(Edit8.text);
9: QuickMessage1(Edit9.text);
10: QuickMessage1(Edit10.text);
11: InvokerHotKey(Q, Q, Q, R, Y, CheckBox1.Checked);
12: InvokerHotKey(Q, Q, W, R, V, CheckBox2.Checked);
13: InvokerHotKey(Q, W, W, R, X, CheckBox3.Checked);
14: InvokerHotKey(Q, Q, E, R, G, CheckBox4.Checked);
15: InvokerHotKey(Q, E, E, R, F, CheckBox5.Checked);
16: InvokerHotKey(W, W, E, R, Z, CheckBox6.Checked);
17: InvokerHotKey(W, E, E, R, D, CheckBox7.Checked);
18: InvokerHotKey(W, W, W, R, C, CheckBox8.Checked);
19: InvokerHotKey(E, E, E, R, T, CheckBox9.Checked);
20: InvokerHotKey(Q, W, E, R, B, CheckBox10.Checked);
else inherited;
end;
end;


//бинд клавиш
procedure TForm1.Button1Click(Sender: TObject);
//вернём исходное состояние лейблов в Hot Key инвенторя(ВДРУГ ЧТО-ТО НЕ БИНДЯТ)
procedure LabelReturn(infolabel:Tlabel);
begin
infolabel.Caption:='не зарегистрированна';
infoLabel.Font.Color:=clWindowText;
end;
//регистрация клавиш инвенторя
function RegisterKey(id:integer;key:byte;InfoLabel:TLabel): boolean;
var
ok:boolean;
begin
OK := RegisterHotKey(Handle, id, MOD_SHIFT, key); //регистрируем клавишу и проверяем результат
if OK=false then //предупреждения и оформление
begin
InfoLabel.Caption:='ERROR';
InfoLabel.Font.Color:=clRed;
showmessage('Ошибка регистрации клавиши '+inttostr(id));
end
else
begin
InfoLabel.Caption:='OK';
InfoLabel.Font.Color:=clLime;
end;
Result:=OK;
end;
//регистрация быстрых сообщений
Function RegisterMessage(id:integer;key:byte):boolean;
var
OK:boolean;
begin
ok:=RegisterHotKey(Handle, id, MOD_ALT, key);
if ok=false then showmessage
('ошибка регистрации быстрого сообщения на ALT +'+inttostr(id));
Result:=ok;
end;

//начало основной процедуры
var
i,C:integer;//пока неиспользуется
begin
unregister();//сброс всех горячих клавиш
//Поиск нужного окна
MyWindow:=FindWindow(MyWindowClass,MyWindowName);
//если не нашли окно
if MyWindow=0 then showmessage('неудалось найти приложение');//можно не использовать
//возвращаем лейблы инвенторя в начальное состояние
LabelReturn(label1);
LabelReturn(label2);
LabelReturn(label3);
LabelReturn(label4);
LabelReturn(label5);
LabelReturn(label6);
//hot key инвенторя
if CheckBox12.Checked then
begin
//незаполненные поля не трогаем, осталное биндим и записываем итоги
if edit1.Text<>'' then
RegOKArray[1]:=RegisterKey(1,byte(Edit1.Text[1]),label1);
if edit2.Text<>'' then
RegOKArray[2]:=RegisterKey(2,byte(Edit2.Text[1]),label2);
if edit3.Text<>'' then
RegOKArray[3]:=RegisterKey(3,byte(Edit3.Text[1]),label3);
if edit4.Text<>'' then
RegOKArray[4]:=RegisterKey(4,byte(Edit4.Text[1]),label4);
if edit5.Text<>'' then
RegOKArray[5]:=RegisterKey(5,byte(Edit5.Text[1]),label5);
if edit6.Text<>'' then
RegOKArray[6]:=RegisterKey(6,byte(Edit6.Text[1]),label6);
end;

if checkbox13.checked then
begin
//регистрация быстрых сообщений (работает с пустыми полями)
RegOKArray[7] :=RegisterMessage(7,byte('7'));
RegOKArray[8] :=RegisterMessage(8,byte('8'));
RegOKArray[9] :=RegisterMessage(9,byte('9'));
RegOKArray[10] :=RegisterMessage(10,byte('0'));
end;

if CheckBox11.Checked then //нужен ли Хот Кей для Invoker
begin
if edit11.Text<>'' then
RegOKArray[11]:=RegisterInvok(byte(Edit11.Text[1]),11,label17);
if edit12.Text<>'' then
RegOKArray[12]:=RegisterInvok(byte(Edit12.Text[1]),12,label18);
if edit13.Text<>'' then
RegOKArray[13]:=RegisterInvok(byte(Edit13.Text[1]),13,label19);
if edit14.Text<>'' then
RegOKArray[14]:=RegisterInvok(byte(Edit14.Text[1]),14,label20);
if edit15.Text<>'' then
RegOKArray[15]:=RegisterInvok(byte(Edit15.Text[1]),15,label21);
if edit16.Text<>'' then
RegOKArray[16]:=RegisterInvok(byte(Edit16.Text[1]),16,label22);
if edit17.Text<>'' then
RegOKArray[17]:=RegisterInvok(byte(Edit17.Text[1]),17,label23);
if edit18.Text<>'' then
RegOKArray[18]:=RegisterInvok(byte(Edit18.Text[1]),18,label24);
if edit19.Text<>'' then
RegOKArray[19]:=RegisterInvok(byte(Edit19.Text[1]),19,label25);
if edit20.Text<>'' then
RegOKArray[20]:=RegisterInvok(byte(Edit20.Text[1]),20,label26);
end;
end;

//работа с инвентарём
procedure TForm1.DoMyHotKey(key:word);
var
wnd:hwnd;
begin
wnd:=FindWindowEx(MyWindow,0,nil,nil);//ищем дочение окно(работает с первым попавшимся дочерним окном)
keybd_event(key, 0, 0, 0); //Нажатие
keybd_event(key, 0, KEYEVENTF_KEYUP, 0); //Отпускание
end;


end.

З.Ы. Комментарии были написаны давно, кое где есть ошибки
З.З.Ы. Стоит ли выкладывать эту программу в ветку форума Warcraft3->Софт?
З.З.З.Ы. так и не понял как спрятать код под спойлер спойлер