Draw Only - Borjge - %WM_xButton Events

Category: gbDesigner

Date: 03-28-2012

Return to Index


 
'Compilable Example:
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' 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..
'--------------------------------------------------------------------
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Include "WIN32API.INC"
'--------------------------------------------------------------------
%IDC_CHK1 = 121
%IDC_CHK2 = 122
'--------------------------------------------------------------------
Declare CallBack Function DlgProc() As Long
Declare Function MakeGridBrush (ByVal hDlg AS DWordAS DWord
 
Declare SUB selRectBegin (ByVal hWnd AS DWord)
Declare SUB selRectDraw  (ByVal hWnd AS DWord, ByVal x As Long, ByVal y As Long)
Declare SUB selRectEnd   (ByVal hWnd AS DWord)
'--------------------------------------------------------------------
Global cGridX As Long, cGridY As Long, gShowGrid As Long, gSnapToGrid As Long
Global ghBit AS DWord, ghBrush AS DWord, gMemDC AS DWord
Global gPt AS POINTAPI, gRc AS RECT
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Main entrance
'--------------------------------------------------------------------
 
Function PBMain () As Long
   Local hDlg AS DWord, lRes As Long
 
   DIALOG NEW 0, "DrawRect and grid sample",,, 321, 179, _
      %WS_CAPTION OR %WS_CLIPCHILDREN OR %WS_SYSMENU, 0 TO hDlg
 
   CONTROL ADD CHECKBOX, hDlg, %IDC_CHK1, "&Snap to grid ", 255, 130, 60, 10
   CONTROL ADD CHECKBOX, hDlg, %IDC_CHK2, "&Show grid ",    255, 142, 60, 10
   CONTROL SET CHECK hDlg, %IDC_CHK1, 1
   CONTROL SET CHECK hDlg, %IDC_CHK2, 2
 
   CONTROL ADD BUTTON,   hDlg, %IDCANCEL, "&Quit",          255, 160, 60, 14
 
   DIALOG SHOW MODAL hDlg CALL DlgProc
 
End Function
 
   'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
   ' Main callback
   '--------------------------------------------------------------------
 
CallBack Function DlgProc() As Long
   Local lRes As Long
 
   SELECT CASE CBMSG
      CASE %WM_INITDIALOG
         STATIC hCur AS DWord ' for static grid brush handle
         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(CBHNDL)           ' and create grid brush
 
      CASE %WM_CTLCOLORDLG ' paint grid if gShowGrid is on..
         IF gShowGrid AND ghBrush THEN Function = ghBrush
 
      CASE %WM_DESTROY 'delete what we created on exit, to avoid mem leaks
         IF ghBrush THEN DeleteObject ghBrush
         IF ghBit   THEN DeleteObject SelectObject(gMemDC, ghBit)
         IF gMemDC  THEN DeleteDC gMemDC  'should already be deleted, but to make sure..
 
      CASE %WM_SETCURSOR
         ' If mouse button is pressed, over-ride default cursor and
         ' set "own", here cross cursor. Note - in dialogs, we must return
         ' %TRUE to inform dialog engine we have taken charge. In SDK-style
         ' windows, we would have had to return zero and break out.
         IF CBWPARAM = CBHNDL AND HIWRD(CBLPARAM) = %WM_LBUTTONDOWN THEN
            IF GetCursor <> hCur THEN SetCursor hCur
            Function = 1
         END IF
 
      CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK 'start selrect draw
         selRectBegin CBHNDL
 
      CASE %WM_MOUSEMOVE
         IF (CBWPARAM AND %MK_LBUTTON) THEN 'if mouse button is down while moved, draw rect
            selRectDraw CBHNDLLOWRD(CBLPARAM), HIWRD(CBLPARAM)
         END IF
 
      CASE %WM_LBUTTONUP 'mouse button released - end draw
         selRectEnd CBHNDL
         ' 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..
 
      CASE %WM_COMMAND      ' <- a control is calling
         SELECT CASE CBCTL  ' <- look at control's id
            CASE %IDC_CHK1
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                  CONTROL GET CHECK CBHNDLCBCTL TO gSnapToGrid
               END IF
 
            CASE %IDC_CHK2
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                  CONTROL GET CHECK CBHNDLCBCTL TO gShowGrid
                  RedrawWindow CBHNDL, ByVal %NULL, 0, _
                     %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_UPDATENOW
               END IF
 
            CASE %IDCANCEL
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog
                  DIALOG END CBHNDL
               END IF
 
         END SELECT
   END SELECT
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 POINTAPI, rc AS RECT
 
   SetCapture hWnd                 ' set capture to desired window
   GetClientRect hWnd, rc          ' get client size
   MapWindowPoints hWnd, 0, ByVal VarPTR(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'd pos"
      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)
   ghBit  = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
   ghBit  = SelectObject(gMemDC, ghBit)
 
   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, hBit 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
   hBit   = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
   hBit   = SelectObject(memDC, hBit)
   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 hBit  THEN DeleteObject SelectObject(memDC, hBit) '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 ghBit  THEN DeleteObject SelectObject(gMemDC, ghBit) : ghBit  = 0
   IF gMemDC THEN DeleteDC gMemDC    : gMemDC = 0
   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 DWordAS DWord
   Local hDC AS DWord, memDC AS DWord, hBit AS DWord, hBitOld AS DWord, rc AS RECT
 
   hDC     = GetDC(hDlg)
   memDC   = CreateCompatibleDC(hDC)
   hBit    = CreateCompatibleBitmap(hDC, cGridX, cGridY)
   hBitOld = SelectObject(memDC, hBit)
 
   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 (hBit)
 
   SelectObject memDC, hBitOld 'clean up to avoid mem leaks
   DeleteObject hBit
   DeleteDC memDC
   ReleaseDC hDlg, hDC
 
End Function
 
'gbs_01098
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm