vbAccelerator - Contents of code file: mPickItem.bas

Attribute VB_Name = "mPickItem"
Option Explicit

Private Const MCVBALPickerProp = "vbalPicker:Control"


Public Type POINTAPI
   x As Long
   y As Long
End Type

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public Type MOUSEHOOKSTRUCT '{ // ms
    pt As POINTAPI
    hWnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As
 Any, lpvSource As Any, ByVal cbCopy As Long)

Private Declare Function IsWindow Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetProp Lib "USER32" Alias "GetPropA" (ByVal hWnd As
 Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "USER32" Alias "SetPropA" (ByVal hWnd As
 Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "USER32" Alias "RemovePropA" (ByVal
 hWnd As Long, ByVal lpString As String) As Long

Public Declare Function IsWindowVisible Lib "USER32" (ByVal hWnd As Long) As
 Long
Public Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Public Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect
 As RECT) As Long
Public Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Long, lpRect
 As RECT) As Long
Public Declare Function ClientToScreen Lib "USER32" (ByVal hWnd As Long,
 lpPoint As POINTAPI) As Long
Public Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long,
 lpPoint As POINTAPI) As Long
Public Declare Function MapWindowPoints Lib "USER32" (ByVal hwndFrom As Long,
 ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA"
 (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA"
 (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   Public Const GWL_STYLE = (-16)
   Public Const WS_BORDER = &H800000
   Public Const WS_CHILD = &H40000000
   Public Const WS_DISABLED = &H8000000
   Public Const WS_VISIBLE = &H10000000
   Public Const WS_TABSTOP = &H100000
   Public Const WS_HSCROLL = &H100000
   Public Const GWL_EXSTYLE = (-20)
   Public Const WS_EX_TOPMOST = &H8&
   Public Const WS_EX_CLIENTEDGE = &H200&
   Public Const WS_EX_STATICEDGE = &H20000
   Public Const WS_EX_WINDOWEDGE = &H100&
   Public Const WS_EX_APPWINDOW = &H40000
   Public Const WS_EX_TOOLWINDOW = &H80&
   Public Const WS_EX_LAYERED As Long = &H80000

Public Declare Function SetWindowPos Lib "USER32" (ByVal hWnd As Long, ByVal
 hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long,
 ByVal cy As Long, ByVal wFlags As Long) As Long
   Public Const SWP_FRAMECHANGED = &H20        '  The frame changed: send
    WM_NCCALCSIZE
   Public Const SWP_NOACTIVATE = &H10
   Public Const SWP_NOMOVE = &H2
   Public Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering
   Public Const SWP_NOREDRAW = &H8
   Public Const SWP_NOSIZE = &H1
   Public Const SWP_NOZORDER = &H4
   Public Const SWP_SHOWWINDOW = &H40
   Public Const HWND_DESKTOP = 0
Public Declare Function ShowWindow Lib "USER32" (ByVal hWnd As Long, ByVal
 nCmdShow As Long) As Long
   Public Const SW_HIDE = 0
   
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal
 nIndex As Long) As Long
    Public Const BITSPIXEL = 12
    Public Const LOGPIXELSX = 88    '  Logical pixels/inch in X
    Public Const LOGPIXELSY = 90    '  Logical pixels/inch in Y
' System metrics:
Public Declare Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As
 Long
    Public Const SM_CXICON = 11
    Public Const SM_CYICON = 12
    Public Const SM_CXFRAME = 32
    Public Const SM_CYCAPTION = 4
    Public Const SM_CYFRAME = 33
    Public Const SM_CYHSCROLL = 3
    Public Const SM_CYBORDER = 6
    Public Const SM_CXBORDER = 5
    Public Const SM_CYMENU = 15

' GDI object functions:
Public Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal
 lpDriverName As String, _
           lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
 hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal
 hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc
 As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As
 Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long,
 ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As
 Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
 hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
 As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As
 Long
Public Declare Function GetSysColorBrush Lib "USER32" (ByVal nIndex As Long) As
 Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal
 nWidth As Long, ByVal crColor As Long) As Long
Public Const PS_SOLID = 0
Public Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal
 hRgn As Long) As Long
