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