From cb4a46e7fbe62d788e66ed6121c717a2d22a4d7c Mon Sep 17 00:00:00 2001
From: watcherhd <watcherhd@e753b5eb-9565-29b2-b5c5-2cc6f99dfbcb>
Date: Thu, 21 Apr 2011 14:14:52 +0000
Subject: svn.miranda.im is moving to a new home!

git-svn-id: http://miranda-plugins.googlecode.com/svn/trunk@7 e753b5eb-9565-29b2-b5c5-2cc6f99dfbcb
---
 delphi/Awkward/utils/hotkeys.pas | 571 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 571 insertions(+)
 create mode 100644 delphi/Awkward/utils/hotkeys.pas

(limited to 'delphi/Awkward/utils/hotkeys.pas')

diff --git a/delphi/Awkward/utils/hotkeys.pas b/delphi/Awkward/utils/hotkeys.pas
new file mode 100644
index 0000000..738bd55
--- /dev/null
+++ b/delphi/Awkward/utils/hotkeys.pas
@@ -0,0 +1,571 @@
+{Hotkey and timer related functions}
+unit hotkeys;
+
+interface
+
+uses windows;
+
+type
+  AWKHotKeyProc = function(hotkey:integer):integer;
+
+function AddProc(aproc:AWKHotKeyProc;ahotkey:integer;global:bool=false):integer; overload;
+function AddProc(ahotkey:integer;wnd:HWND;aproc:AWKHotKeyProc         ):integer; overload;
+function AddProc(ahotkey:integer;wnd:HWND;msg:DWORD                   ):integer; overload;
+function DelProc(hotkey:integer         ):integer;  overload;
+function DelProc(hotkey:integer;wnd:HWND):integer; overload;
+
+procedure InitHotKeys;
+procedure FreeHotKeys;
+
+implementation
+
+uses messages;
+
+var
+  CurThread:THANDLE;
+
+type
+  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
+  TKBDLLHOOKSTRUCT = record
+    vkCode     :dword;
+    scanCode   :dword;
+    flags      :dword;
+    time       :dword;
+    dwExtraInfo:dword;
+  end;
+
+const
+  WH_KEYBOARD_LL = 13;
+  WM_MYMESSAGE = WM_USER +13;
+
+// const from commctrl module;
+const
+  HOTKEYF_SHIFT   = $01;
+  HOTKEYF_CONTROL = $02;
+  HOTKEYF_ALT     = $04;
+  HOTKEYF_EXT     = $08;
+
+const
+  hkAssigned = 1;
+  hkGlobal   = 2;
+  hkMessage  = 4;
+const
+  kbHook:THANDLE=0;
+  hiddenwindow:HWND=0;
+  modifiers:dword=0;
+const
+  PageStep = 10;
+type
+  PHKRec = ^THKRec;
+  THKRec = record
+    proc  :AWKHotKeyProc; // procedure
+    flags :integer;       // options
+    handle:THANDLE;       // thread or window?
+    atom  :TATOM;         // hotkey id
+    hotkey:integer;       // hotkey
+  end;
+  PHKRecs = ^THKRecs;
+  THKRecs = array [0..15] of THKRec;
+
+const
+  NumRecs:integer=0;
+  MaxRecs:integer=10;
+  hkRecs:pHKRecs=nil;
+
+//----- simpler version of 'common' function -----
+
+const
+  HexDigitChr: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7',
+                                        '8','9','A','B','C','D','E','F');
+
+function IntToHex(dst:PAnsiChar;Value:cardinal):PAnsiChar;
+var
+  Digits:integer;
+begin
+  dst[8]:=#0;
+  Digits:=8;
+  repeat
+    Dec(Digits);
+    dst[Digits]:=HexDigitChr[Value and $F];
+    Value:=Value shr 4;
+  until Digits=0;
+  result:=dst;
+end;
+
+//----- utils -----
+
+function GetAtom(hotkey:dword):dword;
+const
+  HKPrefix = 'awk_';
+var
+  p:array [0..15] of AnsiChar;
+begin
+  lstrcpya(p,HKPrefix);
+  IntToHex(p+Length(HKPrefix),hotkey);
+  result:=GlobalAddAtomA(p);
+end;
+
+function HotKeyDlgToHook(w:cardinal):cardinal; register;
+asm
+  movzx ecx,al
+  xor   al,al
+  test  ah,HOTKEYF_ALT
+  je    @L1
+  or    al,MOD_ALT
+@L1:
+  test ah,HOTKEYF_CONTROL
+  je   @L2
+  or   al,MOD_CONTROL
+@L2:
+  test ah,HOTKEYF_SHIFT
+  je   @L3
+  or   al,MOD_SHIFT
+@L3:
+  test ah,HOTKEYF_EXT
+  je   @L4
+  or   al,MOD_WIN
+@L4:
+  mov ch,al
+  mov eax,ecx
+{
+begin
+  result:=w and $FF;
+  if (w and (HOTKEYF_ALT     shl 8))<>0 then result:=result or (MOD_ALT     shl 8);
+  if (w and (HOTKEYF_CONTROL shl 8))<>0 then result:=result or (MOD_CONTROL shl 8);
+  if (w and (HOTKEYF_SHIFT   shl 8))<>0 then result:=result or (MOD_SHIFT   shl 8);
+  if (w and (HOTKEYF_EXT     shl 8))<>0 then result:=result or (MOD_WIN     shl 8);
+}
+end;
+
+function HotKeyHookToDlg(w:cardinal):cardinal; register;
+asm
+  movzx ecx,al
+  xor   al,al
+  test  ah,MOD_ALT
+  je    @L1
+  or    al,HOTKEYF_ALT
+@L1:
+  test ah,MOD_CONTROL
+  je   @L2
+  or   al,HOTKEYF_CONTROL
+@L2:
+  test ah,MOD_SHIFT
+  je   @L3
+  or   al,HOTKEYF_SHIFT
+@L3:
+  test ah,MOD_WIN
+  je   @L4
+  or   al,HOTKEYF_EXT
+@L4:
+  mov  ch,al
+  mov  eax,ecx
+{
+begin
+  result:=w and $FF;
+  if (w and (MOD_ALT     shl 8))<>0 then result:=result or (HOTKEYF_ALT     shl 8);
+  if (w and (MOD_CONTROL shl 8))<>0 then result:=result or (HOTKEYF_CONTROL shl 8);
+  if (w and (MOD_SHIFT   shl 8))<>0 then result:=result or (HOTKEYF_SHIFT   shl 8);
+  if (w and (MOD_WIN     shl 8))<>0 then result:=result or (HOTKEYF_EXT     shl 8);
+}
+end;
+
+//----- Hook -----
+
+function FindHotkey(keycode:integer;local:boolean):pointer;
+var
+  i:integer;
+  p:pHKRec;
+begin
+  i:=NumRecs;
+  p:=pointer(HKRecs);
+  while i>0 do
+  begin
+    dec(i);
+    with p^ do
+    begin
+      if (flags and hkAssigned)<>0 then
+      begin
+        if (local xor ((flags and hkGlobal)<>0)) then
+        begin
+          if hotkey=keycode then
+          begin
+            if handle<>0 then
+            begin
+              if GetFocus=handle then
+              begin
+                if (flags and hkMessage)<>0 then
+                begin
+                  PostMessage(handle,dword(@proc),keycode,0);
+                  result:=pointer(-1);
+                end
+                else
+                  result:=@proc;
+                exit;
+              end;
+            end
+            else
+            begin
+              result:=@proc;
+              exit;
+            end;
+          end;
+        end;
+      end;
+    end;
+    inc(p);
+  end;
+  result:=nil;
+end;
+
+function wmKeyboard_hook(code:integer;wParam:integer;lParam:longint):longint; stdcall;
+var
+  key:dword;
+  proc:pointer;
+begin
+  if (code=HC_ACTION) and
+     (lParam>0) and (LoWord(lParam)=1) then
+  begin
+    key:=0;
+    if (GetKeyState(VK_SHIFT  ) and $8000)<>0 then key:=key or (MOD_SHIFT   shl 8);
+    if (GetKeyState(VK_CONTROL) and $8000)<>0 then key:=key or (MOD_CONTROL shl 8);
+    if (GetKeyState(VK_MENU   ) and $8000)<>0 then key:=key or (MOD_ALT     shl 8);
+    if (GetKeyState(VK_LWIN   ) and $8000)<>0 then key:=key or (MOD_WIN     shl 8);
+    if (GetKeyState(VK_RWIN   ) and $8000)<>0 then key:=key or (MOD_WIN     shl 8);
+//    if (GetKeyState(VK_APPS) and $8000)<>0 then
+//    if (GetKeyState(VK_SLEEP) and $8000)<>0 then
+    key:=key or lo(wParam);
+    proc:=FindHotkey(key,true);
+    if proc<>nil then
+    begin
+      if integer(proc)<>-1 then
+        PostMessageA(hiddenwindow,WM_MYMESSAGE,key,dword(proc));
+      result:=1;
+      exit;
+    end;
+  end;
+  result:=CallNextHookEx(KbHook,code,wParam,lParam);
+end;
+
+function wmKeyboardLL_hook(code:integer;wParam:integer;lParam:integer):integer; stdcall;
+const
+  lastkey:dword=0;
+var
+  mask:dword;
+  key:dword;
+  proc:pointer;
+begin
+  if code=HC_ACTION then
+  begin
+    case PKBDLLHOOKSTRUCT(lParam)^.vkCode of
+      VK_MENU,
+      VK_LMENU,
+      VK_RMENU:    mask:=MOD_ALT     shl 8;
+      VK_LWIN,
+      VK_RWIN:     mask:=MOD_WIN     shl 8;
+      VK_SHIFT,
+      VK_LSHIFT,
+      VK_RSHIFT:   mask:=MOD_SHIFT   shl 8;
+      VK_CONTROL,
+      VK_LCONTROL,
+      VK_RCONTROL: mask:=MOD_CONTROL shl 8;
+    else
+      if (PKBDLLHOOKSTRUCT(lParam)^.flags and 128)=0 then
+      begin
+        // local only
+// maybe process will better choice?
+        if //(lastkey=0) and
+           (CurThread=GetWindowThreadProcessId(GetForegroundWindow,nil)) then
+        begin
+          key:=PKBDLLHOOKSTRUCT(lParam)^.vkCode or modifiers;
+          proc:=FindHotkey(key,true);
+          if proc<>nil then
+          begin
+            lastkey:=PKBDLLHOOKSTRUCT(lParam)^.vkCode;
+            if integer(proc)<>-1 then
+              PostMessageA(hiddenwindow,WM_MYMESSAGE,key,dword(proc));
+            result:=1;
+            exit;
+          end;
+        end;
+      end
+      else if (lastkey<>0) and (lastkey=PKBDLLHOOKSTRUCT(lParam)^.vkCode) then
+      begin
+        lastkey:=0;
+        result :=1;
+        exit;
+      end;
+      mask:=0;
+    end;
+    if mask<>0 then
+    begin
+      if (PKBDLLHOOKSTRUCT(lParam)^.flags and 128)=0 then
+        modifiers:=modifiers or mask
+      else
+        modifiers:=modifiers and not mask;
+    end
+  end;
+  result:=CallNextHookEx(KbHook,code,wParam,lParam);
+end;
+
+function HiddenWindProc(wnd:HWnd; msg,wParam,lParam:integer):integer; stdcall;
+var
+  key:dword;
+begin
+  if Msg=WM_HOTKEY then
+  begin
+    key:=(lParam shr 16)+(Lo(lParam) shl 8);
+    result:=dword(FindHotKey(key,false));
+    if result<>0 then
+    begin
+      result:=AWKHotKeyProc(result)(HotkeyHookToDlg(key));
+      exit;
+    end;
+  end
+  else if Msg=WM_MYMESSAGE then
+  begin
+    result:=AWKHotKeyProc(lParam)(HotkeyHookToDlg(wParam));
+    exit;
+  end;
+  result:=DefWindowProcA(wnd,msg,wparam,lparam);
+end;
+
+procedure DestroyHiddenWindow;
+begin
+  if hiddenwindow<>0 then
+  begin
+    DestroyWindow(hiddenwindow);
+    hiddenwindow:=0;
+  end;
+end;
+
+procedure CreateHiddenWindow;
+var
+  wnd:HWND;
+begin
+  if hiddenwindow=0 then
+  begin
+    wnd:=CreateWindowExA(0,'STATIC',nil,0,
+       1,1,1,1,dword(HWND_MESSAGE),0,hInstance,nil);
+    if wnd<>0 then
+    begin
+      SetWindowLongA(wnd,GWL_WNDPROC,dword(@HiddenWindProc));
+      hiddenwindow:=wnd;
+    end
+  end
+end;
+//----- interface -----
+
+function CheckTable(ahotkey:integer;global:bool):integer;
+var
+  tmp:pHKRecs;
+  i:integer;
+  p:pHKRec;
+begin
+  if HKRecs=nil then
+  begin
+    MaxRecs:=PageStep;
+    GetMem  (HKRecs ,MaxRecs*SizeOf(THKRec));
+    FillChar(HKRecs^,MaxRecs*SizeOf(THKRec),0);
+    NumRecs:=0;
+  end;
+  // search existing
+  i:=0;
+  p:=pointer(HKRecs);
+  while i<NumRecs do
+  begin
+    if (p^.flags and hkAssigned)<>0 then
+    begin
+      if (p^.hotkey=ahotkey) and
+         (((p^.flags and hkGlobal)<>0) xor not global) then
+        break;
+    end;
+    inc(p);
+    inc(i);
+  end;
+  //search empty
+  if i=NumRecs then
+  begin
+    i:=0;
+    p:=pointer(HKRecs);
+    while i<NumRecs do
+    begin
+      if (p^.flags and hkAssigned)=0 then
+        break;
+      inc(p);
+      inc(i);
+    end;
+  end;
+  if i=NumRecs then // allocate if not found
+  begin
+    if NumRecs=MaxRecs then
+    begin
+      inc(MaxRecs,PageStep);
+      GetMem  (tmp ,MaxRecs*SizeOf(THKRec));
+      FillChar(tmp^,MaxRecs*SizeOf(THKRec),0);
+      move(HKRecs^,tmp^,NumRecs*SizeOf(THKRec));
+      FreeMem(HKRecs);
+      HKRecs:=tmp;
+    end;
+    inc(NumRecs);
+  end;
+  if global then
+    HKRecs^[i].flags:=hkAssigned or hkGlobal
+  else
+    HKRecs^[i].flags:=hkAssigned;
+  HKRecs^[i].hotkey:=HotKeyDlgToHook(ahotkey);
+  result:=i;
+end;
+
+function AddProc(aproc:AWKHotKeyProc;ahotkey:integer;global:bool=false):integer;
+begin
+  result:=1;
+  if @aproc=nil then exit;
+
+  with HKRecs^[CheckTable(ahotkey,global)] do
+  begin
+    proc  :=aproc;
+    handle:=0;
+    if global then
+    begin
+      atom:=GetAtom(hotkey);
+      if not RegisterHotKey(hiddenwindow,atom,hi(hotkey),lo(hotkey)) then
+        result:=0;
+    end;
+  end;
+end;
+
+// search needed
+function AddProcWin(ahotkey:integer;wnd:HWND):integer;
+begin
+  result:=CheckTable(ahotkey,false);
+  with HKRecs^[result] do
+  begin
+    handle:=wnd;
+  end;
+end;
+
+function AddProc(ahotkey:integer;wnd:HWND;aproc:AWKHotKeyProc):integer;
+begin
+  if @aproc=nil then
+  begin
+    result:=0;
+    exit;
+  end;
+
+  result:=AddProcWin(ahotkey,wnd);
+  if result<0 then
+    result:=0
+  else
+  begin
+    HKRecs^[result].proc:=@aproc;
+  end;
+end;
+
+function AddProc(ahotkey:integer;wnd:HWND;msg:DWORD):integer;
+begin
+  result:=AddProcWin(ahotkey,wnd);
+  if result<0 then
+    result:=0
+  else
+  begin
+    HKRecs^[result].flags:=HKRecs^[result].flags or hkMessage;
+    HKRecs^[result].proc :=pointer(msg);
+  end;
+end;
+
+function DelProc(hotkey:integer):integer;
+var
+  i:integer;
+  p:pHKRec;
+begin
+  hotkey:=HotKeyDlgToHook(hotkey); //!!
+  p:=pointer(HKRecs);
+  i:=NumRecs;
+  while i>0 do
+  begin
+    dec(i);
+    if ((p^.flags and hkAssigned)<>0) and (p^.handle=0) then
+      if p^.hotkey=hotkey then
+      begin
+        if (p^.flags and hkGlobal)<>0 then
+        begin
+          UnregisterHotKey(hiddenwindow,p^.atom);
+          GlobalDeleteAtom(p^.atom);
+        end;
+        p^.flags:=p^.flags and not hkAssigned;
+        result:=i;
+        exit;
+      end;
+    inc(p);
+  end;
+  result:=0;
+end;
+
+function DelProc(hotkey:integer;wnd:HWND):integer;
+var
+  i:integer;
+  p:pHKRec;
+begin
+  hotkey:=HotKeyDlgToHook(hotkey); //!!
+  p:=pointer(HKRecs);
+  i:=NumRecs;
+  while i>0 do
+  begin
+    dec(i);
+    if (p^.flags and hkAssigned)<>0 then
+      if (p^.handle=wnd) {and ((p^.flags and hkGlobal)=0)} then
+      begin
+        if (hotkey=0) or (hotkey=p^.hotkey) then
+        begin
+          p^.flags:=p^.flags and not hkAssigned;
+          result:=i;
+          exit;
+        end;
+      end;
+    inc(p);
+  end;
+  result:=0;
+end;
+
+procedure InitHotKeys;
+begin
+  MaxRecs:=10;
+  GetMem(HKRecs,SizeOf(THKRec)*MaxRecs);
+  FillChar(HKRecs^,SizeOf(THKRec)*MaxRecs,0);
+  NumRecs:=0;
+  CreateHiddenWindow;
+  kbhook:=SetWindowsHookExA(WH_KEYBOARD_LL,@wmKeyboardLL_hook,hInstance,0);
+
+  if KbHook=0 then
+    KbHook:=SetWindowsHookExA(WH_KEYBOARD,@wmKeyboard_hook,0,GetCurrentThreadId);
+end;
+
+procedure FreeHotKeys;
+var
+  i:integer;
+  p:pHKRec;
+begin
+  i:=NumRecs;
+  p:=pointer(HKRecs);
+  while i>0 do
+  begin
+    dec(i);
+    if (p^.flags and (hkAssigned or hkGlobal))=(hkAssigned or hkGlobal) then
+    begin
+      UnregisterHotKey(hiddenwindow,p^.atom);
+      GlobalDeleteAtom(p^.atom);
+    end;
+    inc(p);
+  end;
+  DestroyHiddenWindow;
+  if kbhook<>0 then
+    UnhookWindowsHookEx(kbhook);
+  FreeMem(HKRecs);
+  HKRecs:=nil;
+  MaxRecs:=0;
+  NumRecs:=0;
+end;
+
+initialization
+  CurThread:=GetCurrentThreadId();
+end.
\ No newline at end of file
-- 
cgit v1.2.3