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

Private Const ULW_ALPHA         As Long = &H2

Private Const AC_SRC_ALPHA      As Long = &H1
Private Const AC_SRC_OVER       As Long = &H0

Private Const HIDETIME          As Long = 2

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

Private Type POINTAPI
    x                           As Long
    y                           As Long
End Type

Private Type Size
    cX                          As Long
    cY                          As Long
End Type

Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal Hwnd As Long, ByVal hdcDst As Long, ByRef pptDst As Any, ByRef psize As Any, ByVal hdcSrc As Long, ByRef pptSrc As Any, ByVal crKey As Long, ByRef pblend As Long, ByVal dwFlags As Long) 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 GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As RECT) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function CreateEllipticRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal Hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const IDC_HAND As Long = 32649
Private Const IDC_ARROW As Long = 32512&

Implements iWindow

Private c_cWindow               As cWindow
Private c_lhWnd                 As Long
Private c_lOpacity              As Long
Private c_lLeft                 As Long
Private c_lTop                  As Long
Private c_lWidth                As Long
Private c_lHeight               As Long
'Private c_Interface             As IToolBar
Private WithEvents c_cTimer     As cTimer
Attribute c_cTimer.VB_VarHelpID = -1
Private c_Back                  As c32bppDIB
Private c_BtnMnu                As c32bppDIB
Private c_BtnClose              As c32bppDIB
Private m_lStartTime            As Long
Private m_ClientHwnd              As Long

Dim RGN1 As Long
Dim RGN2 As Long
Dim h_ARROW As Long
Dim h_HAND As Long
Dim BtnId As Integer

Public Event Click(Index As Integer)


'Public Function SetInterface(ByVal Interface As IToolBar)
'    Set c_Interface = Interface
'    c_cWindow.AddMsg -1
'End Function

Public Property Let ClientHwnd(Handle As Long)
    m_ClientHwnd = Handle
End Property

Public Property Get ClientHwnd() As Long
    ClientHwnd = m_ClientHwnd
End Property


Public Property Let Left(lLeft As Long)
    c_lLeft = lLeft
    Call MoveToWindow
End Property

Public Property Get Left() As Long
    Left = c_lLeft
End Property

Public Property Let Top(lTop As Long)
    c_lTop = lTop
    Call MoveToWindow
End Property

Public Property Get Top() As Long
    Top = c_lTop
End Property

Public Property Let Opacity(ByVal lOpacity As Long)
    If lOpacity > 100 Then lOpacity = 100
    If lOpacity < 0 Then lOpacity = 0
    c_lOpacity = (255 * lOpacity) \ 100
End Property

Public Property Get Opacity() As Long
    Opacity = c_lOpacity
End Property

Private Sub c_cTimer_PulseTimer()
    Dim PT As POINTAPI
    Dim TR As RECT
    Dim Hwnd As Long
    
    If m_lStartTime = 0 Then m_lStartTime = Timer
        
    Call GetWindowRect(m_ClientHwnd, TR)
    Call GetCursorPos(PT)
    Hwnd = WindowFromPoint(PT.x, PT.y)
    
    If Hwnd = c_lhWnd Then
        m_lStartTime = Timer
    End If
    If Not PtInRect(TR, PT.x, PT.y) = 0 Then
        m_lStartTime = Timer
    End If
    
    If m_lStartTime + HIDETIME < Timer Then
        Call Hide
    End If
End Sub

