Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как в KOL (без MCK) создать глобальную горячую клавишу [Delphi]


Grademax ©   (2006-10-10 12:52:00) 

Как в KOL (без использования MCK) создать глобальную горячую клавишу. Причем без использования hock'a. В общем нужно, чтобы всё это было бы в одном файле (.dpr).

Есть пример на Win API, хотелось бы тоже самое но в KOL.
----------------------------------------------------------
Program main;
uses windows, messages;
const hotkey1 = 1001;//константа для идентификации горячей клавиши
var
  wc : TWndClassex;
  mainwnd : THandle;
  mesg : TMsg;
{==============================================================================}
Function WindowProc(wnd:hwnd; msg : integer; wparam:wparam; lparam:lparam):lresult; stdcall;
//var ncode, ctrlid : word;
begin
    case msg of
         wm_hotkey :begin
                    //обработчик события нажатия на зарегистрированную горячую клавишу
                    if wparam=hotkey1 then messagebox(wnd, 'Вы нажали на win+n', '', mb_ok);
                    end;

         wm_destroy:begin
                    unregisterhotkey(mainwnd, hotkey1);//уничтожение созданной ранее горячей клавиши
                    postquitmessage(0);
                    result:=0;
                    end

                    else result:=defwindowproc(wnd,msg,wparam,lparam);
    end;
end;//of windowproc
{==============================================================================}
BEGIN
    wc.cbsize:=sizeof(wc);
    wc.style:=cs_hredraw or cs_vredraw;
    wc.lpfnwndproc:=@windowproc;
    wc.cbclsextra:=0;
    wc.cbwndextra:=dlgwindowextra;
    wc.hinstance:=hinstance;
    wc.hicon:=loadicon(0,idi_application);
    wc.hcursor:=loadcursor(0,idc_arrow);
    wc.hbrbackground:=color_btnface+1;
    wc.lpszmenuname:=nil;
    wc.lpszclassname:='hotkeycatcher_class';

    RegisterClassex(wc);

    mainwnd:= createwindow('hotkeycatcher_class', 'Пример глобальной горячей клавиши нажмите Win+n',
    ws_overlappedwindow, cw_usedefault, cw_usedefault, cw_usedefault, cw_usedefault,
    0, 0,hinstance,nil);

    //$4e – шестнадцатеричный код клавиши с символом n
    if not registerhotkey(mainwnd,hotkey1,mod_win, $4e) then
    messagebox(mainwnd, 'Не удалось зарегистрировать горячую клавишу', '', mb_ok);

    showwindow(mainwnd,sw_show);

    while getmessage(mesg,0,0,0) do begin
          if mainwnd<>0 then
             if isdialogmessage(mainwnd,mesg) then continue;

          TranslateMessage(mesg);
          DispatchMessage(mesg);
    end;
END.

Моторокер   (2007-03-17 00:50:00) [1]

Всё работает, но клавиши блокируются.
Есть возможность не блокировать их?
Отправка сообщения в активную программу вызывает зацикливание.

Только через хуки?

mdw   (2007-02-12 13:55:00) [2]

Пример прислать?

Barloggg   (2007-02-12 10:16:00) [3]


> > А как среагировать на горячую клавишу не активируя при
> этом
> > приложение?а то получается приходится нажимать дважды.
> ..
>
> Это как????

это я про код в [9].


> > да и еще, а как пользоваться компонентом KolHotKey?и что
> > он вообще делает?
>
> Примерно также и тоже что и HotKey в VCL.


а глобальные он может создавать? неплохо бы пример про него создать или урок.

mdw   (2007-02-09 15:37:00) [4]


> А как среагировать на горячую клавишу не активируя при этом
> приложение?а то получается приходится нажимать дважды...

Это как????


> как назначить код клавиши, скажем F1?

RegisterHotkey(form.Handle, 1000, 0, VK_F1);


> да и еще, а как пользоваться компонентом KolHotKey?и что
> он вообще делает?

Примерно также и тоже что и HotKey в VCL.

Barloggg   (2007-02-09 15:00:00) [5]

да и еще, а как пользоваться компонентом KolHotKey?
и что он вообще делает?

Barloggg   (2007-02-09 14:57:00) [6]

скопировал код из [6]
работает.
как насчет инструкций?

Как я понял код клавиши задается так:
RegisterHotkey(form.Handle,1000,MOD_CONTROL,Ord('H'));
а как назначить код клавиши, скажем F1?

Barloggg   (2007-02-09 14:16:00) [7]

скопировал код из [9]
А как среагировать на горячую клавишу не активируя при этом приложение?
а то получается приходится нажимать дважды...

Grademax   (2006-10-13 10:56:00) [8]

Спасибо, Thaddy. Убедил! Пойду начну менять привычки... :)

Thaddy   (2006-10-13 10:45:00) [9]

That code should not work!

try:

Function DoMessage(Dummy:Pointer;Var Msg: TMsg; Var Reslt: Integer): Boolean;


You forgot that Makemethod can only work on normal procedures that take care of the hidden self-pointer that an object method expects.
(See KOL documentation and this forum (many, many times explained :) )

