Регистрация Главная Сообщество
Сообщения за день Справка Регистрация

Hot Key для Warcraft3

-

Вопросы и ответы, обсуждения

- Ваши вопросы по Pascal/Delphi только в данном разделе

Ответ
 
Опции темы
Старый 07.02.2014, 20:43   #1
 Разведчик
Аватар для Aleksandr550
 
Aleksandr550 никому не известный тип
Регистрация: 11.01.2014
Сообщений: 1
Популярность: 10
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
 
По умолчанию Hot Key для Warcraft3

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

сам код:
Код:
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->Софт?
З.З.З.Ы. так и не понял как спрятать код под спойлер спойлер
  Ответить с цитированием
Ответ


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

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

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

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[Продам] Аккаунт Battle.net Diablo, wow, starcraft, warcraft3, hs sy0nd Другие игры 2 11.02.2014 11:56
[Русификатор для мода][WARCRAFT3] ~Winston~ Античиты и дополнения 2 29.01.2011 14:13
[Файл] Оформление Warcraft3 kolla0 Warcraft 3 3 23.08.2010 12:53

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

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

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