VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSizeGripLR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Copyright © 2014 Dexter Freivald. All Rights Reserved. DEXWERX.COM
'
' CSizeGripLR.cls
'
' Implements a themed (uxtheme.dll) size grip.
'   - Uses DrawFrameControl when theming not enabled.
'   - Supports Bottom Left Orientation
'

Option Explicit

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

Private Type SIZE
    cx As Long
    cy As Long
End Type

Private Enum THEMESIZE
    TS_MIN
    TS_TRUE
    TS_DRAW
End Enum

Private Const S_OK As Long = 0
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const HTBOTTOMLEFT As Long = 16
Private Const HTBOTTOMRIGHT As Long = 17
Private Const SM_CXVSCROLL As Long = 2
Private Const SM_CYHSCROLL As Long = 3
Private Const DFC_SCROLL As Long = 3
Private Const DFCS_SCROLLSIZEGRIP As Long = &H8
Private Const DFCS_SCROLLSIZEGRIPRIGHT As Long = &H10
Private Const SPB_CLASS As String = "Scrollbar"
Private Const SPB_SIZEBOX As Long = 10
Private Const SZB_RIGHTALIGN As Long = 1
Private Const SZB_LEFTALIGN As Long = 2

Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, ByRef lprc As RECT, ByVal uType As Long, ByVal uState As Long) As Long
Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
Private Declare Function GetThemePartSize Lib "uxtheme" (ByVal hTheme As Long, ByVal hdc As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal prc As Long, ByVal eSize As THEMESIZE, psz As SIZE) As Long
Private Declare Function DrawThemeBackground Lib "uxtheme" (ByVal hTheme As Long, ByVal hdc As Long, ByVal iPartId As Long, ByVal iStateId As Long, pRect As RECT, pClipRect As RECT) As Long

Public Enum EGripOrientation
    gripBottomRight
    gripBottomLeft
End Enum

Private WithEvents m_Parent As Form
Attribute m_Parent.VB_VarHelpID = -1
Private WithEvents m_Grip As Label
Attribute m_Grip.VB_VarHelpID = -1
Private m_Orientation As EGripOrientation
'

Public Property Let Orientation(Value As EGripOrientation)
    m_Orientation = Value
    If Not m_Grip Is Nothing Then
        m_Grip.MousePointer = IIf(m_Orientation, vbSizeNESW, vbSizeNWSE)
        m_Grip.Move IIf(m_Orientation, 0, m_Parent.ScaleWidth - m_Grip.Width), m_Parent.ScaleHeight - m_Grip.Height
    End If
End Property

Public Property Get Orientation() As EGripOrientation
    Orientation = m_Orientation
End Property

Public Sub Attach(Parent As Form, Optional GripOrientation As EGripOrientation = gripBottomRight)
    Dim ThemeHandle As Long
    Dim GripSize As SIZE

    m_Orientation = GripOrientation

    Set m_Parent = Parent
    m_Parent.ScaleMode = vbPixels

    Set m_Grip = m_Parent.Controls.Add("VB.Label", "lblSizeGrip" & m_Parent.Controls.Count)
    With m_Grip
        .Caption = vbNullString
        .BackStyle = vbTransparent
        .Width = GetSystemMetrics(SM_CXVSCROLL)
        .Height = GetSystemMetrics(SM_CYHSCROLL)
        .MousePointer = IIf(m_Orientation, vbSizeNESW, vbSizeNWSE)
        .Visible = True
    End With

    ThemeHandle = OpenThemeData(m_Parent.hWnd, StrPtr(SPB_CLASS))
    If ThemeHandle Then
        If GetThemePartSize(ThemeHandle, m_Parent.hdc, SPB_SIZEBOX, _
            IIf(m_Orientation, SZB_LEFTALIGN, SZB_RIGHTALIGN), 0&, TS_DRAW, GripSize) = S_OK Then
            
            m_Grip.Width = GripSize.cx
            m_Grip.Height = GripSize.cy
        End If
        CloseThemeData ThemeHandle
    End If
End Sub

Private Sub Class_Terminate()
    Set m_Parent = Nothing
    Set m_Grip = Nothing
End Sub

Private Sub m_Grip_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessageA m_Parent.hWnd, WM_NCLBUTTONDOWN, IIf(m_Orientation, HTBOTTOMLEFT, HTBOTTOMRIGHT), 0&
End Sub

Private Sub m_Parent_Paint()
    Dim ThemeHandle As Long
    Dim ClipRect As RECT

    If Not m_Orientation Then ClipRect.Left = m_Grip.Left
    ClipRect.Top = m_Grip.Top
    ClipRect.Right = m_Grip.Left + m_Grip.Width
    ClipRect.Bottom = m_Grip.Top + m_Grip.Height

    ThemeHandle = OpenThemeData(m_Parent.hWnd, StrPtr(SPB_CLASS))
    If ThemeHandle Then
        DrawThemeBackground ThemeHandle, m_Parent.hdc, SPB_SIZEBOX, _
            IIf(m_Orientation, SZB_LEFTALIGN, SZB_RIGHTALIGN), ClipRect, ClipRect
        CloseThemeData ThemeHandle
    Else
        DrawFrameControl m_Parent.hdc, ClipRect, DFC_SCROLL, _
            IIf(m_Orientation, DFCS_SCROLLSIZEGRIPRIGHT, DFCS_SCROLLSIZEGRIP)
    End If
End Sub

Private Sub m_Parent_Resize()
    m_Grip.Move IIf(m_Orientation, 0, m_Parent.ScaleWidth - m_Grip.Width), m_Parent.ScaleHeight - m_Grip.Height
End Sub