Реализация хоткей в wince

[kurdt666]

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,windows,
  StdCtrls;
  const
  MyHotKey = ord(' ');


type
  TWMHotKey = packed record
    Msg: Cardinal;
    HotKey: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
   
        procedure wmhotkey(var msg:twmhotkey); message wm_hotkey;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TForm1 }

procedure tform1.wmhotkey(var msg:twmhotkey);
begin
showmessage('hotkepressed!!!!');
end;




procedure TForm1.FormCreate(Sender: TObject);
begin
//if windows.OpenClipboard(form1.Handle) then showmessage('yo');
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:UINT;
begin
RegisterHotKey(Form1.Handle, MyHotKey, 0, MyHotKey);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
UnRegisterHotKey(Form1.Handle, MyHotKey);

end;

initialization
  {$I unit1.lrs}

end.   

Этот код в виндовсе регистрирует о не вызывается событие в винсе вообще ничего не работает... потскажите альтернативу или может я чегото не так делаю...

[Bohdan]

Во первых так не правильно и в винде:

RegisterHotKey(Form1.Handle, MyHotKey, 0, MyHotKey);

Попробуй например так:
keyid:=GlobalAddAtom('My Hotkey'); //создаем атом
RegisterHotKey(handle,// сообщение о HotKey будет получать форма
keyid, // регистрируем атом как id
MOD_ALT,// модификатор у нас - клавиша Alt
VK_F10 // вирт. клавиша - F10
);

В конце:
UnregisterHotKey(handle, keyid);
GlobalDeleteAtom(keyid);

[kurdt666]

Пробовал по разному....

Код: Выделить всё

const ch= ord('7');
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure wmhotkey(var msg:twmhotkey); message wm_hotkey;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.DFM}

procedure tform1.wmhotkey(var msg:twmhotkey);
var f:file of char;
    c:char;
begin
showmessage('yo');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if not registerhotkey(handle,1,0,ch)
                                       then showmessage('NOW!! od_alt or mod_shift,vk_f9');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
unregisterhotkey(handle,1);
end;


вот делфи код работает на ура в лазаре регистрируется но вот тут проблема

Код: Выделить всё

procedure wmhotkey(var msg:twmhotkey); message wm_hotkey;

Может надо както обьявлять... если это ошибка лазаря то это одна ис самых больших ошибок так нормально с апи не можно будет работать...

пробовал и так

Код: Выделить всё

         procedure wmhotkey(var msg:twmhotkey); message $0312;

это номер из дельфы вытянул {$EXTERNALSYM WM_HOTKEY}
WM_HOTKEY = $0312;

[Bupyc]

Код: Выделить всё

procedure wmhotkey(var msg:twmhotkey); message wm_hotkey;

Я тоже натыкался на такие же грабли. Но в моём случае это был не критичный баг, т.к. значительная часть кода была невизуальной и его можно было обойти. В принципе, можно попробовать запостить багрепорт. Правда надежды особо никакой. Постил я багрепорты, да так они там и висят уже 3-й месяц.

[Attid]

этот можно как критический да еще и в фпц группу, должен быстро пройти.

Bupyc
как именно висят ? как новые или назначены на версии 1,*
если первое то не порядок у меня больше недели не болтаются если я правельно отписываю, если нет то даже бывало по мылу связывались для разьяснения, но уже через некоторое время.

[Bohdan]

Лазурус тут не при чем...

По моему, тут дело в том что ты хочешь, как я понимаю, перехватить нажатия на экранной клавиатуре (если не так то сообщи).

Как я понимаю, экранная клава не имитирует нажатие кнопок, она посылает WM_Char активному контролу.

[Bupyc]

как именно висят ?

Ну из того, что я запостил, например 10184, назначен на версию 1.2. Или то, что я мониторю - 0010217. Тут вообще только статус acknowledged присвоен.

[Alexx2000]

Может быть дело в том что Лазарус не все сообщения передает окну,
например сообщение WM_INITMENUPOPUP не передается. Пришлось переопределять оконную процедуру. Вполне возможно что и wm_hotkey не передается.

[Attid]

Или то, что я мониторю - 0010217.

ну да с wince туго согласен =(
тут проще в сторону KOL смотреть.

[kurdt666]

ну да с wince туго согласен =(

тут проще в сторону KOL смотреть.

попробую с кол

[Bohdan]

Ни КОЛ ни Лазарус тут не причем, смотри мой пост выше.
Вот вам пример на винапи:

Код: Выделить всё

uses
  Windows,Messages;
procedure HotKey;
begin
MessageBox(0,'Hi!','Hi',mb_ok);
end;

var  message:MSG;
      idHotKey: integer;
begin                     
keyid:=GlobalAddAtom('My Hotkey');
  RegisterHotKey( 0,keyid, 0, VK_SPACE);

  while GetMessage(message,0,0,0) do begin
   if message.message=WM_HOTKEY then begin
    HotKey;
    break;
   end;
    TranslateMessage(message);
    DispatchMessage(message);
  end;
  UnRegisterHotKey( 0,keyid);

end.


[Attid]

Bohdan
ну вот может

Код: Выделить всё

uses
  Windows,Messages;

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

[kurdt666]

Код: Выделить всё

keyid:=GlobalAddAtom('My Hotkey');
  if not RegisterHotKey( 0,keyid, 0, VK_UP) then  MessageBox(0,'Hi!','Hi',mb_ok);   

Bohdan
Этот код в виндовсе работает но в винсе дает значение фалсе

[Юра]

Как насчет просто почитать доку по RegisterHotKey для WinCE: http://msdn2.microsoft.com/en-us/library/ms911003.aspx ?

hWnd - [in] Handle to the window that will receive WM_HOTKEY messages generated by the hot key. The value of this parameter should not be NULL.

[kurdt666]

Сори Юра просто я скопировал код Bohdanа и не посмотрел что там хендл не указан..

указал хендл работает...

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
var  message:MSG;
      idHotKey,keyid: integer;
begin
keyid:=GlobalAddAtom('My Hotkey');
  if not RegisterHotKey( form1.Handle,keyid, 0, VK_UP) then  MessageBox(0,'Hi!','ÍÅ ìîãó çàðåãèñòðèðîâàòü',mb_ok);

  while GetMessage(message,0,0,0) do begin
   if message.message=WM_HOTKEY then begin
    HotKey;
    sleep(10);
    break;
   end;
    TranslateMessage(message);
    DispatchMessage(message);
  end;
  UnRegisterHotKey( form1.Handle,keyid);
end; 

а еще вопросик, а можно както єто записать в человеческом виде?
ну тоесть как в дельфе
тоесть наподобии єтого

Код: Выделить всё

...
private
  procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
...
const
  MyHotKey = ord('1');

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  MessageBeep(0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterHotKey(Form1.Handle, MyHotKey, 0, MyHotKey);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Form1.Handle, MyHotKey);
end;