Public Declare Function DrawEdge Lib "USER32" (ByVal hdc As Long, qrc As RECT,
 ByVal edge As Long, ByVal grfFlags As Long) As Boolean
Public Declare Function SetParent Lib "USER32" (ByVal hWndChild As Long, ByVal
 hWndNewParent As Long) As Long
Public Declare Function SetFocusAPI Lib "USER32" Alias "SetFocus" (ByVal hWnd
 As Long) As Long

Public Const BDR_RAISEDOUTER = &H1
Public Const BDR_SUNKENOUTER = &H2
Public Const BDR_RAISEDINNER = &H4
Public Const BDR_SUNKENINNER = &H8

Public Const BDR_OUTER = &H3
Public Const BDR_INNER = &HC
Public Const BDR_RAISED = &H5
Public Const BDR_SUNKEN = &HA

Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)

Public Const BF_LEFT = &H1
Public Const BF_TOP = &H2
Public Const BF_RIGHT = &H4
Public Const BF_BOTTOM = &H8

Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Public Const BF_DIAGONAL = &H10

' For diagonal lines, the BF_RECT flags specify the end point of
' the vector bounded by the rectangle parameter.
Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP _
             Or BF_RIGHT)
Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP _
             Or BF_LEFT)
Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM _
             Or BF_LEFT)
Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM _
             Or BF_RIGHT)

Public Const BF_MIDDLE = &H800    ' Fill in the middle.
Public Const BF_SOFT = &H1000     ' Use for softer buttons.
Public Const BF_ADJUST = &H2000   ' Calculate the space left over.
Public Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
Public Const BF_MONO = &H8000     ' For monochrome borders.

Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal
 crColor As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal
 crColor As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode
 As Long) As Long
    Public Const OPAQUE = 2
    Public Const TRANSPARENT = 1

Public Declare Function DrawText Lib "USER32" Alias "DrawTextA" (ByVal hdc As
 Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal
 wFormat As Long) As Long
    Public Const DT_LEFT = &H0&
    Public Const DT_TOP = &H0&
    Public Const DT_CENTER = &H1&
    Public Const DT_RIGHT = &H2&
    Public Const DT_VCENTER = &H4&
    Public Const DT_BOTTOM = &H8&
    Public Const DT_WORDBREAK = &H10&
    Public Const DT_SINGLELINE = &H20&
    Public Const DT_EXPANDTABS = &H40&
    Public Const DT_TABSTOP = &H80&
    Public Const DT_NOCLIP = &H100&
    Public Const DT_EXTERNALLEADING = &H200&
    Public Const DT_CALCRECT = &H400&
    Public Const DT_NOPREFIX = &H800
    Public Const DT_INTERNAL = &H1000&
    Public Const DT_WORD_ELLIPSIS = &H40000

' Rectangle functions:
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As
 Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function EqualRect Lib "USER32" (lpRect1 As RECT, lpRect2 As
 RECT) As Long
Public Declare Function InflateRect Lib "USER32" (lpRect As RECT, ByVal x As
 Long, ByVal y As Long) As Long
Public Declare Function OffsetRect Lib "USER32" (lpRect As RECT, ByVal x As
 Long, ByVal y As Long) As Long
Public Declare Function PtInRect Lib "USER32" (lpRect As RECT, ByVal ptX As
 Long, ByVal ptY As Long) As Long
Public Declare Function FillRect Lib "USER32" (ByVal hdc As Long, lpRect As
 RECT, ByVal hBrush As Long) As Long

' Corrected Draw State function declarations:
Private Declare Function DrawState Lib "USER32" Alias "DrawStateA" _
   (ByVal hdc As Long, _
   ByVal hBrush As Long, _
   ByVal lpDrawStateProc As Long, _
   ByVal lParam As Long, _
   ByVal wParam As Long, _
   ByVal x As Long, _
   ByVal y As Long, _
   ByVal cx As Long, _
   ByVal cy As Long, _
   ByVal fuFlags As Long) As Long