Grademax   (2006-10-13 05:39:00) [10]

Хотя всё предложенное выше и работает (причем очень успешно), решил собрать всё в один файл (*.dpr), так сказать для чистоты эксперемента. :)

Соответственно опять "наступил на грабли".
Хотя сие творение тоже "работает", но чрезвычайно глюковато, причем на столько, что работой вообще сложно назвать.

Для справки:
БОльшую часть своих программ пишу именно в такой форме, может привычка, может люблю сложности, но так или иначе оно мне больше нравится и греет душу :) (Так сказать близок мне этот литературный стиль, когда всё в одном файле за исключением отдельных контролов и модулей с часто используемыми функциями) :) :)

{---------------------------------------------------------------------------}
Program Proba;
uses Windows, Messages, Kol;
Const
 HOTKEYF_CONTROL = $0002;
var W:PControl;
{---------------------------------------------------------------------------}
function CtrlKeyDown : boolean;
begin
    result:=(Word(GetKeyState(VK_CONTROL)) and $8000)<>0;
end;
{---------------------------------------------------------------------------}
function DoMessage( var Msg: TMsg; var Reslt: Integer ): Boolean;
begin
Result:=False;
{ if (msg.message = WM_SYSCOMMAND) and
      (msg.wparam = SC_HOTKEY) then
              MsgOk('Alternative Hotkey');}
if (getasynckeystate(ord('A'))<>0)and(CtrlKeyDown=True) then MsgOk('123');
end;
{---------------------------------------------------------------------------}
Procedure StartForm;
begin
    W := NewForm( Applet, 'Press Ctrl+A' ).SetSize( 350, 200 );
    W.CenterOnParent;

//??????????????????????????
    W.OnMessage := TOnMessage( MakeMethod( @W, @DoMessage));
    W.Add2AutoFree(nil);
    W.perform(WM_SETHOTKEY,MakeWord(Ord('A'),HOTKEYF_CONTROL),0);
//??????????????????????????

    Run( W );
end;
{---------------------------------------------------------------------------}
begin
    StartForm;
end.
{---------------------------------------------------------------------------}

Thaddy   (2006-10-11 13:15:00) [11]

Alternatively the other hotkey approach.
This code will activate application if not focused or execute the procedure when the application has focus. This is unrelated to registerhotkey method:

{
program Project1;
uses
 Kol,
 unit1 in 'Unit1.pas';

begin
 NewForm1( Form1, nil);
 Run(Form1.form);
end.
}
unit unit1;

interface
uses
 Windows, Messages, Kol;
// Redeclared because missing from Delphi 5
Const
 HOTKEYF_CONTROL = $0002;

type

PForm1=^TForm1;
TForm1=object(Tobj)
 Form:pControl;
public
 function DoMessage(var Msg:Tmsg;var Rslt:integer):boolean;
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );

var
 Form1:pForm1;

implementation

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin
 New(Result,Create);
 with Result^ do
 begin
   Form:= NewForm(AParent,'KOLForm').SetSize(600,400).centeronparent.Tabulate;
   Applet:=Form;
   Form.OnMessage:=DoMessage;
   Form.Add2AutoFree(Result);
   form.perform(WM_SETHOTKEY,MakeWord(Ord('H'),HOTKEYF_CONTROL),0);
 end;
end;

function TForm1.DoMessage(var Msg:TMsg;var Rslt:integer):Boolean;
begin
 Result:=false;
 if (msg.message = WM_SYSCOMMAND) and
       (msg.wparam = SC_HOTKEY) then
               MsgOk('Alternative Hotkey');
end;

end.

Grademax   (2006-10-11 13:02:00) [12]

УРА! Поверить не могу! Заработало!!! :)
Спасибо ВСЕМ! Спасли!

Thaddy   (2006-10-11 12:45:00) [13]

code works, but small correction:

 WM_HOTKEY:
 if msg.wParam = 1000 then  //!!

Thaddy   (2006-10-11 12:39:00) [14]

This code works.
GlobalAddAtom is only necessary when you have this code in a DLL.

{
program Project1;
uses
 Kol,
 unit1 in 'Unit1.pas';

begin
 NewForm1( Form1, nil);
 Run(Form1.form);
end.
}
unit unit1;

interface
uses
 Windows, Messages, Kol;

type

PForm1=^TForm1;
TForm1=object(Tobj)
 Form:pControl;
public
 function DoMessage(var Msg:Tmsg;var Rslt:integer):boolean;
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );

var
 Form1:pForm1;

implementation

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin
 New(Result,Create);
 with Result^ do
 begin
   Form:= NewForm(AParent,'KOLForm').SetSize(600,400).centeronparent.Tabulate;
   Applet:=Form;
   Form.OnMessage:=DoMessage;
   Form.Add2AutoFree(Result);
   RegisterHotkey(form.Handle,1000,MOD_CONTROL,Ord('H'));
 end;
end;

