'  Screen Drag Rectangle Demonstration
'  -----------------------------------
'  Demonstration of how to draw a drag rectangle on the screen DC without the performance
'  loss seen when GetDC(NULL) is used to access the screen DC.
'  This code will work fine with Vista's Aero (DWM) enabled, unlike code that uses GetDC(NULL) or CreateDC "DESKTOP".
'  Org. discussion: [URL][/URL]
'  Posted: August 2008.
#Compile Exe
#Dim All
#Include "WIN32API.INC"                         ' Windows API definitions.
Global gDragStarted As Long                     ' TRUE if drag operation in process.
Global gDraghWnd As Dword                       ' Window handle that the drag operation is in.
Global gDragLockWindow As Long                  ' TRUE if the desktop window was locked.
Global gDragHDC As Dword                        ' Device context of the desktop (screen).
Global gDragHalftoneBrush As Dword              ' Halftone brush used for animated rectangles.
' Creates an 8 pixel half-tone brush used with drawing "animated" rectangles.
Function DragHalftoneBrush As Dword
  Dim grayPattern(0 To 7) As Word
  Local grayBitmap As Dword
  Local i As Long
  For i = 0 To 7
      grayPattern(i) = &H5555
      Shift Left grayPattern(i), (i And 1)
  Next i
  grayBitmap = CreateBitmap(8, 8, 1, 1, ByVal VarPtr(grayPattern(0)))
  If (grayBitmap) Then
     Function = CreatePatternBrush(grayBitmap)
  End If
End Function
' Core function. Draws the drag rectangle on the previously obtained screen DC.
' Note: any previous rectangle is erased.
Function DragPaint(ByRef rcArea As RECT, _
                   ByRef szlArea As SIZEL, _
                   ByRef rcAreaLast As RECT, _
                   ByRef szlLast As SIZEL, _
                   ByRef hBrush As Dword, _
                   ByRef hBrushLast As Dword) As Long
  Local rgnNew As Dword
  Local rgnOutside As Dword
  Local rgnInside As Dword
  Local rgnLast As Dword
  Local rgnUpdate As Dword
  Local hBrushOld As Dword
  Local rc As RECT
  Local szl As SIZEL
  ' Create an update region from the drag rectangle...
  rgnOutside = CreateRectRgnIndirect(rcArea)
  rc = rcArea
  IntersectRect(rc, rc, rcArea)
  rgnInside = CreateRectRgnIndirect(rc)
  rgnNew = CreateRectRgn(0, 0, 0, 0)
  CombineRgn(rgnNew, rgnOutside, rgnInside, %RGN_XOR)
  If (hBrush = %NULL) Then hBrush = DragHalfToneBrush
  If (hBrushLast = %NULL) Then hBrushLast = hBrush
  If (IsRectEmpty(rcAreaLast) = %FALSE) Then
     ' find difference between new region and old region
     rgnLast = CreateRectRgn(0, 0, 0, 0)
     SetRectRgn(rgnOutside, rcAreaLast.nLeft, rcAreaLast.nTop, rcAreaLast.nRight, rcAreaLast.nBottom)
     rc = rcAreaLast
     IntersectRect(rc, rc, rcAreaLast)
     SetRectRgn(rgnInside, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom)
     CombineRgn(rgnLast, rgnOutside, rgnInside, %RGN_XOR)
     ' only diff them if brushes are the same
     If (hBrush = hBrushLast) Then
        rgnUpdate = CreateRectRgn(0, 0, 0, 0)
        CombineRgn(rgnUpdate, rgnLast, rgnNew, %RGN_XOR)
     End If
  End If
  If (hBrush <> hBrushLast) And (IsRectEmpty(rcAreaLast) = %FALSE) Then
     ' brushes are different -- erase old region first
     SelectClipRgn(gDragHDC, rgnLast)
     GetClipBox(gDragHDC, rc)
     hBrushOld = SelectObject(gDragHDC, hBrushLast)
     PatBlt(gDragHDC, rc.nleft, rc.ntop, rc.nRight-rc.nLeft, rc.nBottom-rc.nTop, %PATINVERT)
     SelectObject(gDragHDC, hBrushOld)
     hBrushOld = %NULL
  End If
  ' draw into the update/new region
  SelectClipRgn(gDragHDC, IIf&(rgnUpdate <> %NULL, rgnUpdate, rgnNew))
  GetClipBox(gDragHDC, rc)
  hBrushOld = SelectObject(gDragHDC, hBrush)
  PatBlt(gDragHDC, rc.nleft, rc.ntop, rc.nRight-rc.nLeft, rc.nBottom-rc.nTop, %PATINVERT)
  If (hBrushOld <> %NULL) Then SelectObject(gDragHDC, hBrushOld)
  SelectClipRgn(gDragHDC, %NULL)
  Function = %TRUE
