{$mode ObjFpc}
uses windows;
Const MainWndClass='MainWindowClass';
HotKeyId=$2;
HotKeyControlId=$5;
ButtonControlId=$6;
Wm_ChangeHotKeys=Wm_User+2;
var MainWnd,HotKeysWnd,ButtonWnd:hWnd;
HotKeysFlags,HotKeysLetter:word;
buf:word;
function MainProc(Wnd:hWnd; Msg:cardinal; wparam,lparam:longint):longint; stdcall;
begin
result:=0;
case Msg of
Wm_Create:begin//создаем кнопку и HotKey контрол
HotKeysWnd:=CreateWindowEx(0,HotKey_Class,'Hot Keys',
Ws_Child or Ws_Visible,
2,5,
150,
20,
Wnd,
HotKeyControlId,
system.mainInstance,
nil);
ButtonWnd:=CreateWindowEx(0,'Button','Change',
Ws_Child or Ws_Visible,
2,35,
70,
20,
Wnd,
ButtonControlId,
system.mainInstance,
nil);
//почему-то перестало работать.
SendMessage(HotKeysWnd,HKM_SetHotKey,MakeWParam(HotKeysLetter,HotKeysFlags),0);
end;
Wm_Destroy:begin
PostQuitMessage(0);
end;
Wm_HotKey:case wParam of//если нас вызывает через горячие клавиши, то...
HotKeyId: MessageBox(0,PChar('Main function'),PChar('Hot Keys!!!'),Mb_Ok);
end;
Wm_Command: case LoWord(wParam) of
ButtonControlId:case HiWord(wParam) of//нажали на кнопку - сообщаем
Bn_Clicked:begin
buf:=SendMessage(HotKeysWnd,HKM_GetHotKey,0,0);
if buf=0 then writeln('Error');
writeln('Flags: ',HiWord(buf));//почему 0?
writeln('Letter: ',LoWord(buf),' = ',chr(LoWord(buf)));
SendMessage(Wnd,Wm_ChangeHotKeys,buf,0);
end;
end;
end;
Wm_ChangeHotKeys:begin//меняем Hot Keys...
writeln('Flags Received: ',HiWord(wParam));//почему 0?
writeln('Letter Received: ',LoWord(wParam),' = ',chr(LoWord(wParam)));
if not(UnregisterHotKey(wnd,HotKeyId)) then
writeln('Hot key unregistering error');
HotKeysFlags:=HiWord(wParam);
HotKeysLetter:=LoWord(wParam);
if not(RegisterHotKey(Wnd,HotKeyId,HotKeysFlags,HotKeysLetter)) then
writeln('Cannot register new keys combination');
MessageBox(0,PChar('Receive'),PChar('Message was received'),Mb_Ok);
end;
else result:=DefWindowProc(Wnd,Msg,wparam,lparam);
end;
end;
function RegisterMainWndClass(ClassName:PChar):boolean;
var WndClass:PWndClassEx;
begin
WndClass:=new(PWndClassEx);
with WndClass^ do
begin
cbSize:=sizeof(WndClassEx);
style := CS_DBLCLKS or CS_HREDRAW or
CS_OWNDC or CS_VREDRAW or Cs_ParentDc;
LpfnWndProc:=@MainProc;
cbClsExtra:=0;
cbWndExtra:=0;
hInstance:=System.HInstance;
hIcon:=LoadIcon(0,Idi_Asterisk);
hCursor:=LoadCursor(0,Idc_Arrow);
hbrBackground:=Color_BtnFace+1;
lpszMenuName:=nil;
lpszClassName:=ClassName;
hIconSm:=0;
end;
result:=RegisterClassEx(WndClass)<>0;
end;
function CreateMainWnd(ClassName:PChar):hWnd;
begin
result:=CreateWindowEx(WS_EX_APPWINDOW,
ClassName,
'',
Ws_Border or Ws_Caption or Ws_ClipCHildren or
Ws_OverlappedWindow or Ws_SizeBox or
Ws_Visible,
CW_USEDEFAULT, CW_USEDEFAULT,
200, 130,
0,
0,
HInstance,
nil
);
HotKeysFlags:=Mod_Control;
HotKeysLetter:=ord('L');
writeln('Init Flags: ',HotKeysFLags);
writeln('Init Letter: ',HotKeysLetter);
writeln;
RegisterHotKey(result,HotKeyId,HotKeysFlags,HotKeysLetter);
end;
var Msg:TMsg;
begin
RegisterMainWndClass(MainWndClass);
MainWnd:=CreateMainWnd(MainWndClass);
UpdateWindow(MainWnd);
ShowWindow(MainWnd,Sw_ShowNa);
while GetMessage(Msg,0,0,0) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
var buf: WORD;
buf:=SendMessage(HotKeysWnd,HKM_GetHotKey,0,0);
var buf: DWORD; // <--- или var buf: LRESULT
buf:=SendMessage(HotKeysWnd,HKM_GetHotKey,0,0);
var MainWnd,HotKeysWnd,ButtonWnd:hWnd;
HotKeysFlags,HotKeysLetter:word;
buf:word; // <--- Все верно, нас интересует только одно слово
function MainProc(Wnd:hWnd; Msg:UINT; wparam:WPARAM;lparam:LPARAM):INT_PTR; stdcall;
begin
result:=0;
case Msg of
Wm_Create:
begin
HotKeysWnd:=CreateWindowEx(
0, HotKey_Class,'Hot Keys',
Ws_Child or Ws_Visible,
2,5,
150,
20,
Wnd,
HotKeyControlId,
system.mainInstance,
nil
);
ButtonWnd:=CreateWindowEx(
0,'Button','Change',
Ws_Child or Ws_Visible,
2,35,
70,
20,
Wnd,
ButtonControlId,
system.mainInstance,
nil
);
SendMessage(HotKeysWnd, HKM_SetHotKey,
MakeWParam(HotKeysLetter,HotKeysFlags), 0);
end;
Wm_Destroy:
begin
PostQuitMessage(0);
end;
Wm_HotKey:
case wParam of
HotKeyId:
MessageBox(0,PChar('Main function'),PChar('Hot Keys!!!'),Mb_Ok);
end;
Wm_Command:
case LoWord(wParam) of
ButtonControlId:
case HiWord(wParam) of
Bn_Clicked:
begin
buf:=SendMessage(HotKeysWnd,HKM_GetHotKey,0,0);
if buf=0 then writeln('Error');
writeln('Flags: ',Hi(buf)); // MSDN: the modifier flags are in the high-order __byte__
writeln('Letter: ',Lo(buf),' = ',chr(Lo(buf))); // ... The virtual key code is in the low-order __byte__
SendMessage(Wnd,Wm_ChangeHotKeys,buf,0);
end;
end;
end;
Wm_ChangeHotKeys:
begin
writeln('Flags Received: ',Hi(loword(wParam)));
writeln('Letter Received: ',Lo(loWord(wParam)),' = ',chr(Lo(loWord(wParam))));
if not(UnregisterHotKey(wnd,HotKeyId))
then writeln('Hot key unregistering error');
HotKeysFlags:=HiWord(wParam);
HotKeysLetter:=LoWord(wParam);
if not(RegisterHotKey(Wnd,HotKeyId,HotKeysFlags,HotKeysLetter))
then writeln('Cannot register new keys combination');
MessageBox(0,PChar('Receive'),PChar('Message was received'),Mb_Ok);
end;
else
result:=DefWindowProc(Wnd,Msg,wparam,lparam);
end;
end;
MOD_ALT = 1;, а посмотри, что у тебя передается, когда ты жмешь Alt+ ... ? У Control+ ... код совпадает, поэтому работает только Control. Почему - пока не понял.
MOD_CONTROL = 2;
MOD_SHIFT = 4;
MOD_WIN = 8;
{ HKM_GETHOTKEY message }
HOTKEYF_ALT = 4;
HOTKEYF_CONTROL = 2;
HOTKEYF_EXT = 8;
HOTKEYF_SHIFT = 1;
VarДолжно работать...
modif: Word;
...
WM_COMMAND:
case LoWord(wParam) of
ButtonControlId:
case HiWord(wParam) of
BN_CLICKED:
begin
buf := SendMessage(HotKeysWnd, HKM_GETHOTKEY, 0, 0);
if buf = 0 then writeln('Error');
modif := $0000;
if (hi(buf) and HOTKEYF_ALT) = HOTKEYF_ALT then modif := modif or MOD_ALT;
if (hi(buf) and HOTKEYF_CONTROL) = HOTKEYF_CONTROL then modif := modif or MOD_CONTROL;
if (hi(buf) and HOTKEYF_SHIFT) = HOTKEYF_SHIFT then modif := modif or MOD_SHIFT;
if (hi(buf) and HOTKEYF_EXT) = HOTKEYF_EXT then modif := modif or MOD_WIN;
writeln('Flags: ', modif);
writeln('Letter: ',Lo(buf),' = ',chr(Lo(buf)));
buf := (modif shl 8) or (buf and $00FF);
SendMessage(Wnd, WM_CHANGEHOTKEYS,
MakeWParam(buf, 0), 0);
end;
end;
end;
...
{ HKM_GETHOTKEY message }
HOTKEYF_ALT = 4;
HOTKEYF_CONTROL = 2;
HOTKEYF_EXT = 8;
HOTKEYF_SHIFT = 1;
if (hi(buf) and HOTKEYF_ALT) = HOTKEYF_ALT then modif := modif or MOD_ALT;
if (hi(buf) and HOTKEYF_CONTROL) = HOTKEYF_CONTROL then modif := modif or MOD_CONTROL;
if (hi(buf) and HOTKEYF_SHIFT) = HOTKEYF_SHIFT then modif := modif or MOD_SHIFT;
if (hi(buf) and HOTKEYF_EXT) = HOTKEYF_EXT then modif := modif or MOD_WIN;
if (hi(buf) and HOTKEYF_ALT) = HOTKEYF_ALT then modif := modif or MOD_ALT;
modif or MOD_ALT
buf := (modif shl 8) or (buf and $00FF);
HotKeysFlags:=Mod_Control; // <--- MOD_...
HotKeysLetter:=ord('L');
Var
modif: Word;
...
buf := (Word(modif) shl 8) or (buf and $00FF); // <--- !!!
...
var modif: byte;будет правильно...
buf := (modif shl 8) or (buf and $00FF); // без приведения к Word