Private Declare Function DrawStateString Lib "USER32" Alias "DrawStateA" _
   (ByVal hdc As Long, _
   ByVal hBrush As Long, _
   ByVal lpDrawStateProc As Long, _
   ByVal lpString As String, _
   ByVal cbStringLen As Long, _
   ByVal x As Long, _
   ByVal y As Long, _
   ByVal cx As Long, _
   ByVal cy As Long, _
   ByVal fuFlags As Long) As Long

' Missing Draw State constants declarations:
'/* Image type */
Private Const DST_COMPLEX = &H0
Private Const DST_TEXT = &H1
Private Const DST_PREFIXTEXT = &H2
Private Const DST_ICON = &H3
Private Const DST_BITMAP = &H4

' /* State type */
Private Const DSS_NORMAL = &H0
Private Const DSS_UNION = &H10
Private Const DSS_DISABLED = &H20
Private Const DSS_MONO = &H80
Private Const DSS_RIGHT = &H8000

' Image List
Public Declare Function ImageList_GetImageCount Lib "COMCTL32.DLL" ( _
        ByVal hIml As Long _
    ) As Long
Public Declare Function ImageList_GetImageRect Lib "COMCTL32.DLL" ( _
        ByVal hIml As Long, _
        ByVal i As Long, _
        prcImage As RECT _
    ) As Long
Private Declare Function ImageList_GetIcon Lib "COMCTL32.DLL" ( _
        ByVal hIml As Long, _
        ByVal i As Long, _
        ByVal diIgnore As Long _
    ) As Long
' Draw an item in an ImageList:
Private Declare Function ImageList_Draw Lib "COMCTL32.DLL" ( _
        ByVal hIml As Long, _
        ByVal i As Long, _
        ByVal hdcDst As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal fStyle As Long _
    ) As Long
' Draw an item in an ImageList with more control over positioning
' and colour:
Private Declare Function ImageList_DrawEx Lib "COMCTL32.DLL" ( _
      ByVal hIml As Long, _
      ByVal i As Long, _
      ByVal hdcDst As Long, _
      ByVal x As Long, _
      ByVal y As Long, _
      ByVal dx As Long, _
      ByVal dy As Long, _
      ByVal rgbBk As Long, _
      ByVal rgbFg As Long, _
      ByVal fStyle As Long _
   ) As Long
' Built in ImageList drawing methods:
Private Const ILD_NORMAL = 0
Private Const ILD_TRANSPARENT = 1
Private Const ILD_BLEND25 = 2
Private Const ILD_SELECTED = 4
Private Const ILD_FOCUS = 4
Private Const ILD_OVERLAYMASK = 3840
' Use default rgb colour:
Public Const CLR_NONE = -1
Private Declare Function DestroyIcon Lib "USER32" (ByVal hIcon As Long) As Long
Public Declare Function ImageList_GetIconSize Lib "comctl32" (ByVal hImageList
 As Long, cx As Long, cy As Long) As Long

Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR
 As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