Private Sub Class_Initialize()
    c_lOpacity = 255
    Set c_cTimer = New cTimer
    Set c_cWindow = New cWindow
    Set c_Back = New c32bppDIB
    Set c_BtnMnu = New c32bppDIB
    Set c_BtnClose = New c32bppDIB
    
    Dim XLeft As Long
    Dim YTop As Long
    
    c_Back.LoadPicture_File App.Path & "\BackToolBar.png"
    c_BtnMnu.LoadPicture_File App.Path & "\Menu_hov.png"
    c_BtnClose.LoadPicture_File App.Path & "\closed_hov.png"
    
    h_ARROW = LoadCursor(ByVal 0&, IDC_ARROW)
    h_HAND = LoadCursor(ByVal 0&, IDC_HAND)
    
    
    With c_cWindow
        Set .Owner = Me
        .WindowClassRegister "CWL_ToolBar" & ObjPtr(Me)
        c_lhWnd = .WindowCreate(WS_EX_TOOLWINDOW Or WS_EX_LAYERED, WS_POPUP, , , , 100, 100)
        
        .AddMsg WM_LBUTTONUP
        .AddMsg WM_MOUSEMOVE
    End With
    
    'Button Menu
    XLeft = (c_Back.Width / 4) - (c_BtnMnu.Width / 2)
    YTop = (c_Back.Height / 2) - (c_BtnMnu.Height / 2)
    c_BtnMnu.Render c_Back.LoadDIBinDC(True), XLeft, YTop
    RGN1 = c_BtnMnu.CreateRegion(regionShaped, XLeft, YTop)
    
    'Button Close
    XLeft = (c_Back.Width - (c_Back.Width / 4)) - (c_BtnClose.Width / 2)
    YTop = (c_Back.Height / 2) - (c_BtnClose.Height / 2)
    c_BtnClose.Render c_Back.LoadDIBinDC(True), XLeft, YTop
    RGN2 = c_BtnClose.CreateRegion(regionShaped, XLeft, YTop)
    
    Me.Render c_Back
    
    
End Sub

Private Sub Class_Terminate()
    c_cWindow.WindowDestroy c_lhWnd
    Set c_cWindow = Nothing
    Set c_cTimer = Nothing
    Set c_Back = Nothing
    Set c_BtnMnu = Nothing
    Set c_BtnClose = Nothing
    
    DeleteObject RGN1
    DeleteObject RGN2
    DestroyCursor h_ARROW
    DestroyCursor h_HAND
End Sub

Public Function Render(ByVal cDib As c32bppDIB)
    Dim srcPt As POINTAPI
    Dim srcSize As Size
    Dim lBlendFunc As Long

    srcSize.cX = cDib.Width
    srcSize.cY = cDib.Height
    c_lWidth = cDib.Width
    c_lHeight = cDib.Height
    
    lBlendFunc = AC_SRC_OVER Or (c_lOpacity * &H10000) _
       Or (AC_SRC_ALPHA * &H1000000)

    Call UpdateLayeredWindow(c_lhWnd, 0&, ByVal 0&, srcSize, _
       cDib.LoadDIBinDC(True), srcPt, 0&, lBlendFunc, ULW_ALPHA)
End Function

Public Function Show()
    Call MoveToWindow
    Call ShowWindow(c_lhWnd, SW_SHOW)
    c_cTimer.StartTimer c_lhWnd, 50
    
End Function


Private Sub MoveToWindow()
    Dim TR As RECT
   
    Call GetWindowRect(m_ClientHwnd, TR)
    Call MoveWindow(c_lhWnd, TR.Left + c_lLeft, TR.Top + c_lTop, c_lWidth, c_lHeight, 0)
End Sub


Public Function Hide()
    Call c_cTimer.StopTimer
    m_lStartTime = 0
    Call ShowWindow(c_lhWnd, SW_HIDE)
End Function

Private Sub iWindow_Proc(bHandled As Boolean, lReturn As Long, Hwnd As Long, uMsg As WinSubHook2.eMsg, wParam As Long, lParam As Long)
Dim TR As RECT
Dim PT As POINTAPI

    If uMsg = WM_MOUSEMOVE Then
        Call GetCursorPos(PT)
        Call ScreenToClient(Hwnd, PT)
        
        
        If PtInRegion(RGN1, PT.x, PT.y) Then
            SetCursor h_HAND
            BtnId = 1
        Else
            If PtInRegion(RGN2, PT.x, PT.y) Then
                SetCursor h_HAND
                BtnId = 2
            Else
                SetCursor h_ARROW
                BtnId = 0
            End If
        End If
    End If
        
    If uMsg = WM_LBUTTONUP Then
        If BtnId > 0 Then RaiseEvent Click(BtnId)
    End If

    'If Not c_Interface Is Nothing Then
        'c_Interface.Proc bHandled, lReturn, hwnd, uMsg, wParam, lParam
    'End If
End Sub
