This is another instructive example of "Programming Windows". It can be run either using corewinW.inc (found in reply #2 above) or using corewin.inc - in this case the WinApi functions must be adapted to the Unicode versions, which is an interesting exercise anyway. Details and info about the program can be found in Chapter 6 of the book. I wonder how the output will look like in other languages.
One aspect of the app impressed me a lot. I did not expect that using TextOut in about line 237 would work as is in Oxygenbasic, with applying wsprintf and szFormat and the different expressions. But it worked! Very cool.
KeyView2.o2bas
/*--------------------------------------------------------
KeyView2.o2bas -- Displays Keyboard and Character Messages
adapted to Unicode and ported to Oxygen Basic
The code in C is discussed in: Programming Windows, Fifth Edition
(c) Charles Petzold, 1998
--------------------------------------------------------*/
$ filename "KeyView2.exe"
'uses rtl32
'uses rtl64
uses corewinW
% SM_CXMAXIMIZED 61
% SM_CYMAXIMIZED 62
% SYSTEM_FONT 13
% WM_INPUTLANGCHANGE 0x0051
% WM_DISPLAYCHANGE 0x007E
type TEXTMETRICW
long tmHeight
long tmAscent
long tmDescent
long tmInternalLeading
long tmExternalLeading
long tmAveCharWidth
long tmMaxCharWidth
long tmWeight
long tmOverhang
long tmDigitizedAspectX
long tmDigitizedAspectY
wchar tmFirstChar
wchar tmLastChar
wchar tmDefaultChar
wchar tmBreakChar
byte tmItalic
byte tmUnderlined
byte tmStruckOut
byte tmPitchAndFamily
byte tmCharSet
end type
typedef TEXTMETRICW TEXTMETRIC
' Helper functions
macro iif int(R, A,B,C)
if A then R=B else R=C
end macro
macro iif$ wstring(R, A,B,C)
if A then R=B else R=C
end macro
function min(int a,b)
if a<b then return a
return b
end function
indexbase 0
sys hInstance = GetModuleHandle (NULL)
int iCmdShow = SW_SHOW
function WinMain () as sys
wstring szAppName = L"KeyView2"
sys hwnd
MSG msg
WNDCLASS wndclass
wndclass.style = CS_HREDRAW or CS_VREDRAW
wndclass.lpfnWndProc = @WndProc
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = hInstance
wndclass.hIcon = LoadIcon (NULL, IDI_APPLICATION)
wndclass.hCursor = LoadCursor (NULL, IDC_ARROW)
wndclass.hbrBackground = GetStockObject (WHITE_BRUSH)
wndclass.lpszMenuName = NULL
wndclass.lpszClassName = strptr szAppName
if not RegisterClass (&wndclass) then
MessageBox (NULL, L"Cannot RegisterClass wndclass",
szAppName, MB_ICONERROR)
return 0
end if
hwnd = CreateWindowEx (0,
szAppName, L"Keyboard Message Viewer #2",
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT, CW_USEDEFAULT,
CW_USEDEFAULT, CW_USEDEFAULT,
NULL, NULL, hInstance, NULL)
if not hwnd then
MessageBox (NULL, L"Cannot Create Main Window",
szAppName, MB_ICONERROR)
return 0
end if
ShowWindow (hwnd, iCmdShow)
UpdateWindow (hwnd)
while GetMessage (&msg, NULL, 0, 0)
TranslateMessage (&msg)
DispatchMessage (&msg)
wend
end function
function WndProc (sys hwnd, uint message, sys wParam, sys lParam) as sys callback
static DWORD dwCharSet = DEFAULT_CHARSET
static int cxClientMax, cyClientMax, cxClient, cyClient, cxChar, cyChar
static int cLinesMax, cLines
static MSG *pmsg
static sys pMem
static RECT rectScroll
wstring szTop = L"Message Key Char Repeat Scan Ext ALT Prev Tran"
wstring szUnd = L"_______ ___ ____ ______ ____ ___ ___ ____ ____"
' array of two strings!
wstring szFormat[] = { L"%-13s %3d %-19s%c%6u %4d %3s %3s %4s %4s",
L"%-13s 0x%04X%1s%c %9u %4d %3s %3s %4s %4s" }
wstring szYes = L"Yes"
wstring szNo = L"No"
wstring szDown = L"Down"
wstring szUp = L"Up"
' array of 8 strings
wstring szMessage [] = {
L"WM_KEYDOWN", L"WM_KEYUP",
L"WM_CHAR", L"WM_DEADCHAR",
L"WM_SYSKEYDOWN", L"WM_SYSKEYUP",
L"WM_SYSCHAR", L"WM_SYSDEADCHAR" }
sys hdc
int i, iType
PAINTSTRUCT ps
wchar szBuffer[128], szKeyName [32]
TEXTMETRIC tm
switch message {
case WM_INPUTLANGCHANGE
dwCharSet = wParam
// fall through
case WM_CREATE
case WM_DISPLAYCHANGE
// Get maximum size of client area
cxClientMax = GetSystemMetrics (SM_CXMAXIMIZED)
cyClientMax = GetSystemMetrics (SM_CYMAXIMIZED)
// Get character size for fixed-pitch font
hdc = GetDC (hwnd)
SelectObject (hdc, CreateFont (0, 0, 0, 0, 0, 0, 0, 0,
dwCharSet, 0, 0, 0, FIXED_PITCH, NULL))
GetTextMetrics (hdc, &tm)
cxChar = tm.tmAveCharWidth
cyChar = tm.tmHeight
DeleteObject (SelectObject (hdc, GetStockObject (SYSTEM_FONT)))
ReleaseDC (hwnd, hdc)
// Allocate memory for display lines
if pMem then freememory pmsg
cLinesMax = cyClientMax / cyChar
pMem = getmemory (cLinesMax * sizeof (MSG))
@pmsg = pMem
cLines = 0
// fall through
case WM_SIZE
if message = WM_SIZE then
cxClient = LOWORD (lParam)
cyClient = HIWORD (lParam)
end if
// Calculate scrolling rectangle
rectScroll.left = 0
rectScroll.right = cxClient
rectScroll.top = cyChar
rectScroll.bottom = cyChar * (cyClient / cyChar)
InvalidateRect (hwnd, NULL, TRUE)
if message = WM_INPUTLANGCHANGE then return TRUE
return 0
case WM_KEYDOWN
case WM_KEYUP
case WM_CHAR
case WM_DEADCHAR
case WM_SYSKEYDOWN
case WM_SYSKEYUP
case WM_SYSCHAR
case WM_SYSDEADCHAR
// Rearrange storage array
for i = cLinesMax - 1 to > 0 step -1
pmsg[i] = pmsg[i - 1]
next i
// Store new message
pmsg[0].hwnd = hwnd
pmsg[0].message = message
pmsg[0].wParam = wParam
pmsg[0].lParam = lParam
cLines = min (cLines + 1, cLinesMax)
// Scroll up the display
ScrollWindow (hwnd, 0, -cyChar, &rectScroll, &rectScroll)
break // ie, call DefWindowProc so Sys messages work
case WM_PAINT
hdc = BeginPaint (hwnd, &ps)
SelectObject (hdc, CreateFont (0, 0, 0, 0, 0, 0, 0, 0,
dwCharSet, 0, 0, 0, FIXED_PITCH, NULL))
SetBkMode (hdc, TRANSPARENT)
TextOut (hdc, 0, 0, szTop, len (szTop))
TextOut (hdc, 0, 0, szUnd, len (szUnd))
int limit = min (cLines, cyClient / cyChar - 1)
for i = 0 to < limit
' Oxygen: true=-1
iType = abs(pmsg[i].message == WM_CHAR ||
pmsg[i].message == WM_SYSCHAR ||
pmsg[i].message == WM_DEADCHAR ||
pmsg[i].message == WM_SYSDEADCHAR)
GetKeyNameText (pmsg[i].lParam, @szKeyName, 32)
TextOut (hdc, 0, (cyClient \ cyChar - 1 - i) * cyChar, szBuffer,
wsprintf (szBuffer, szFormat [iType],
szMessage [pmsg[i].message - WM_KEYFIRST],
pmsg[i].wParam,
iif$ (iType != 0, L" " , szKeyName),
iif (iType != 0, pmsg[i].wParam , L" "),
LOWORD (pmsg[i].lParam),
HIWORD (pmsg[i].lParam) & 0xFF,
iif$ (0x01000000 & pmsg[i].lParam, szYes , szNo),
iif$ (0x20000000 & pmsg[i].lParam, szYes , szNo),
iif$ (0x40000000 & pmsg[i].lParam, szDown, szUp),
iif$ (0x80000000 & pmsg[i].lParam, szUp , szDown)
))
next i
DeleteObject (SelectObject (hdc, GetStockObject (SYSTEM_FONT)))
EndPaint (hwnd, &ps)
return 0
case WM_DESTROY
PostQuitMessage (0)
return 0
} 'end switch
return DefWindowProc (hwnd, message, wParam, lParam)
end function
WinMain ()