GDI: CreatePatternBrush Function

[José Roca]

 
The following example creates a patterned brush to display a dotted grid.

Code Select Expand


' ########################################################################################
' DrawRect sample, showing a completely flicker free way to draw a
' hollow rectangle in a window, by using a global memDC as buffer
' and temporary memDC for drawing, before copying all to screen.
'
' Also included is code for grid background points via pattern brush.
' Note: pattern brushes can only be 8x8 pixels in Win95. In all other
' systems, Win98 and up, brush can be larger. Commented code - hope
' it's understandable..
'
' Public Domain by Borje Hagsten, March 2003
'
' Can be used as base for a paint program, or why not a visual designer?
' Just add a few bytes of code for creating and resizing controls with
' the mouse, and you have made yourself your own visual designer..
' Adapted by José Roca, April 2009.
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"

%IDC_CHK1 = 121
%IDC_CHK2 = 122

GLOBAL cGridX AS LONG, cGridY AS LONG, gShowGrid AS LONG, gSnapToGrid AS LONG
GLOBAL ghBitmap AS DWORD, ghBrush AS DWORD, gMemDC AS DWORD
GLOBAL gPt AS POINTAPI, gRc AS RECT

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hWndMain    AS DWORD
   LOCAL hCtl        AS DWORD
   LOCAL hFont       AS DWORD
   LOCAL wcex        AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc          AS RECT
   LOCAL szCaption   AS ASCIIZ * 255
   LOCAL nLeft       AS LONG
   LOCAL nTop        AS LONG
   LOCAL nWidth      AS LONG
   LOCAL nHeight     AS LONG

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "DrawRect and Grid Sample"

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and size of the window
   nWidth  = 488
   nHeight = 323
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window styles
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x size
                             nHeight, _                        ' initial y size
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   hCtl = CreateWindowEx(0, "Button", "&Snap to grid ", _
               %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_AUTOCHECKBOX, _
               383, 211, 90, 17, hWndMain, %IDC_CHK1, GetModuleHandle(""), BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
   SendMessage hCtl, %BM_SETCHECK, %BST_CHECKED, 0

   hCtl = CreateWindowEx(0, "Button", "&Show grid ", _
               %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_AUTOCHECKBOX, _
               383, 231, 90, 16, hWndMain, %IDC_CHK2, GetModuleHandle(""), BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
   SendMessage hCtl, %BM_SETCHECK, %BST_CHECKED, 0

   hCtl = CreateWindowEx(0, "Button", "&Quit", _
               %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
               383, 260, 90, 23, hWndMain, %IDCANCEL, GetModuleHandle(""), BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL  lRes AS LONG
   LOCAL  hdc  AS DWORD
   LOCAL  rc   AS RECT
   STATIC hCur AS DWORD

   SELECT CASE wMsg

      CASE %WM_CREATE
         cGridX      = 10     ' Horizontal grid size
         cGridY      = 10     ' Vertical grid size
         gShowGrid   = 1      ' Show grid at start
         gSnapToGrid = 1      ' Snap drawing to grid at start
         hCur        = LoadCursor(0, BYVAL %IDC_CROSS)  ' Store handle of cursot to use at draw
         ghBrush     = MakeGridBrush(hWnd)              ' and create grid brush
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE %IDC_CHK1
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  gSnapToGrid = SendMessage(GetDlgItem(hWnd, LO(WORD, wParam)), %BM_GETCHECK, 0, 0)
                  EXIT FUNCTION
               END IF
            CASE %IDC_CHK2
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  gShowGrid = SendMessage(GetDlgItem(hWnd, LO(WORD, wParam)), %BM_GETCHECK, 0, 0)
                  RedrawWindow hWnd, BYVAL %NULL, 0, _
                               %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_UPDATENOW
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_ERASEBKGND
         IF gShowGrid AND ghBrush THEN
            hdc = wParam
            GetClientRect hWnd, rc
            FillRect hdc, rc, ghBrush
            FUNCTION = 1
            EXIT FUNCTION
         END IF

      CASE %WM_SETCURSOR
        ' If mouse button is pressed, over-ride default cursor and
        ' set "own", here cross cursor.
        IF wParam = hWnd AND HI(WORD, lParam) = %WM_LBUTTONDOWN THEN
           IF GetCursor <> hCur THEN SetCursor hCur
           FUNCTION = 1
           EXIT FUNCTION
        END IF

      CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK
         ' Start selrect draw
         selRectBegin hWnd
         EXIT FUNCTION

      CASE %WM_MOUSEMOVE
         ' If mouse button is down while moved, draw rect
         IF (wParam AND %MK_LBUTTON) THEN
            selRectDraw hWnd, LO(WORD, lParam), HI(WORD, lParam)
            EXIT FUNCTION
         END IF

      CASE %WM_LBUTTONUP
         ' Mouse button released - end draw
         selRectEnd hWnd
         ' Now, when mouse button is released, global RECT (gRc)
         ' will hold coordinates of final drawn rect. If you
         ' for example want to select a group of controls or
         ' other objects, you can use IntersectRect API to see
         ' if parts of other RECT's are withing this global rect.
         ' Or use the coordinates to create a control/object of
         ' this size, whatever..
         EXIT FUNCTION

      CASE %WM_DESTROY
         ' Delete what we created on exit, to avoid mem leaks
         IF ghBrush THEN DeleteObject ghBrush
         IF ghBitmap THEN DeleteObject SelectObject(gMemDC, ghBitmap)
         IF gMemDC THEN DeleteDC gMemDC  'should already be deleted, but to make sure..
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Initialize sel rect drawing
' Copy dialog to global "screen buffer" for use as base for flicker
' free drawing and later restore.
' ========================================================================================
SUB selRectBegin (BYVAL hWnd AS DWORD)

   LOCAL hDC AS DWORD, hBit AS DWORD, pt AS POINT, rc AS RECT

   SetCapture hWnd                 ' Set capture to desired window
   GetClientRect hWnd, rc          ' Get client size
   MapWindowPoints hWnd, 0, rc, 2  ' Map client coordiantes to screen
   ClipCursor rc                   ' Clip cursor to client coordinates

   GetCursorPos gPt                ' Get cursor pos on screen
   ScreenToClient hWnd, gPt        ' Convert to client coordinates

   IF gSnapToGrid THEN
      gPt.x = (gPt.x \ cGridX) * cGridX  ' If snap to grid, calculate grid positin
      gPt.y = (gPt.y \ cGridY) * cGridY  ' via multiply of integer divide result
   END IF

   GetClientRect hWnd, rc          ' Create a global memDC and copy window to it.
   hDC      = GetDc(hWnd)
   gMemDC   = CreateCompatibleDC (hDC)
   ghBitmap = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
   ghBitmap = SelectObject(gMemDC, ghBitmap)

   BitBlt gMemDC, 0, 0, rc.nRight, rc.nBottom, hDC, 0, 0, %SRCCOPY
   ReleaseDc hWnd, hDC

END SUB
' ========================================================================================

' ========================================================================================
' perform sel rect drawing
' ========================================================================================
SUB selRectDraw (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)

   LOCAL hDC AS DWORD, hBrush AS DWORD, hPen AS DWORD, rc AS RECT
   LOCAL memDC AS DWORD, hBitmap AS DWORD

   IF gSnapToGrid THEN
      ' MS cross cursor has mis-aligned hotspot - it should be at
      ' cross, but is upper-left corner. We should use own cross,
      ' but this is just a sample, so instead cheat and add 4 to pos..
      x = x + 4  ' <- Depends on where hotspot in cursor is..
      y = y + 4
      x = (x \ cGridX) * cGridX  ' First integer divide, then multiply for "grid effect".
      y = (y \ cGridY) * cGridY
   END IF

   ' Must make sure rect coordinates are correct,
   ' so right side always is larger than left, etc.
   IF (gPt.x <= x) AND (gPt.y >= y) THEN
      SetRect gRc, gPt.x, y, x, gPt.y
   ELSEIF (gPt.x > x) AND (gPt.y > y) THEN
      SetRect gRc, x, y, gPt.x, gPt.y
   ELSEIF (gPt.x >= x) AND (gPt.y <= y) THEN
      SetRect gRc, x, gPt.y, gPt.x, y
   ELSE
      SetRect gRc, gPt.x, gPt.y, x, y
   END IF

   GetClientRect hWnd, rc
   IF gRc.nLeft = gRc.nRight  THEN INCR gRc.nRight  '<- Ensure we never get a "null rect"
   IF gRc.nTop  = gRc.nBottom THEN INCR gRc.nBottom

   hDC     = GetDc(hWnd)
   memDC   = CreateCompatibleDC (hDC)  ' Create temporary memDC to draw in
   hBitmap = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
   hBitmap = SelectObject(memDC, hBitmap)
   hBrush  = SelectObject(memDC, GetStockObject(%NULL_BRUSH))  ' For hollow rect

   BitBlt memDC, 0, 0, rc.nRight, rc.nBottom, gMemDC, 0, 0, %SRCCOPY  ' Copy original buffer to temp DC

   hPen = SelectObject(memDC, CreatePen(%PS_SOLID, 2, GetSysColor(%COLOR_3DSHADOW))) 'create pen
   Rectangle memDC, gRc.nLeft, gRc.nTop, gRc.nRight + 1, gRc.nBottom + 1             'draw rect
   DeleteObject SelectObject(memDC, hPen)

   BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, memDC, 0, 0, %SRCCOPY  ' Copy temp DC to window

   SelectObject memDC, hBrush
   IF hBitmap  THEN DeleteObject SelectObject(memDC, hBitmap)  ' Clean up to avoid mem leaks
   IF memDC THEN DeleteDC memDC
   ReleaseDc hWnd, hDC

END SUB
' ========================================================================================

' ========================================================================================
' End sel rect drawing
' Copy original window buffer back to screen to wipe out drawn
' rectangle, delete global memDC, release capture and clipped cursor.
' ========================================================================================
SUB selRectEnd (BYVAL hWnd AS DWORD)

   LOCAL hDC AS DWORD, rc AS RECT

   hDC = GetDc(hWnd)
   GetClientRect hWnd, rc
   BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, gMemDC, 0, 0, %SRCCOPY
   ReleaseDc hWnd, hDC

   IF ghBitmap  THEN
      DeleteObject SelectObject(gMemDC, ghBitmap)
      ghBitmap  = 0
   END IF
   IF gMemDC THEN
      DeleteDC gMemDC
      gMemDC = 0
   END IF
   ReleaseCapture

   ClipCursor BYVAL %NULL

END SUB
' ========================================================================================

' ========================================================================================
' Create a patterned brush for grid. By using this, grid draw becomes
' very quick, even on full size dialogs. Must warn though - in Win95,
' brush can be max 8x8 pixels. In Win98 and later, brush can be bigger,
' so never a problem there.
' ========================================================================================
FUNCTION MakeGridBrush(BYVAL hDlg AS DWORD) AS DWORD

   LOCAL hDC AS DWORD, memDC AS DWORD, hBitmap AS DWORD, hBitmapOld AS DWORD, rc AS RECT

   hDC        = GetDC(hDlg)
   memDC      = CreateCompatibleDC(hDC)
   hBitmap    = CreateCompatibleBitmap(hDC, cGridX, cGridY)
   hBitmapOld = SelectObject(memDC, hBitmap)

   rc.nRight  = cGridX
   rc.nBottom = cGridY
   FillRect memDC, rc, GetSysColorBrush(%COLOR_3DFACE)

   SetPixelV memDC, 0, 0, 0      ' Paint dots in all four corners
   SetPixelV memDC, 0, cGridY, 0
   SetPixelV memDC, cGridX, 0, 0
   SetPixelV memDC, cGridX, cGridY, 0

   FUNCTION = CreatePatternBrush(hBitmap)

   SelectObject memDC, hBitmapOld  ' Clean up to avoid memory leaks
   DeleteObject hBitmap
   DeleteDC memDC
   ReleaseDC hDlg, hDC

END FUNCTION
' ========================================================================================