function TForm1.DoMessage(var Msg:TMsg;var Rslt:integer):Boolean;
begin
 Result:=false;
 case msg.message of
 WM_HOTKEY:
   begin
     Result := true;
     msgOk('Ctrl-H!');
   end;
 WM_DESTROY:
   UnRegisterHotKey(form.Handle,1000);
 end;
end;

end.

mdw   (2006-10-11 12:07:00) [15]

Послал на мыло

Grademax   (2006-10-11 10:43:00) [16]

Всё исправил... НЕ РАБОТАЕТ!!! Перепроверил... Работать должна, но ... НЕ РАБОТАЕТ!!! вроде бы и ошибок нет и EXE файл создается, но не ловится Ctrl+H.

Люди, может кто выложит рабочий файл на чистом KOL???

MTsv DN   (2006-10-11 08:59:00) [17]

> Как в KOL (без использования MCK)
Здесь Вы пишите одно...

> [2]
А здесь другое... Вы определитесь...

> Горячая клавиша по прежнему не работает... Что не так???
Что Ctrl+H не работает??? У меня ВСЕ ПАШЕТ!!!
Единственное:
procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
  HK:= GlobalAddAtom('MyHotKey');
  RegisterHotKey(Applet.Handle, HK, MOD_CONTROL, Ord('H'));
end;

procedure TForm1.KOLForm1Close(Sender: PObj; var Accept: Boolean);
begin
  UnregisterHotKey(Applet.Handle, HK);
  GlobalDeleteAtom(HK);;
end;

function TForm1. KOLForm1Message(var Msg: tagMSG;
 var Rslt: Integer): Boolean;
begin
  Result:= False;
  if Msg.message = WM_HOTKEY then begin
    if (Msg.wParam = HK) then begin
      ShowMessage('HotKey');
      Result:= True;
    end;
  end;
end;
Не Applet, а Form...

Grademax   (2006-10-11 08:28:00) [18]

Горячая клавиша по прежнему не работает... Что не так???

unit Unit1;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, KOL {$IFNDEF KOL_MCK}, mirror, Classes, Controls, mckControls, mckObjs, Graphics {$ENDIF (place your units here->)};
{$ELSE}
{$I uses.inc}
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;
{$ENDIF}

type
 {$IFDEF KOL_MCK}
 {$I MCKfakeClasses.inc}
 {$IFDEF KOLCLASSES} TForm1 = class; PForm1 = TForm1; {$ELSE OBJECTS} PForm1 = ^TForm1; {$ENDIF CLASSES/OBJECTS}
 {$IFDEF KOLCLASSES}{$I TForm1.inc}{$ELSE} TForm1 = object(TObj) {$ENDIF}
   Form: PControl;
 {$ELSE not_KOL_MCK}
 TForm1 = class(TForm)
 {$ENDIF KOL_MCK}
   KOLProject1: TKOLProject;
   KOLForm1: TKOLForm;
   procedure KOLForm1Close(Sender: PObj; var Accept: Boolean);
   procedure KOLForm1FormCreate(Sender: PObj);
   function  KOLApplet1Message(var Msg: tagMSG; var Rslt: Integer): Boolean;

 private
   { Private declarations }
   HK: ATOM;
 public
   { Public declarations }
 end;

var
 Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;

{$IFDEF KOL_MCK}
procedure NewForm1( var Result: PForm1; AParent: PControl );
{$ENDIF}

implementation

{$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}

{$IFDEF KOL_MCK}
{$I Unit1_1.inc}
{$ENDIF}

procedure TForm1.KOLForm1Close(Sender: PObj; var Accept: Boolean);
begin
  UnregisterHotKey(Applet.Handle, HK);
  GlobalDeleteAtom(HK);;
end;

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
    HK:= GlobalAddAtom('MyHotKey');
    RegisterHotKey(Applet.Handle, HK, MOD_CONTROL, Ord('H'));
end;

function TForm1.KOLApplet1Message(var Msg: tagMSG;
var Rslt: Integer): Boolean;
begin
  Result:= False;
  if Msg.message = WM_HOTKEY then begin
    if (Msg.wParam = HK) then begin
      ShowMessage('HotKey');
      Result:= True;
    end;
  end;
end;

end.

mdw   (2006-10-10 14:03:00) [19]

...
 private
   HK: ATOM;
....

procedure TMainForm.KOLForm1FormCreate(Sender: PObj);
begin
   HK:= GlobalAddAtom('MyHotKey');
   RegisterHotKey(Applet.Handle, HK, MOD_CONTROL, Ord('H'));
end;

procedure TMainForm.KOLForm1Close(Sender: PObj; var Accept: Boolean);
begin
   UnregisterHotKey(Applet.Handle, HK);
   GlobalDeleteAtom(HK);;
end;

function TMainForm.KOLApplet1Message(var Msg: tagMSG;
 var Rslt: Integer): Boolean;
begin
   Result:= False;
   if Msg.message = WM_HOTKEY then begin
     if (Msg.wParam = HK) then begin
       ShowMessage('HotKey');
       Result:= True;
     end;
   end;
end;

Наверх

Титульная страница Поиск, карта сайта Написать письмо