|
|
@@ -0,0 +1,425 @@
|
|
|
+{
|
|
|
+ $Id$
|
|
|
+ Copyright (c) 2002 by Pierre Muller
|
|
|
+
|
|
|
+ This unit implements an the hooks needed for the win32 graph unit.
|
|
|
+
|
|
|
+ This program is free software; you can redistribute it and/or modify
|
|
|
+ it under the terms of the GNU General Public License as published by
|
|
|
+ the Free Software Foundation; either version 2 of the License, or
|
|
|
+ (at your option) any later version.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
+ GNU General Public License for more details.
|
|
|
+
|
|
|
+ You should have received a copy of the GNU General Public License
|
|
|
+ along with this program; if not, write to the Free Software
|
|
|
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
+
|
|
|
+ ****************************************************************************
|
|
|
+}
|
|
|
+unit win32gr;
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+procedure SetGraphHooks;
|
|
|
+
|
|
|
+procedure UnsetGraphHooks;
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+uses
|
|
|
+ windows,
|
|
|
+ drivers,
|
|
|
+ graph;
|
|
|
+
|
|
|
+
|
|
|
+var
|
|
|
+ InputHandle : Handle;
|
|
|
+ StoredControlKeyState : longint;
|
|
|
+
|
|
|
+
|
|
|
+const
|
|
|
+ KeyToAsciiCode : array [0..255] of char =
|
|
|
+ (
|
|
|
+ { 00 } #0,
|
|
|
+ { 01 VK_LBUTTON } #0,
|
|
|
+ { 02 VK_RBUTTON } #0,
|
|
|
+ { 03 VK_CANCEL } #0,
|
|
|
+ { 04 VK_MBUTTON } #0,
|
|
|
+ { 05 unassigned } #0,
|
|
|
+ { 06 unassigned } #0,
|
|
|
+ { 07 unassigned } #0,
|
|
|
+ { 08 VK_BACK } #0,
|
|
|
+ { 09 VK_TAB } #9,
|
|
|
+ { 0A unassigned } #0,
|
|
|
+ { 0B unassigned } #0,
|
|
|
+ { 0C VK_CLEAR ?? } #0,
|
|
|
+ { 0D VK_RETURN } #0,
|
|
|
+ { 0E unassigned } #0,
|
|
|
+ { 0F unassigned } #0,
|
|
|
+ { 10 VK_SHIFT } #0,
|
|
|
+ { 11 VK_CONTROL } #0,
|
|
|
+ { 12 VK_MENU (Alt key) } #0,
|
|
|
+ { 13 VK_PAUSE } #0,
|
|
|
+ { 14 VK_CAPITAL (Caps Lock) } #0,
|
|
|
+ { 15 Reserved for Kanji systems} #0,
|
|
|
+ { 16 Reserved for Kanji systems} #0,
|
|
|
+ { 17 Reserved for Kanji systems} #0,
|
|
|
+ { 18 Reserved for Kanji systems} #0,
|
|
|
+ { 19 Reserved for Kanji systems} #0,
|
|
|
+ { 1A unassigned } #0,
|
|
|
+ { 1B VK_ESCAPE } #27,
|
|
|
+ { 1C Reserved for Kanji systems} #0,
|
|
|
+ { 1D Reserved for Kanji systems} #0,
|
|
|
+ { 1E Reserved for Kanji systems} #0,
|
|
|
+ { 1F Reserved for Kanji systems} #0,
|
|
|
+ { 20 VK_SPACE} ' ',
|
|
|
+ { 21 VK_PRIOR (PgUp) } #0,
|
|
|
+ { 22 VK_NEXT (PgDown) } #0,
|
|
|
+ { 23 VK_END } #0,
|
|
|
+ { 24 VK_HOME } #0,
|
|
|
+ { 25 VK_LEFT } #0,
|
|
|
+ { 26 VK_UP } #0,
|
|
|
+ { 27 VK_RIGHT } #0,
|
|
|
+ { 28 VK_DOWN } #0,
|
|
|
+ { 29 VK_SELECT ??? } #0,
|
|
|
+ { 2A OEM specific !! } #0,
|
|
|
+ { 2B VK_EXECUTE } #0,
|
|
|
+ { 2C VK_SNAPSHOT } #0,
|
|
|
+ { 2D VK_INSERT } #0,
|
|
|
+ { 2E VK_DELETE } #0,
|
|
|
+ { 2F VK_HELP } #0,
|
|
|
+ { 30 VK_0 '0' } '0',
|
|
|
+ { 31 VK_1 '1' } '1',
|
|
|
+ { 32 VK_2 '2' } '2',
|
|
|
+ { 33 VK_3 '3' } '3',
|
|
|
+ { 34 VK_4 '4' } '4',
|
|
|
+ { 35 VK_5 '5' } '5',
|
|
|
+ { 36 VK_6 '6' } '6',
|
|
|
+ { 37 VK_7 '7' } '7',
|
|
|
+ { 38 VK_8 '8' } '8',
|
|
|
+ { 39 VK_9 '9' } '9',
|
|
|
+ { 3A unassigned } #0,
|
|
|
+ { 3B unassigned } #0,
|
|
|
+ { 3C unassigned } #0,
|
|
|
+ { 3D unassigned } #0,
|
|
|
+ { 3E unassigned } #0,
|
|
|
+ { 3F unassigned } #0,
|
|
|
+ { 40 unassigned } #0,
|
|
|
+ { 41 VK_A 'A' } 'A',
|
|
|
+ { 42 VK_B 'B' } 'B',
|
|
|
+ { 43 VK_C 'C' } 'C',
|
|
|
+ { 44 VK_D 'D' } 'D',
|
|
|
+ { 45 VK_E 'E' } 'E',
|
|
|
+ { 46 VK_F 'F' } 'F',
|
|
|
+ { 47 VK_G 'G' } 'G',
|
|
|
+ { 48 VK_H 'H' } 'H',
|
|
|
+ { 49 VK_I 'I' } 'I',
|
|
|
+ { 4A VK_J 'J' } 'J',
|
|
|
+ { 4B VK_K 'K' } 'K',
|
|
|
+ { 4C VK_L 'L' } 'L',
|
|
|
+ { 4D VK_M 'M' } 'M',
|
|
|
+ { 4E VK_N 'N' } 'N',
|
|
|
+ { 4F VK_O 'O' } 'O',
|
|
|
+ { 50 VK_P 'P' } 'P',
|
|
|
+ { 51 VK_Q 'Q' } 'Q',
|
|
|
+ { 52 VK_R 'R' } 'R',
|
|
|
+ { 53 VK_S 'S' } 'S',
|
|
|
+ { 54 VK_T 'T' } 'T',
|
|
|
+ { 55 VK_U 'U' } 'U',
|
|
|
+ { 56 VK_V 'V' } 'V',
|
|
|
+ { 57 VK_W 'W' } 'W',
|
|
|
+ { 58 VK_X 'X' } 'X',
|
|
|
+ { 59 VK_Y 'Y' } 'Y',
|
|
|
+ { 5A VK_Z 'Z' } 'Z',
|
|
|
+ { 5B unassigned } #0,
|
|
|
+ { 5C unassigned } #0,
|
|
|
+ { 5D unassigned } #0,
|
|
|
+ { 5E unassigned } #0,
|
|
|
+ { 5F unassigned } #0,
|
|
|
+ { 60 VK_NUMPAD0 NumKeyPad '0' } '0',
|
|
|
+ { 61 VK_NUMPAD1 NumKeyPad '1' } '1',
|
|
|
+ { 62 VK_NUMPAD2 NumKeyPad '2' } '2',
|
|
|
+ { 63 VK_NUMPAD3 NumKeyPad '3' } '3',
|
|
|
+ { 64 VK_NUMPAD4 NumKeyPad '4' } '4',
|
|
|
+ { 65 VK_NUMPAD5 NumKeyPad '5' } '5',
|
|
|
+ { 66 VK_NUMPAD6 NumKeyPad '6' } '6',
|
|
|
+ { 67 VK_NUMPAD7 NumKeyPad '7' } '7',
|
|
|
+ { 68 VK_NUMPAD8 NumKeyPad '8' } '8',
|
|
|
+ { 69 VK_NUMPAD9 NumKeyPad '9' } '9',
|
|
|
+ { 6A VK_MULTIPLY } #0,
|
|
|
+ { 6B VK_ADD } #0,
|
|
|
+ { 6C VK_SEPARATOR } #0,
|
|
|
+ { 6D VK_SUBSTRACT } #0,
|
|
|
+ { 6E VK_DECIMAL } #0,
|
|
|
+ { 6F VK_DIVIDE } #0,
|
|
|
+ { 70 VK_F1 'F1' } #0,
|
|
|
+ { 71 VK_F2 'F2' } #0,
|
|
|
+ { 72 VK_F3 'F3' } #0,
|
|
|
+ { 73 VK_F4 'F4' } #0,
|
|
|
+ { 74 VK_F5 'F5' } #0,
|
|
|
+ { 75 VK_F6 'F6' } #0,
|
|
|
+ { 76 VK_F7 'F7' } #0,
|
|
|
+ { 77 VK_F8 'F8' } #0,
|
|
|
+ { 78 VK_F9 'F9' } #0,
|
|
|
+ { 79 VK_F10 'F10' } #0,
|
|
|
+ { 7A VK_F11 'F11' } #0,
|
|
|
+ { 7B VK_F12 'F12' } #0,
|
|
|
+ { 7C VK_F13 } #0,
|
|
|
+ { 7D VK_F14 } #0,
|
|
|
+ { 7E VK_F15 } #0,
|
|
|
+ { 7F VK_F16 } #0,
|
|
|
+ { 80 VK_F17 } #0,
|
|
|
+ { 81 VK_F18 } #0,
|
|
|
+ { 82 VK_F19 } #0,
|
|
|
+ { 83 VK_F20 } #0,
|
|
|
+ { 84 VK_F21 } #0,
|
|
|
+ { 85 VK_F22 } #0,
|
|
|
+ { 86 VK_F23 } #0,
|
|
|
+ { 87 VK_F24 } #0,
|
|
|
+ { 88 unassigned } #0,
|
|
|
+ { 89 VK_NUMLOCK } #0,
|
|
|
+ { 8A VK_SCROLL } #0,
|
|
|
+ { 8B unassigned } #0,
|
|
|
+ { 8C unassigned } #0,
|
|
|
+ { 8D unassigned } #0,
|
|
|
+ { 8E unassigned } #0,
|
|
|
+ { 8F unassigned } #0,
|
|
|
+ { 90 unassigned } #0,
|
|
|
+ { 91 unassigned } #0,
|
|
|
+ { 92 unassigned } #0,
|
|
|
+ { 93 unassigned } #0,
|
|
|
+ { 94 unassigned } #0,
|
|
|
+ { 95 unassigned } #0,
|
|
|
+ { 96 unassigned } #0,
|
|
|
+ { 97 unassigned } #0,
|
|
|
+ { 98 unassigned } #0,
|
|
|
+ { 99 unassigned } #0,
|
|
|
+ { 9A unassigned } #0,
|
|
|
+ { 9B unassigned } #0,
|
|
|
+ { 9C unassigned } #0,
|
|
|
+ { 9D unassigned } #0,
|
|
|
+ { 9E unassigned } #0,
|
|
|
+ { 9F unassigned } #0,
|
|
|
+ { A0 unassigned } #0,
|
|
|
+ { A1 unassigned } #0,
|
|
|
+ { A2 unassigned } #0,
|
|
|
+ { A3 unassigned } #0,
|
|
|
+ { A4 unassigned } #0,
|
|
|
+ { A5 unassigned } #0,
|
|
|
+ { A6 unassigned } #0,
|
|
|
+ { A7 unassigned } #0,
|
|
|
+ { A8 unassigned } #0,
|
|
|
+ { A9 unassigned } #0,
|
|
|
+ { AA unassigned } #0,
|
|
|
+ { AB unassigned } #0,
|
|
|
+ { AC unassigned } #0,
|
|
|
+ { AD unassigned } #0,
|
|
|
+ { AE unassigned } #0,
|
|
|
+ { AF unassigned } #0,
|
|
|
+ { B0 unassigned } #0,
|
|
|
+ { B1 unassigned } #0,
|
|
|
+ { B2 unassigned } #0,
|
|
|
+ { B3 unassigned } #0,
|
|
|
+ { B4 unassigned } #0,
|
|
|
+ { B5 unassigned } #0,
|
|
|
+ { B6 unassigned } #0,
|
|
|
+ { B7 unassigned } #0,
|
|
|
+ { B8 unassigned } #0,
|
|
|
+ { B9 unassigned } #0,
|
|
|
+ { BA OEM specific } #0,
|
|
|
+ { BB OEM specific } #0,
|
|
|
+ { BC OEM specific } #0,
|
|
|
+ { BD OEM specific } #0,
|
|
|
+ { BE OEM specific } #0,
|
|
|
+ { BF OEM specific } #0,
|
|
|
+ { C0 OEM specific } #0,
|
|
|
+ { C1 unassigned } #0,
|
|
|
+ { C2 unassigned } #0,
|
|
|
+ { C3 unassigned } #0,
|
|
|
+ { C4 unassigned } #0,
|
|
|
+ { C5 unassigned } #0,
|
|
|
+ { C6 unassigned } #0,
|
|
|
+ { C7 unassigned } #0,
|
|
|
+ { C8 unassigned } #0,
|
|
|
+ { C9 unassigned } #0,
|
|
|
+ { CA unassigned } #0,
|
|
|
+ { CB unassigned } #0,
|
|
|
+ { CC unassigned } #0,
|
|
|
+ { CD unassigned } #0,
|
|
|
+ { CE unassigned } #0,
|
|
|
+ { CF unassigned } #0,
|
|
|
+ { D0 unassigned } #0,
|
|
|
+ { D1 unassigned } #0,
|
|
|
+ { D2 unassigned } #0,
|
|
|
+ { D3 unassigned } #0,
|
|
|
+ { D4 unassigned } #0,
|
|
|
+ { D5 unassigned } #0,
|
|
|
+ { D6 unassigned } #0,
|
|
|
+ { D7 unassigned } #0,
|
|
|
+ { D8 unassigned } #0,
|
|
|
+ { D9 unassigned } #0,
|
|
|
+ { DA unassigned } #0,
|
|
|
+ { DB OEM specific } #0,
|
|
|
+ { DC OEM specific } #0,
|
|
|
+ { DD OEM specific } #0,
|
|
|
+ { DE OEM specific } #0,
|
|
|
+ { DF OEM specific } #0,
|
|
|
+ { E0 OEM specific } #0,
|
|
|
+ { E1 OEM specific } #0,
|
|
|
+ { E2 OEM specific } #0,
|
|
|
+ { E3 OEM specific } #0,
|
|
|
+ { E4 OEM specific } #0,
|
|
|
+ { E5 unassigned } #0,
|
|
|
+ { E6 OEM specific } #0,
|
|
|
+ { E7 unassigned } #0,
|
|
|
+ { E8 unassigned } #0,
|
|
|
+ { E9 OEM specific } #0,
|
|
|
+ { EA OEM specific } #0,
|
|
|
+ { EB OEM specific } #0,
|
|
|
+ { EC OEM specific } #0,
|
|
|
+ { ED OEM specific } #0,
|
|
|
+ { EE OEM specific } #0,
|
|
|
+ { EF OEM specific } #0,
|
|
|
+ { F0 OEM specific } #0,
|
|
|
+ { F1 OEM specific } #0,
|
|
|
+ { F2 OEM specific } #0,
|
|
|
+ { F3 OEM specific } #0,
|
|
|
+ { F4 OEM specific } #0,
|
|
|
+ { F5 OEM specific } #0,
|
|
|
+ { F6 unassigned } #0,
|
|
|
+ { F7 unassigned } #0,
|
|
|
+ { F8 unassigned } #0,
|
|
|
+ { F9 unassigned } #0,
|
|
|
+ { FA unassigned } #0,
|
|
|
+ { FB unassigned } #0,
|
|
|
+ { FC unassigned } #0,
|
|
|
+ { FD unassigned } #0,
|
|
|
+ { FE unassigned } #0,
|
|
|
+ { FF unassigned } #0
|
|
|
+ );
|
|
|
+
|
|
|
+{ this procedure allows to hook keyboard messages }
|
|
|
+function fvisioncharmessagehandler (Window: hwnd; AMessage, WParam,
|
|
|
+ LParam: Longint): Longint;
|
|
|
+var
|
|
|
+ ir : INPUT_RECORD;
|
|
|
+ NumWritten : longint;
|
|
|
+ vKey : byte;
|
|
|
+ IsExtended : boolean;
|
|
|
+begin
|
|
|
+ fvisioncharmessagehandler:=0;
|
|
|
+ if (AMessage = WM_CHAR) then
|
|
|
+ exit;
|
|
|
+ fillchar(ir,sizeof(ir),#0);
|
|
|
+ ir.EventType:=KEY_EVENT;
|
|
|
+ with ir.Event.KeyEvent do
|
|
|
+ begin
|
|
|
+ vKey:=WParam and $ff;
|
|
|
+ IsExtended:=(lParam and (1 shl 24))<>0;
|
|
|
+ if AMessage = WM_KEYDOWN then
|
|
|
+ bKeyDown:=true;
|
|
|
+ wVirtualKeyCode:=vKey;
|
|
|
+ dwControlKeyState:=StoredControlKeyState;
|
|
|
+ AsciiChar:=KeyToAsciiCode[vKey];
|
|
|
+ if AsciiChar<>#0 then
|
|
|
+ begin
|
|
|
+ { Use lower chars }
|
|
|
+ if ((StoredControlKeyState and SHIFT_PRESSED)=0) and
|
|
|
+ ((wVirtualKeyCode>=VK_A) and (wVirtualKeyCode<=VK_Z)) then
|
|
|
+ AsciiChar:=chr(ord(AsciiChar) + ord('a')-ord('A'));
|
|
|
+ end;
|
|
|
+ case vKey of
|
|
|
+ VK_SHIFT :
|
|
|
+ if bKeyDown then
|
|
|
+ StoredControlKeyState:= StoredControlKeyState or SHIFT_PRESSED
|
|
|
+ else
|
|
|
+ StoredControlKeyState:= StoredControlKeyState and not SHIFT_PRESSED;
|
|
|
+ VK_CONTROL :
|
|
|
+ begin
|
|
|
+ if IsExtended then
|
|
|
+ begin
|
|
|
+ if bKeyDown then
|
|
|
+ StoredControlKeyState:= StoredControlKeyState or RIGHT_CTRL_PRESSED
|
|
|
+ else
|
|
|
+ StoredControlKeyState:= StoredControlKeyState and not RIGHT_CTRL_PRESSED;
|
|
|
+ end
|
|
|
+ else if bKeyDown then
|
|
|
+ StoredControlKeyState:= StoredControlKeyState or LEFT_CTRL_PRESSED
|
|
|
+ else
|
|
|
+ StoredControlKeyState:= StoredControlKeyState and not LEFT_CTRL_PRESSED;
|
|
|
+ end;
|
|
|
+ VK_MENU :
|
|
|
+ begin
|
|
|
+ if IsExtended then
|
|
|
+ begin
|
|
|
+ if bKeyDown then
|
|
|
+ StoredControlKeyState:= StoredControlKeyState or RIGHT_ALT_PRESSED
|
|
|
+ else
|
|
|
+ StoredControlKeyState:= StoredControlKeyState and not RIGHT_ALT_PRESSED;
|
|
|
+ end
|
|
|
+ else if bKeyDown then
|
|
|
+ StoredControlKeyState:= StoredControlKeyState or LEFT_ALT_PRESSED
|
|
|
+ else
|
|
|
+ StoredControlKeyState:= StoredControlKeyState and not LEFT_ALT_PRESSED;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ end;
|
|
|
+ WriteConsoleInput(InputHandle,ir,1,NumWritten);
|
|
|
+end;
|
|
|
+
|
|
|
+{ this procedure allows to hook mouse messages }
|
|
|
+function fvisionmousemessagehandler (Window: hwnd; AMessage, WParam,
|
|
|
+ LParam: Longint): Longint;
|
|
|
+
|
|
|
+var
|
|
|
+ ir : INPUT_RECORD;
|
|
|
+ NumWritten : longint;
|
|
|
+begin
|
|
|
+ fvisionmousemessagehandler:=0;
|
|
|
+ ir.EventType:=_MOUSE_EVENT;
|
|
|
+ with ir.Event.MouseEvent do
|
|
|
+ begin
|
|
|
+ dwMousePosition.x:=loword(LParam) div SysFontWidth;
|
|
|
+ dwMousePosition.y:=hiword(LParam) div SysFontHeight;
|
|
|
+ dwButtonState:=0;
|
|
|
+ if (wParam and MK_LBUTTON)<>0 then
|
|
|
+ dwButtonState:=dwButtonState or FROM_LEFT_1ST_BUTTON_PRESSED;
|
|
|
+ if (wParam and MK_MBUTTON)<>0 then
|
|
|
+ dwButtonState:=dwButtonState or FROM_LEFT_2ND_BUTTON_PRESSED;
|
|
|
+ if (wParam and MK_RBUTTON)<>0 then
|
|
|
+ dwButtonState:=dwButtonState or RIGHTMOST_BUTTON_PRESSED;
|
|
|
+ end;
|
|
|
+ WriteConsoleInput(InputHandle,ir,1,NumWritten);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetGraphHooks;
|
|
|
+
|
|
|
+begin
|
|
|
+ mousemessagehandler:=@fvisionmousemessagehandler;
|
|
|
+ charmessagehandler:=@fvisioncharmessagehandler;
|
|
|
+ InputHandle:=GetStdHandle(STD_INPUT_HANDLE);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure UnsetGraphHooks;
|
|
|
+
|
|
|
+begin
|
|
|
+ mousemessagehandler:=nil;
|
|
|
+ charmessagehandler:=nil;
|
|
|
+ InputHandle:=UnusedHandle;
|
|
|
+ StoredControlKeyState:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+end.
|
|
|
+
|
|
|
+{
|
|
|
+ $Log$
|
|
|
+ Revision 1.1 2002-05-24 09:35:20 pierre
|
|
|
+ first commit, not fully functional yet
|
|
|
+
|
|
|
+
|
|
|
+}
|
pierre