VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cWidget"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Const HOVERTIME         As Long = 1000
Private Const SPI_GETWORKAREA   As Long = 48
Private Const HTCAPTION         As Long = 2
Private Const WM_NCLBUTTONDOWN  As Long = &HA1
Private Const SND_ASYNC         As Long = &H1
Private Const SND_MEMORY        As Long = &H4

Public Enum eClip
    eC_None = &H0
    eC_Desktop = &H1
    eC_Screen = &H2
End Enum

Private Type POINTAPI
    x                           As Long
    y                           As Long
End Type

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

Private Type tRegion
    lRegion                     As Long
    vData                       As Variant
    ToolTipText                 As String
End Type



Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function MoveWindow Lib "user32" (ByVal Hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal Hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function PtInRegion Lib "gdi32.dll" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Event MouseEnter(ByVal lX As Long, ByVal lY As Long, ByVal lRegion As Long, ByVal vData As Variant)
Public Event MouseLeave(ByVal lRegion As Long, ByVal vData As Variant)
Public Event MouseDown(ByVal Button As MouseButtonConstants, ByVal lX As Long, ByVal lY As Long, ByVal lRegion As Long, ByVal vData As Variant)
Public Event MouseUp(ByVal Button As MouseButtonConstants, ByVal lX As Long, ByVal lY As Long, ByVal lRegion As Long, ByVal vData As Variant)
Public Event MouseDblClick(ByVal Button As MouseButtonConstants, ByVal lX As Long, ByVal lY As Long, ByVal lRegion As Long, ByVal vData As Variant)
Public Event MouseClick(ByVal Button As MouseButtonConstants, ByVal lX As Long, ByVal lY As Long, ByVal lRegion As Long, ByVal vData As Variant)
Public Event ToolBarButtonClick(Index As Integer)


Implements iSubclass

Public CtrlClient               As cCtrlClient
Public SkinClient               As cSkinClient
Public WithEvents ToolBar       As cToolBar
Attribute ToolBar.VB_VarHelpID = -1
Private c_cToolTip              As cToolTip
Private cSubclass               As cSubclass
Private c_eClipMode             As eClip
Private c_cObjects              As Collection
Private c_tRegions()            As tRegion
Private WithEvents cTimer       As cTimer
Attribute cTimer.VB_VarHelpID = -1
Private WithEvents cTimerH      As cTimer
Attribute cTimerH.VB_VarHelpID = -1

Private m_UseToolBar                    As Boolean
'Private c_lhWnd                 As Long
Private c_bLayeredSupport       As Boolean

Private c_bIn                   As Boolean
Private c_bLockInPlace          As Boolean

Private c_lActiveRgn            As Long
Private c_lIndex                As Long

'Public Property Let UseToolBar(Roon As Boolean)
'    m_UseToolBar = Roon
'    If Roon = False Then ToolBar.Hide
'End Property

'Public Property Get UseToolBar() As Boolean
'    UseToolBar = m_UseToolBar
'End Property

Public Function CreateToolBar()
If ToolBar Is Nothing Then
    Set ToolBar = New cToolBar
    ToolBar.ClientHwnd = SkinClient.Hwnd
     m_UseToolBar = True
End If
End Function

Public Function DestroyToolBar()
If Not ToolBar Is Nothing Then
    Set ToolBar = Nothing
    m_UseToolBar = False
End If
End Function


Public Property Let ClipMode(ByVal eMode As eClip)
    c_eClipMode = eMode
End Property

Public Property Get ClipMode() As eClip
    ClipMode = c_eClipMode
End Property

Public Function PlaySound(ByVal Sound As cSound) As Boolean
    If IsArrayDim(VarPtrArray(Sound.GetBytes)) Then
        Dim bvData() As Byte
        bvData = Sound.GetBytes
        Call sndPlaySound(bvData(0), SND_ASYNC Or SND_MEMORY)
        PlaySound = True
    End If
End Function

Public Sub DragMe()
    Call ReleaseCapture
    Call SendMessage(SkinClient.Hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    If m_UseToolBar Then ToolBar.Show
End Sub

'Public Function AddRegion(ByVal lRegion As Long, ByVal vData As Variant) As Long
'    Dim lIndex As Long
'
'    If IsArrayDim(VarPtrArray(c_tRegions)) Then
'        lIndex = UBound(c_tRegions) + 1
'        ReDim Preserve c_tRegions(lIndex)
'    Else
'        ReDim c_tRegions(0)
'    End If
'
'    With c_tRegions(lIndex)
'        .lRegion = lRegion
'        .vData = vData
'    End With
'    AddRegion = lIndex
'
'End Function

Public Function AddRegion(ByVal lRegion As Long, ByVal vData As Variant, Optional ToolTipText As String)
    Dim lIndex As Long
    
    lIndex = UBound(c_tRegions) + 1
    ReDim Preserve c_tRegions(lIndex)
    With c_tRegions(lIndex)
        .lRegion = lRegion
        .vData = vData
        .ToolTipText = ToolTipText
    End With
    
End Function





Public Function SetRegion(ByVal Index As Long, ByVal NewRegion As Long)
    DeleteObject c_tRegions(Index).lRegion
    c_tRegions(Index).lRegion = NewRegion
End Function

Public Function RegionCount() As Integer
    RegionCount = UBound(c_tRegions)
End Function


Public Function SetRgnToolTipText(ByVal Index As Long, Text As String)
    c_tRegions(Index).ToolTipText = Text
End Function




Private Sub Class_Initialize()
    Set CtrlClient = New cCtrlClient
    Set SkinClient = New cSkinClient
    Set c_cToolTip = New cToolTip
    'Set ToolBar = New cToolBar
    Set c_cObjects = New Collection
    Set cTimer = New cTimer
    ReDim c_tRegions(0)
    c_lIndex = -1
End Sub

Private Sub Class_Terminate()
    Set CtrlClient = Nothing
    Set SkinClient = Nothing
    Set cSubclass = Nothing
    Set cTimer = Nothing
    Set cTimerH = Nothing
    Set ToolBar = Nothing
    Set c_cToolTip = Nothing
    Dim i As Long
    
    If IsArrayDim(VarPtrArray(c_tRegions)) Then
        For i = 0 To UBound(c_tRegions)
            Call DeleteObject(c_tRegions(i).lRegion)
        Next
    End If
End Sub

Public Function Initialize()
    Dim TR  As RECT
    
    Set cSubclass = New cSubclass

    If Not SkinClient.Hwnd = 0 Then
        cSubclass.Subclass SkinClient.Hwnd, Me
        cSubclass.AddMsg WM_MOVING, MSG_BEFORE
        cSubclass.AddMsg WM_EXITSIZEMOVE, MSG_BEFORE
        cSubclass.AddMsg WM_MOUSEMOVE, MSG_BEFORE
        cSubclass.AddMsg WM_LBUTTONDBLCLK, MSG_BEFORE
        cSubclass.AddMsg WM_LBUTTONDOWN, MSG_BEFORE
        cSubclass.AddMsg WM_LBUTTONUP, MSG_BEFORE
        cSubclass.AddMsg WM_MBUTTONDBLCLK, MSG_BEFORE
        cSubclass.AddMsg WM_MBUTTONDOWN, MSG_BEFORE
        cSubclass.AddMsg WM_MBUTTONUP, MSG_BEFORE
        cSubclass.AddMsg WM_RBUTTONDBLCLK, MSG_BEFORE
        cSubclass.AddMsg WM_RBUTTONDOWN, MSG_BEFORE
        cSubclass.AddMsg WM_RBUTTONUP, MSG_BEFORE
        cSubclass.AddMsg WM_CLOSE, MSG_BEFORE
        cSubclass.AddMsg WM_DESTROY, MSG_BEFORE
        
        If Not CtrlClient.Hwnd = 0 Then
            Call GetWindowRect(SkinClient.Hwnd, TR)
            Call MoveWindow(CtrlClient.Hwnd, TR.Left, TR.Top, TR.Right - TR.Left, TR.Bottom - TR.Top, 1)
        End If
    End If
    'ToolBar.ClientHwnd = SkinClient.Hwnd
End Function

Private Function IsArrayDim(ByVal lpArray As Long) As Boolean
    Dim lAddress As Long
    
    Call CopyMemory(lAddress, ByVal lpArray, &H4)
    IsArrayDim = Not (lAddress = 0)
End Function

Private Sub cTimer_PulseTimer()
    Dim PT As POINTAPI

    Call GetCursorPos(PT)
    Call ScreenToClient(SkinClient.Hwnd, PT)
    'Debug.Print PtInRegion(SkinClient.Rgn, Pt.X, Pt.Y), SkinClient.Rgn
    
    'Call GetCursorPos(Pt)
    If PtInRegion(SkinClient.Rgn, PT.x, PT.y) = 0 Then
        c_bIn = False
        cTimer.StopTimer
        RaiseEvent MouseLeave(0, "MAIN")
        If Not c_lActiveRgn = 0 Then
            c_cToolTip.Hide
            RaiseEvent MouseLeave(c_lActiveRgn, c_tRegions(c_lActiveRgn).vData)
            c_lActiveRgn = 0
        End If
    End If
End Sub

Private Sub iSubclass_Proc(ByVal bBefore As Boolean, bHandled As Boolean, lReturn As Long, Hwnd As Long, uMsg As WinSubHook2.eMsg, wParam As Long, lParam As Long)
    Dim TR  As RECT:    Dim wTR As RECT
    Dim lW As Long:     Dim lH As Long
    
    Dim PT As POINTAPI
    Dim i As Long

    Dim lIndex As Long
    Dim vData As Variant
    
    Call GetCursorPos(PT)
    Call ScreenToClient(Hwnd, PT)

    Select Case uMsg
        Case WM_MOVING
        
            If m_UseToolBar Then ToolBar.Hide
            
            Call CopyMemory(TR, ByVal lParam, Len(TR))
            If Not c_eClipMode = eC_None Then

                If c_eClipMode = eC_Desktop Then
                    Call SystemParametersInfo(SPI_GETWORKAREA, ByVal 0&, wTR, ByVal 0&)
                Else
                    Call GetWindowRect(GetDesktopWindow, wTR)
                End If

                lW = TR.Right - TR.Left: lH = TR.Bottom - TR.Top

                If TR.Left < wTR.Left Then
                    TR.Left = wTR.Left: TR.Right = TR.Left + lW
                End If

                If TR.Top < wTR.Top Then
                    TR.Top = wTR.Top: TR.Bottom = TR.Top + lH
                End If

                If TR.Right > wTR.Right Then
                    TR.Right = wTR.Right: TR.Left = TR.Right - lW
                End If

                If TR.Bottom > wTR.Bottom Then
                    TR.Bottom = wTR.Bottom: TR.Top = TR.Bottom - lH
                End If

                Call CopyMemory(ByVal lParam, TR, Len(TR))
            End If
            If Not CtrlClient.Hwnd = 0 Then
                Call MoveWindow(CtrlClient.Hwnd, TR.Left, TR.Top, TR.Right - TR.Left, TR.Bottom - TR.Top, 1)
            End If
            
        '**********************************************************************************************************************
        
        
        Case WM_MOUSEMOVE
        
            If Not c_bIn Then
                c_bIn = True
                cTimer.StartTimer Hwnd, 10
                RaiseEvent MouseEnter(PT.x, PT.y, 0, "MAIN")
                If m_UseToolBar Then ToolBar.Show
                c_cToolTip.Hide
            End If
        
            If Not c_lActiveRgn = 0 Then
                c_cToolTip.ResetCounterHide
                If PtInRegion(c_tRegions(c_lActiveRgn).lRegion, PT.x, PT.y) = 0 Then
                    RaiseEvent MouseLeave(c_lActiveRgn, c_tRegions(c_lActiveRgn).vData)
                    
                    c_cToolTip.Hide
                    c_lActiveRgn = 0
                    
                End If
                
            Else
            
                For i = 1 To UBound(c_tRegions)
                    
                    If Not PtInRegion(c_tRegions(i).lRegion, PT.x, PT.y) = 0 Then
                        If c_tRegions(i).ToolTipText <> "" Then c_cToolTip.Show (c_tRegions(i).ToolTipText)
                        c_lActiveRgn = i
                        RaiseEvent MouseEnter(PT.x, PT.y, i, c_tRegions(i).vData)
                        Exit For
                    End If
                    
                Next
            End If

        Case WM_LBUTTONDBLCLK
            c_cToolTip.Hide
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            RaiseEvent MouseDblClick(vbLeftButton, PT.x, PT.y, lIndex, vData)
            
        Case WM_LBUTTONDOWN
            c_cToolTip.Hide
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            c_lIndex = lIndex
            RaiseEvent MouseDown(vbLeftButton, PT.x, PT.y, lIndex, vData)
            
        Case WM_LBUTTONUP
            c_cToolTip.Hide
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            If c_lIndex = lIndex Then
                RaiseEvent MouseClick(vbLeftButton, PT.x, PT.y, lIndex, vData)
            End If
            RaiseEvent MouseUp(vbLeftButton, PT.x, PT.y, lIndex, vData)
            c_lIndex = -1
            
        Case WM_MBUTTONDBLCLK
            c_cToolTip.Hide
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            RaiseEvent MouseDblClick(vbMiddleButton, PT.x, PT.y, lIndex, vData)
            
        Case WM_MBUTTONDOWN
            c_cToolTip.Hide
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            c_lIndex = lIndex
            RaiseEvent MouseDown(vbMiddleButton, PT.x, PT.y, lIndex, vData)
            
        Case WM_MBUTTONUP
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            If c_lIndex = lIndex Then
                RaiseEvent MouseClick(vbMiddleButton, PT.x, PT.y, lIndex, vData)
            End If
            RaiseEvent MouseUp(vbMiddleButton, PT.x, PT.y, lIndex, vData)
            c_lIndex = -1
        Case WM_RBUTTONDBLCLK
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            RaiseEvent MouseDblClick(vbRightButton, PT.x, PT.y, lIndex, vData)
            c_cToolTip.Hide
        Case WM_RBUTTONDOWN
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            c_lIndex = lIndex
            RaiseEvent MouseDown(vbRightButton, PT.x, PT.y, lIndex, vData)
            c_cToolTip.Hide
        Case WM_RBUTTONUP
            Call pHitTest(PT.x, PT.y, lIndex, vData)
            If c_lIndex = lIndex Then
                RaiseEvent MouseClick(vbRightButton, PT.x, PT.y, lIndex, vData)
            End If
            RaiseEvent MouseUp(vbRightButton, PT.x, PT.y, lIndex, vData)
            c_lIndex = -1
        Case WM_CLOSE, WM_DESTROY
            'Call GetWindowRect(c_lhWnd, TR)
            'Call WriteData("WIDGET", "POSX", TR.Left)
            'Call WriteData("WIDGET", "POSY", TR.Top)
            c_cToolTip.Hide
    End Select
        
        
        
    
End Sub

Private Sub pHitTest(ByVal lX As Long, ByVal lY As Long, ByRef lRegion As Long, ByRef vData As Variant)
    Dim i As Long
    For i = 1 To UBound(c_tRegions)
        If Not PtInRegion(c_tRegions(i).lRegion, lX, lY) = 0 Then
            lRegion = i
            vData = c_tRegions(i).vData
            Exit Sub
        End If
    Next
    lRegion = 0:    vData = "MAIN"
End Sub


Private Sub Toolbar_Click(Index As Integer)
    RaiseEvent ToolBarButtonClick(Index)
End Sub

