Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Draw Rect with mouse, and grid sample..

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Draw Rect with mouse, and grid sample..

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' 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..     [img]http://www.powerbasic.com/support/forums/smile.gif[/img]
    '--------------------------------------------------------------------
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
    '--------------------------------------------------------------------
    %IDC_CHK1 = 121
    %IDC_CHK2 = 122
    '--------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION DlgProc() AS LONG
    DECLARE FUNCTION MakeGridBrush (BYVAL hDlg AS DWORD) AS 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 CBHNDL, LOWRD(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 CBHNDL, CBCTL TO gSnapToGrid
                  END IF
     
               CASE %IDC_CHK2
                  IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                     CONTROL GET CHECK CBHNDL, CBCTL 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, 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 DWORD) AS 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

    ------------------
    http://www.tolkenxp.com/pb
    Download: incLean, PBcodec, custom controls and code, etc.
    Borje Hagsten - [email protected]



    [This message has been edited by Borje Hagsten (edited March 04, 2003).]

  • #2
    Added %WM_LBUTTONDBLCLK trap to avoid garbage paint on double-clicks.
    Thanks for the tip, Brad!


    ------------------
    http://www.tolkenxp.com/pb
    Download: incLean, PBcodec, custom controls and code, etc.
    Borje Hagsten - [email protected]

    Comment


    • #3
      I compiled this code today with PowerBASIC 9.01.

      The compilation process runs well; but when I run the program I'm not able to draw a rectangle on the grid.

      Any ideas ?
      Jean-Pierre LEROY

      Comment


      • #4
        I started a thread in the Programming forum since discussions are discouraged in this thread.
        http://www.powerbasic.com/support/pb...ad.php?t=41158
        Rod
        In some future era, dark matter and dark energy will only be found in Astronomy's Dark Ages.

        Comment


        • #5
          Hi Borje,

          Thanks for this Super Sample!

          Just one small improvement I noticed:
          In the following Function:
          Code:
          FUNCTION MakeGridBrush(BYVAL hDlg AS DWORD) AS DWORD
            LOCAL hDC AS DWORD, memDC AS DWORD, hBit AS DWORD, hBitOld AS DWORD, rc AS RECT
          ...
            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
          ...
          END FUNCTION
          The SetPixelV is painting a pixel outside the bitmap area: the bitmap is cGridX x cGridY in size thus the co-ordinates runs from 0 to cGridX-1 and 0 to 0 to cGridY-1.

          One only need a single SetPixelV call.

          Code:
          FUNCTION MakeGridBrush(BYVAL hDlg AS DWORD) AS DWORD
            LOCAL hDC AS DWORD, memDC AS DWORD, hBit AS DWORD, hBitOld AS DWORD, rc AS RECT
          ...
            SetPixelV memDC, 0, 0, 0      'paint one "dot" in the corner
          '  SetPixelV memDC, 0, cGridY, 0
          '  SetPixelV memDC, cGridX, 0, 0
          '  SetPixelV memDC, cGridX, cGridY, 0
          ...
          END FUNCTION
          Kind regards
          JADT

          Comment

          Working...
          X