Last updated: 18. 1.1998, 10:55
<*/NOWARN:F*>
(*-------------------------------------------------------
KEYLOOK.C --- Displays Keyboard and Character Messages
(c) Charles Petzold, 1996
KeyLook.MOD --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
-------------------------------------------------------*)
MODULE KeyLook;
IMPORT SYSTEM;
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT WINX;
CONST
szAppName = "KeyLook";
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
rect : WIN32.RECT;
cxChar : INTEGER;
cyChar : INTEGER;
TYPE
Form = ARRAY[0..40] OF CHAR;
FormArr = ARRAY[0..1] OF Form;
CONST
szFormat = FormArr{
{ "%-14s %3d %c %6u %4d %3s %3s %4s %4s"},
{"%-14s %3d %c %6u %4d %3s %3s %4s %4s"}
};
CONST szTop =
"Message Key Char Repeat Scan Ext ALT Prev Tran";
szUnd =
"_______ ___ ____ ______ ____ ___ ___ ____ ____";
PROCEDURE ShowKey (hwnd : WIN32.HWND; iType : INTEGER; szMessage : ARRAY OF CHAR;
wParam : WIN32.WPARAM; lParam : WIN32.LPARAM);
VAR
szBuffer : ARRAY[0..79] OF CHAR;
hdc : WIN32.HDC;
TYPE
Bytes = ARRAY[0..4] OF CHAR;
VAR
byte : WIN32.BYTE;
str1 : Bytes;
str2 : Bytes;
str3 : Bytes;
str4 : Bytes;
BEGIN
WINUSER.ScrollWindow (hwnd, 0, -cyChar, rect, rect);
hdc := WINUSER.GetDC (hwnd);
WINGDI.SelectObject (hdc, WINGDI.GetStockObject (WINGDI.SYSTEM_FIXED_FONT));
IF(iType=1) THEN
byte := wParam;
ELSE
byte := SYSTEM.CAST(WIN32.BYTE,' ');
END;
IF(01000000h BAND lParam=1) THEN
str1 := "Yes ";
ELSE
str1 := "No ";
END;
IF(20000000h BAND lParam=1) THEN
str2 := "Yes ";
ELSE
str2 := "No ";
END;
IF(40000000h BAND lParam=1) THEN
str3 := "Down";
ELSE
str3 := "Up ";
END;
IF(60000000h BAND lParam=1) THEN
(* 80000000h !!!! *)
str4 := "Up ";
ELSE
str4 := "Down";
END;
WINGDI.TextOut (hdc, cxChar, rect.bottom - cyChar, szBuffer,
WINUSER.wsprintf (szBuffer, szFormat [iType],
szMessage, wParam,
byte,
WINUSER.LOWORD (lParam),
WINUSER.HIWORD (lParam) BAND 000000FFh,
str1,
str2,
str3,
str4));
WINUSER.ReleaseDC (hwnd, hdc);
WINUSER.ValidateRect (hwnd, WINX.NIL_RECT);
END ShowKey;
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE WndProc (hwnd : WIN32.HWND;
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
(**********************************************************************)
VAR
hdc : WIN32.HDC;
ps : WINUSER.PAINTSTRUCT;
tm : WINGDI.TEXTMETRIC;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
hdc := WINUSER.GetDC (hwnd);
WINGDI.SelectObject (hdc, WINGDI.GetStockObject (WINGDI.SYSTEM_FIXED_FONT));
WINGDI.GetTextMetrics (hdc, tm);
cxChar := tm.tmAveCharWidth;
cyChar := tm.tmHeight;
WINUSER.ReleaseDC (hwnd, hdc);
rect.top := 3 * cyChar DIV 2;
RETURN 0;
| WINUSER.WM_SIZE :
rect.right := WINUSER.LOWORD (lParam);
rect.bottom := WINUSER.HIWORD (lParam);
WINUSER.UpdateWindow (hwnd);
RETURN 0;
| WINUSER.WM_PAINT :
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
hdc := WINUSER.BeginPaint (hwnd, ps);
WINGDI.SelectObject (hdc, WINGDI.GetStockObject (WINGDI.SYSTEM_FIXED_FONT));
WINGDI.SetBkMode (hdc, WINGDI.TRANSPARENT);
WINGDI.TextOut (hdc, cxChar, cyChar DIV 2, szTop, (SIZE(szTop) - 1));
WINGDI.TextOut (hdc, cxChar, cyChar DIV 2, szUnd, (SIZE(szUnd) - 1));
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_KEYDOWN :
ShowKey (hwnd, 0, "WINUSER.WM_KEYDOWN", wParam, lParam);
RETURN 0;
| WINUSER.WM_KEYUP :
ShowKey (hwnd, 0, "WINUSER.WM_KEYUP", wParam, lParam);
RETURN 0;
| WINUSER.WM_CHAR :
ShowKey (hwnd, 1, "WINUSER.WM_CHAR", wParam, lParam);
RETURN 0;
| WINUSER.WM_DEADCHAR :
ShowKey (hwnd, 1, "WINUSER.WM_DEADCHAR", wParam, lParam);
RETURN 0;
| WINUSER.WM_SYSKEYDOWN :
ShowKey (hwnd, 0, "WINUSER.WM_SYSKEYDOWN", wParam, lParam);
| WINUSER.WM_SYSKEYUP :
ShowKey (hwnd, 0, "WINUSER.WM_SYSKEYUP", wParam, lParam);
| WINUSER.WM_SYSCHAR :
ShowKey (hwnd, 1, "WINUSER.WM_SYSCHAR", wParam, lParam);
| WINUSER.WM_SYSDEADCHAR :
ShowKey (hwnd, 1, "WINUSER.WM_SYSDEADCHAR", wParam, lParam);
| WINUSER.WM_DESTROY :
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
BEGIN
wc.cbSize := SIZE(WINUSER.WNDCLASSEX);
wc.style := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := WINX.Instance;
wc.hIcon := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
RETURN WINUSER.RegisterClassEx (wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow
(szAppName, (* window class name *)
"Keyboard Message Looker: Translation to Stony Brook Modula-2",
(* window caption *)
WINUSER.WS_OVERLAPPEDWINDOW, (* window style *)
WINUSER.CW_USEDEFAULT, (* initial x position *)
WINUSER.CW_USEDEFAULT, (* initial y position *)
WINUSER.CW_USEDEFAULT, (* initial x size *)
WINUSER.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
WINX.Instance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
WINUSER.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END KeyLook.