    '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 = strptr "CustomControl" 'strptr(CUSTOM_WC)           '
        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() 'once only
               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