The Mother of All Windows Books/CD-MOM.iso/cd_mom/newsletr/vbz/vbz1-3/dll_src.exe/HOTKEY.PAS

Pascal/Delphi Source File | 1993-02-24 | 3KB | 139 lines

{HOTKEY.DLL - HotKey Support DLL for Visual Basic}
{by Jonathan Zuck}
{Copyright 1992-3 Jonathan Zuck and User Friendly, Inc.}

library HotKey;

{$C Fixed Permanent}

{$R HOTKEY}

uses WinTypes, WinProcs;

type
    HotRec = Record
        VKCODE:integer;
      MASK:integer;
      hWnd:hWnd;
      MyKey:integer;
  end;

var
    HotArray: array [1..1024] of HotRec;
  TKeys:integer;
    NextProc:TFarProc;
  SaveExit:Pointer;

function KBProc (nCode, wParam:integer;lParam:Longint):longint;export;
    Var
       TempMask, El:integer;
    Match:Bool;
    Begin
       if (NOT lParam < 0) and (wParam <> VK_SHIFT)
        and (wParam <> VK_CONTROL) and (wParam <> VK_MENU) and (nCode >= 0) then
          Begin
          TempMask := 0;
            if GetKeyState (VK_SHIFT) < 0 then TempMask := TempMask + 1;
            if GetKeyState (VK_CONTROL) < 0 then TempMask := TempMask + 2;
            if GetKeyState (VK_MENU) < 0 then TempMask := TempMask + 4;
        El := 0;
        Match := FALSE;
        While (Match = FALSE) and (El <> TKeys) do
            Begin
              Inc (El);
            if (HotArray[El].VKCODE = wParam)
                And (HotArray[El].MASK = TempMask) then Match := TRUE;
          End;
          if Match then
              Begin
                PostMessage (HotArray[El].HWND, WM_KEYDOWN, HotArray[El].MyKey, lParam);
                  KBProc := 1;
            End
          Else
                      KBProc := DefHookProc (nCode, wParam, lParam, @NextProc);
              End
             Else
                 Begin
                      KBProc := DefHookProc (nCode, wParam, lParam, @NextProc);
                End;
  end;

function CreateHK (KeyCode, Shift, hWindow, UKeyCode:integer):longint;export;
    Var
       El:integer;
    Match:Bool;
    ID:^LongInt;
    Begin
      if TKeys = 0 then
        NextProc := SetWindowsHook (WH_KEYBOARD, @KBProc);
        if TKeys < 1024 then
            Begin
        El := 0;
        Match := FALSE;
        While (Match = FALSE) and (El <> TKeys) do
            Begin
              Inc(El);
            if (HotArray[El].VKCODE = KeyCode)
                and (HotArray[El].MASK = Shift) then Match := TRUE;
            end;
            if Not Match then
                Begin
                          Inc (TKeys);
                         HotArray[TKeys].VKCODE := KeyCode;
                         HotArray[TKeys].MASK := Shift;
                             HotArray[TKeys].HWND := hWindow;
                    HotArray[TKeys].MyKey := UKeyCode;
                ID := @HotArray[TKeys].HWND;
                         CreateHK := ID^;
              end
            Else CreateHK := -1;
              end
       else
           Begin
          CreateHK := -2;
        end;
    end;

procedure KillHK (hHK:longint);export;
    var
       El:integer;
      ID:^longint;
    Match:Bool;

    Begin
       El := 0;
    Match := FALSE;
    While (Match = FALSE) and (El <> TKeys) do
         Begin
               Inc(El);
        ID := @HotArray[El].HWND;
        if ID^ = hHK then MATCH := TRUE;
      end;
      if Match then
          Begin
              Move (HotArray[El + 1].VKCODE, HotArray[El].VKCODE,
              SizeOf (HotRec) * (TKeys - El));
          Dec (TKeys);
          if TKeys = 0 then
              UnHookWindowsHook (WH_KEYBOARD, @KBProc);
        end;
  end;

procedure LibExit; far;
    begin
    if TKeys > 0 then
           UnHookWindowsHook (WH_KEYBOARD, @KBProc);
    ExitProc := SaveExit;
  end;

Exports
    KBProc,
  CreateHK resident,
  KillHK resident;

begin
    TKeys := 0;
  SaveExit := ExitProc;
  ExitProc := @LibExit;
end.