Public Declare Function SetLayeredWindowAttributes Lib "USER32" _
   (ByVal hWnd As Long, ByVal crKey As Long, _
   ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2


Private m_lID As Long

Public Sub IAddRef(ByRef oThis As Object)
Dim iUnk As IShellFolderEx_TLB.IUnknown
   Set iUnk = oThis
   iUnk.AddRef
End Sub
Public Sub IRelease(ByRef oThis As Object)
Dim iUnk As IShellFolderEx_TLB.IUnknown
   Set iUnk = oThis
   iUnk.Release
End Sub

Public Function gbValidOwner( _
      ByVal hWnd As Long, _
      ByRef ctl As vbalPicker _
   )
Dim lPtr As Long
   If Not (hWnd = 0) Then
      If IsWindow(hWnd) Then
         lPtr = GetProp(hWnd, MCVBALPickerProp)
         If Not (lPtr = 0) Then
            Set ctl = ObjectFromPtr(lPtr)
            gbValidOwner = True
            Exit Function
         End If
      End If
   End If
   gErr 2
End Function
Public Sub gInitialise(ByVal hWnd As Long, ByVal ctl As vbalPicker)
   SetProp hWnd, MCVBALPickerProp, ObjPtr(ctl)
End Sub
Public Sub gTerminate(ByVal hWnd As Long)
   RemoveProp hWnd, MCVBALPickerProp
End Sub

Public Property Get ObjectFromPtr(ByVal lPtr As Long) As Object
Dim objT As Object
   If Not (lPtr = 0) Then
      ' Turn the pointer into an illegal, uncounted interface
      CopyMemory objT, lPtr, 4
      ' Do NOT hit the End button here! You will crash!
      ' Assign to legal reference
      Set ObjectFromPtr = objT
      ' Still do NOT hit the End button here! You will still crash!
      ' Destroy the illegal reference
      CopyMemory objT, 0&, 4
   End If
End Property

Public Function gNewID() As Long
   If m_lID = 2147483647 Then
      m_lID = -2147483648#
   Else
      m_lID = m_lID + 1
   End If
   gNewID = m_lID
End Function

Public Sub gErr(ByVal lErr As Long)
Dim sDesc As String
Dim lErrNum As Long
Const lBase As Long = vbObjectError + 25260

   Select Case lErr
   Case 1
      ' Cannot find owner object
      lErrNum = 364
      sDesc = "Object has been unloaded."
   Case 2
      ' Bar does not exist
      lErrNum = lBase + lErr
      sDesc = "Owning Picker Control does not exist."
      
   Case 3
      ' Item does not exist
      lErrNum = lBase + lErr
      sDesc = "Pick Item does not exist."
      
   Case 4
      ' Invalid key: numeric
      lErrNum = 13
      sDesc = "Type Mismatch."
      
   Case 5
      ' Invalid Key: duplicate
      lErrNum = 457
      sDesc = "This key is already associated with an element of this
       collection."
   
   Case 6
      ' Subscript out of range
      lErrNum = 9
      sDesc = "Subscript out of range."
   
   Case 7
      lErrNum = lBase + lErr
      sDesc = "Failed to add the item"
   
   Case Else
      Debug.Assert "Unexpected Error" = ""
      lErrNum = lErr + vbObjectError
   End Select
   
   
   Err.Raise lErrNum, App.EXEName & ".vbalPicker", sDesc
   
End Sub
Public Sub TileArea( _
        ByVal hdc As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal Width As Long, _
        ByVal Height As Long, _
        ByVal lSrcDC As Long, _
        ByVal lBitmapW As Long, _
        ByVal lBitmapH As Long, _
        ByVal lSrcOffsetX As Long, _
        ByVal lSrcOffsetY As Long _
    )
Dim lSrcX As Long
Dim lSrcY As Long
Dim lSrcStartX As Long
Dim lSrcStartY As Long
Dim lSrcStartWidth As Long
Dim lSrcStartHeight As Long
Dim lDstX As Long
Dim lDstY As Long
Dim lDstWidth As Long
Dim lDstHeight As Long

    lSrcStartX = ((x + lSrcOffsetX) Mod lBitmapW)
    lSrcStartY = ((y + lSrcOffsetY) Mod lBitmapH)
    lSrcStartWidth = (lBitmapW - lSrcStartX)
    lSrcStartHeight = (lBitmapH - lSrcStartY)
    lSrcX = lSrcStartX
    lSrcY = lSrcStartY
    
    lDstY = y
    lDstHeight = lSrcStartHeight
    
    Do While lDstY < (y + Height)
        If (lDstY + lDstHeight) > (y + Height) Then
            lDstHeight = y + Height - lDstY
        End If
        lDstWidth = lSrcStartWidth
        lDstX = x
        lSrcX = lSrcStartX
        Do While lDstX < (x + Width)
            If (lDstX + lDstWidth) > (x + Width) Then
                lDstWidth = x + Width - lDstX
                If (lDstWidth = 0) Then
                    lDstWidth = 4
                End If
            End If
            'If (lDstWidth > Width) Then lDstWidth = Width
            'If (lDstHeight > Height) Then lDstHeight = Height
            BitBlt hdc, lDstX, lDstY, lDstWidth, lDstHeight, lSrcDC, lSrcX,
             lSrcY, vbSrcCopy
            lDstX = lDstX + lDstWidth
            lSrcX = 0
            lDstWidth = lBitmapW
        Loop
        lDstY = lDstY + lDstHeight
        lSrcY = 0
        lDstHeight = lBitmapH
    Loop
End Sub


Public Sub DrawImage( _
      ByVal hIml As Long, _
      ByVal iIndex As Long, _
      ByVal hdc As Long, _
      ByVal xPixels As Integer, _
      ByVal yPixels As Integer, _
      ByVal lIconSizeX As Long, ByVal lIconSizeY As Long, _
      Optional ByVal bSelected = False, _
      Optional ByVal bCut = False, _
      Optional ByVal bDisabled = False, _
      Optional ByVal oCutDitherColour As OLE_COLOR = vbWindowBackground, _
      Optional ByVal hExternalIml As Long = 0 _
    )
Dim hIcon As Long
Dim lFlags As Long
Dim lhIml As Long
Dim lColor As Long
Dim iImgIndex As Long

   ' Draw the image at 1 based index or key supplied in vKey.
   ' on the hDC at xPixels,yPixels with the supplied options.
   ' You can even draw an ImageList from another ImageList control
   ' if you supply the handle to hExternalIml with this function.
   
   iImgIndex = iIndex
   If (iImgIndex > -1) Then
      If (hExternalIml <> 0) Then
          lhIml = hExternalIml
      Else
          lhIml = hIml
      End If
      
      lFlags = ILD_TRANSPARENT
      If (bSelected) Or (bCut) Then
          lFlags = lFlags Or ILD_SELECTED
      End If
      
      If (bCut) Then
        ' Draw dithered:
        lColor = TranslateColor(oCutDitherColour)
        If (lColor = -1) Then lColor = TranslateColor(vbWindowBackground)
        ImageList_DrawEx _
              lhIml, _
              iImgIndex, _
              hdc, _
              xPixels, yPixels, 0, 0, _
              CLR_NONE, lColor, _
              lFlags
      ElseIf (bDisabled) Then
        ' extract a copy of the icon:
        hIcon = ImageList_GetIcon(hIml, iImgIndex, 0)
        ' Draw it disabled at x,y:
        DrawState hdc, 0, 0, hIcon, 0, xPixels, yPixels, lIconSizeX,
         lIconSizeY, DST_ICON Or DSS_DISABLED
        ' Clear up the icon:
        DestroyIcon hIcon
              
      Else
        ' Standard draw:
        ImageList_Draw _
            lhIml, _
            iImgIndex, _
            hdc, _
            xPixels, _
            yPixels, _
            lFlags
      End If
   End If
End Sub


Public Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    ' Convert Automation color to Windows color
    If OleTranslateColor(oClr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function


Public Property Get LighterBrush(ByVal oClr As OLE_COLOR) As Long
   ' TODO:
   LighterBrush = GetSysColorBrush(vb3DHighlight And &H1F&)
End Property
Public Sub DrawRect(ByVal hdc As Long, ByRef tR As RECT, ByVal oClr As
 OLE_COLOR)
Dim hPen As Long
Dim hPenOld As Long
   hPen = CreatePen(PS_SOLID, 1, TranslateColor(oClr))
   hPenOld = SelectObject(hdc, hPen)
   Rectangle hdc, tR.Left, tR.Top, tR.Right, tR.Bottom
   SelectObject hdc, hPenOld
   DeleteObject hPen
End Sub