Thank you, Charles. You reminded me that I could pass the structures directly as parameters. So I can also apply:
sub CustomPaint(CustomData *pData, sys hDC, RECT *rcDirty, bool bErase)
...
sub CustomDoubleBuffer(CustomData *pData, PAINTSTRUCT *pPaintStruct)
...
I am not sure, but it seems to me that I do not need all the & prefixes in this case. I ommited many of them and I do not see a difference. Maybe I exaggerated a bit. But at the moment the app itself runs ok in 32-bit and 64-bit.
This is the code of DoubleBuff2.o2bas:
'Custom Control demonstrating the double buffering
'https://www.codeproject.com/Articles/617212/Custom-Controls-in-Win32-API-The-Painting
$ filename "dblbuf2.exe"
'uses rtl32
'uses rtl64
uses winutil
% DT_CENTER=1
% DT_VCENTER=4
% DT_SINGLELINE=32
% SWP_NOZORDER=4
% GCL_HBRBACKGROUND = -10
% SRCCOPY=0xCC0020
% WM_NCCREATE=129
% WM_NCDESTROY=130
% WM_PRINTCLIENT=792
% WM_STYLECHANGED=125
% SIZE_RESTORED=0
% SIZE_MAXIMIZED=2
function RGB(int r, g, b) as int
return (r + g*256 + b*65536)
end Function
'=======================
'MAIN CODE
'=======================
dim nCmdline as asciiz ptr, hInstance as sys
&nCmdline = GetCommandLine
hInstance = GetModuleHandle(0)
MainWindow 350,250,WS_OVERLAPPEDWINDOW
'-----------------------------------------------------------------------------
' Window class
% CUSTOM_WC = "CustomControl"
/* Style to request using double buffering. */
% XXS_DOUBLEBUFFER 0x0001
% CUSTOM_ID 100
% MARGIN 7
% CELLSIZE 48
% DARKCOLOR RGB(0,47,127)
% LIGHTCOLOR RGB(241,179,0)
type CustomData
sys hwnd
dword style
sys hbrLight
sys hbrDark
end type
'Register the window class
sub CustomRegister()
WNDCLASSEX wc
' Note we do not use CS_HREDRAW and CS_VREDRAW.
' This means when the control is resized, WM_SIZE (as handled by DefWindowProc())
' invalidates only the newly uncovered area.
' With those class styles, it would invalidate complete client rectangle.
wc.cbSize = sizeof(WNDCLASSEX)
wc.lpszClassName = &CUSTOM_WC 'strptr "CustomControl"
wc.style = CS_GLOBALCLASS
wc.lpfnWndProc = @CustomProc
wc.cbWndExtra = sizeof(sys) 'pointer to CustomData
wc.hCursor = LoadCursor(null, IDC_ARROW)
if RegisterClassEx(&wc) = 0 then mbox "Error: Cannot Register CustomControl"
end sub
'Unregister the window class
sub CustomUnregister()
if UnregisterClass(CUSTOM_WC, null) = 0 then mbox "Error: Cannot Unregister CustomControl"
end sub
function WndProc(sys hwnd, uint uMsg, sys wParam, lParam) as sys callback
static sys hwndCustom
select uMsg
case WM_CREATE
SetWindowText(hwnd, "Double Buffering Example")
CustomRegister()
hwndCustom = CreateWindowEx(0,CUSTOM_WC, null, WS_CHILD or WS_VISIBLE or 0,
0, 0, 0, 0, hwnd, CUSTOM_ID, hInstance, null)
if hwndCustom = 0 then mbox "Error: Cannot create hwndCustom"
case WM_SIZE
if wParam = SIZE_MAXIMIZED or wParam = SIZE_RESTORED then
word cx = loword(lParam)
word cy = hiword(lParam)
SetWindowPos(hwndCustom, null, MARGIN, MARGIN,
(cx-2*MARGIN), (cy-2*MARGIN), SWP_NOZORDER)
end if
case WM_CLOSE
DestroyWindow(hwnd)
case WM_DESTROY
PostQuitMessage(0)
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
end function
sub CustomPaint(CustomData *pData, sys hDC, RECT *rcDirty, bool bErase)
int x, y
RECT r
sys hBrush
' Note we paint only the cells overlaping with the dirty rectangle.
for y = (rcDirty.top / CELLSIZE) to (rcDirty.bottom / CELLSIZE)
for x = (rcDirty.left / CELLSIZE) to (rcDirty.right / CELLSIZE)
if mod((x+y),2)=0 then hBrush=pData.hbrLight else hBrush=pData.hbrDark
SetRect(r, x * CELLSIZE, y * CELLSIZE, (x+1) * CELLSIZE, (y+1) * CELLSIZE)
FillRect(hDC, r, hBrush)
next x
next y
end sub
sub CustomDoubleBuffer(CustomData *pData, PAINTSTRUCT *pPaintStruct)
int cx = pPaintStruct.rcPaint.right - pPaintStruct.rcPaint.left
int cy = pPaintStruct.rcPaint.bottom - pPaintStruct.rcPaint.top
sys hMemDC
sys hBmp
sys hOldBmp
POINT ptOldOrigin
' Create new bitmap-back device context, large as the dirty rectangle.
hMemDC = CreateCompatibleDC(pPaintStruct.hdc)
hBmp = CreateCompatibleBitmap(pPaintStruct.hdc, cx, cy)
hOldBmp = SelectObject(hMemDC, hBmp)
' Do the painting into the memory bitmap.
OffsetViewportOrgEx(hMemDC, -(pPaintStruct.rcPaint.left),
-(pPaintStruct.rcPaint.top), ptOldOrigin)
CustomPaint(pData, hMemDC, pPaintStruct.rcPaint, true)
SetViewportOrgEx(hMemDC, ptOldOrigin.x, ptOldOrigin.y, null)
' Blit the bitmap into the screen. This is really fast operation and altough
' the CustomPaint() can be complex and slow there will be no flicker any more.
BitBlt(pPaintStruct.hdc, pPaintStruct.rcPaint.left, pPaintStruct.rcPaint.top,
cx, cy, hMemDC, 0, 0, SRCCOPY)
' Clean up.
SelectObject(hMemDC, hOldBmp)
DeleteObject(hBmp)
DeleteDC(hMemDC)
end sub
function CustomProc(sys hwnd, uint uMsg, sys wParam, lParam) as sys callback
CustomData *pData 'Pointer to CustomData structure
if uMsg != WM_CREATE then
&pData=GetWindowLongPtr(hwnd, 0)
end if
select case uMsg
case WM_NCCREATE
sys pdat=getmemory sizeof(CustomData)
if pDat then
SetWindowLongPtr(hwnd, 0, pdat) 'Store the pointer for later use
else
return false
end if
&pData=pdat 'address of pData stucture
pData.hwnd = hwnd
CREATESTRUCT cstr at lParam
pData.style=cstr.style
pData.hbrDark = CreateSolidBrush(DARKCOLOR)
pData.hbrLight = CreateSolidBrush(LIGHTCOLOR)
return true
case WM_ERASEBKGND
return false ' Defer erasing into WM_PAINT
case WM_PAINT
PAINTSTRUCT ps
BeginPaint(hwnd, ps)
' We let application to choose whether to use double buffering or not by using the style XXS_DOUBLEBUFFER.
if(pData.style and XXS_DOUBLEBUFFER) then
CustomDoubleBuffer(pData, ps)
else
CustomPaint(pData, ps.hdc, ps.rcPaint, ps.fErase)
end if
EndPaint(hwnd, ps)
return 0
case WM_PRINTCLIENT
RECT rc
GetClientRect(hwnd, rc)
CustomPaint(pData, wParam, rc, true)
return 0
case WM_STYLECHANGED
if wParam = GWL_STYLE then
pData.style = lParam
end if
break
case WM_NCDESTROY
if &pData then
DeleteObject(pData.hbrDark)
DeleteObject(pData.hbrLight)
freememory(&pData)
end if
CustomUnregister()
return 0
end select
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end function