End Function
' Draws a drag rectangle in the specified style to the window.
' Note: if rcArea is empty, the last rectangle drawn is removed.
Function DragDraw(ByRef rcArea As RECT, _
                  ByVal nAnimated As Long, _
                  ByVal nThickness As Long) As Long
  Local hWhiteBrush As Dword
  Local hAniBrush As Dword
  Local hBrush As Dword
  Local szl As SIZEL
  Static rcAreaLast As RECT
  Static szlLast As SIZEL
  Static bAniLast As Byte
  If (gDragStarted = %FALSE) Then Exit Function
  hWhiteBrush = GetStockObject(%WHITE_BRUSH)
  hAniBrush = DragHalftoneBrush
  If nAnimated Then
     ' Animated border...
     hBrush = hAnibrush
     ' Standard border...
     hBrush = hWhiteBrush
  End If
  If (nThickness < 1) Then
     ' Use default line width if not specified....
     If (nAnimated) Then
        ' Use thick frame width... = GetSystemMetrics(%SM_CXDLGFRAME) = GetSystemMetrics(%SM_CYDLGFRAME)
        ' Use very thin frame... = 1 = 1
     End If
     ' User specified line width... = nThickness = nThickness
  End If
  If DragPaint(rcArea, szl, rcAreaLast, szlLast, hBrush, IIf&(bAniLast, hAniBrush, hWhiteBrush)) Then
     If VarPtr(rcArea) Then
        ' Save last...
        rcAreaLast = rcArea
        szlLast = szl
        bAniLast = nAnimated
     End If
     Function = %TRUE
  End If
End Function
CallBack Function dlgProc
  Local hDesktop As Dword
  Local msg As TAGMSG
  Select Case CbMsg
         Case %wm_lbuttondown
              ' Only start once per drag session...
              If gDragStarted Then Exit Function
              ' Clear the message queue of any WM_PAINT messages...
              While (PeekMessage(msg, %NULL, %wm_paint, %wm_paint, %PM_NOREMOVE))
                    If (GetMessage(msg, %NULL, %wm_paint, %wm_paint) = %FALSE) Then
                       Exit Loop
                    End If
              ' Use specific window or desktop...
              gDraghWnd = %NULL 'cbhndl
              ' Lock all updates...
              gDragLockWindow = LockWindowUpdate(gDraghWnd)
              If (gDragLockWindow) Then
                 gDragHDC = GetDCEx(gDraghWnd, %NULL, %DCX_WINDOW Or %DCX_CACHE Or %DCX_LOCKWINDOWUPDATE)
                 gDragHDC = GetDCEx(gDraghWnd, %NULL, %DCX_WINDOW Or %DCX_CACHE)
              End If
              ' Must have a valid screen DC...
              If (gDragHDC) Then
                 ' Create halftone brush for later use...
                 gDragHalftoneBrush = DragHalftoneBrush
                 gDragStarted = %TRUE
              End If
              ' Capture the mouse now...
              SetCapture CbHndl
         Case %wm_mousemove
              ' Draw the rectangle...
              If (gDragStarted = %FALSE) Then Exit Function
              Local rc As RECT
              GetCursorPos ByVal VarPtr(rc)
              rc.nRight = rc.nLeft + 50
              rc.nBottom = rc.nTop + 50
              rc.nLeft = rc.nLeft - 50
              rc.nTop = rc.nTop - 50
              DragDraw rc, 0, 0
         Case %wm_lbuttonup
              ' Trigger WM_CAPTURECHANGED...
         Case %wm_capturechanged
              Local rcEmpty As RECT
              ' Must have started...
              If (gDragStarted = %FALSE) Then Exit Function
              ' Clear last rectangle...
              DragDraw rcEmpty, 0, 0
              ' Remove the temporary brush...
              DeleteObject DragHalftoneBrush
              ' Remove the window lock and device context...
              If (gDragLockWindow) Then LockWindowUpdate %NULL
              ReleaseDC gDraghWnd, gDragHDC
              ' Signal we're finished...
              gDragStarted = %FALSE
  End Select
End Function
' Program Start Point
Function PBMain
  Local hDlg As Dword
  ' Create the main program interface with DDT...
  Dialog New %HWND_DESKTOP, "Click 'n' Drag", , , 350, 200, %ws_caption Or %ws_border Or %ws_sysmenu To hDlg
  ' Display the main dialog...
  Dialog Show Modal hDlg Call dlgProc
End Function