VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'This code researched and developed by Dave Andrews
'Check out my website:- http://www.audiokingdom.com  (independent music network)
'I know you probably don't care, but I thought I'de put a plug in for my company :)

'Feel free to use this wherever you want,
'I would just appreciate and credit / mention in your code
'-----------------------------------------------------------
Const COLOR_CAPTIONTEXT = 9
Const DT_CENTER = &H1      'centre left to right
Const DT_VCENTER = &H4     'centre top to bottom
Const DT_NOCLIP = &H100    'fast draw
Const DT_SINGLELINE = &H20 'single line only

Const DT_FLAGS = DT_SINGLELINE Or DT_CENTER Or DT_VCENTER Or DT_NOCLIP

Private parentPic As PictureBox
Private pWidth As Long
Private pHeight As Long
Private pHwnd As Long

Private UpDC As Long 'returns the address for the up image
Private UpMemPal As Long
Private UpPal As Long
Private UpMemBitmap As Long
Private UpBitmap As Long
Private UpParent As Long
Private UpWidth As Long
Private UpHeight As Long
Private UpColor As Long
Private UpMemoryFont As Long
Private UpOrginalFont As Long

Private DownDC As Long 'Returns the address for the down image
Private DownMemPal As Long
Private DownPal As Long
Private DownMemBitmap As Long
Private DownBitmap As Long
Private DownParent As Long
Private DownWidth As Long
Private DownHeight As Long
Private DownColor As Long
Private DownMemoryFont As Long
Private DownOrginalFont As Long

'----------Hook stuff----------------
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Const GWL_WNDPROC = (-4)
Const WM_MBUTTONDOWN = &H207
Const WM_MBUTTONUP = &H208

Private gOldProc As Long

'--------HSL CONVERSION STUFF FOR BLENDING PIXELS-----------
'HSL conversion routines taken from Dan Redding's "Color Lab"
'Originally converted from the Microsoft Knowledge Base

Private Const HSLMAX As Integer = 240 '***
Const RGBMAX As Integer = 255 '***
Const UNDEFINED As Integer = (HSLMAX * 2 / 3) '***
Private Type HSLCol
    Hue As Integer
    Sat As Integer
    Lum As Integer
End Type
'-----------------------API DECLARATIONS-----------------------------------

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal color As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private 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
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long


'---------------TAKEN DIRECTLY FROM TONY'S CODE FOR A VIRTUAL DC-------
Option Explicit
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const LF_FACESIZE As Long = 32
Private Const CLIP_DEFAULT_PRECIS As Long = 0
Private Const OUT_DEFAULT_PRECIS As Long = 0
Private Const DEFAULT_PITCH As Long = 0
Private Const DEFAULT_QUALITY As Long = 0
Private Const FW_NORMAL As Long = 400

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

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type

Private Type DRAWTEXTPARAMS
    cbSize As Long
    iTabLength As Long
    iLeftMargin As Long
    iRightMargin As Long
    uiLengthDrawn As Long
End Type

Private Type TEXTMETRIC
    tmMemoryHeight As Long
    tmAscent As Long
    tmDescent As Long
    tmInternalLeading As Long
    tmExternalLeading As Long
    tmAveCharWidth As Long
    tmMaxCharWidth As Long
    tmWeight As Long
    tmOverhang As Long
    tmDigitizedAspectX As Long
    tmDigitizedAspectY As Long
    tmFirstChar As Byte
    tmLastChar As Byte
    tmDefaultChar As Byte
    tmBreakChar As Byte
    tmItalic As Byte
    tmUnderlined As Byte
    tmStruckOut As Byte
    tmPitchAndFamily As Byte
    tmCharSet As Byte
End Type

Private Type PALETTEENTRY
    peRed As Byte
    peGreen As Byte
    peBlue As Byte
    peFlags As Byte
End Type

Private Type LOGPALETTE
    palVersion As Integer
    palNumEntries As Integer
    palPalEntry(255) As PALETTEENTRY
End Type

Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104

'Private Const BS_TRANSPARENT As Long = 0
'Private Const BS_OPAQUE As Long = 1

Public Enum BackStyles
    BS_TRANSPARENT = 0
    BS_OPAQUE = 1
End Enum

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

'Private 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
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long

Private Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long

Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long


Private Const SRCCOPY = &HCC0020









Private Sub EmbossUp(Text As String, dX As Integer, dY As Integer)
    Dim wTextParams As DRAWTEXTPARAMS
    Dim rc As RECT
    With rc
        .Left = 2 + dX
        .Top = 2 + dY
        .Right = UpWidth
        .Bottom = UpHeight
    End With
    wTextParams.cbSize = Len(wTextParams)
    Call SetTextColor(UpDC, Brighten(GetPixel(UpDC, UpWidth / 2, UpHeight / 2), 0.4))
    Call DrawTextEx(UpDC, Text, Len(Text), rc, DT_FLAGS, wTextParams)
    With rc
        .Left = 0 + dX
        .Top = 0 + dY
        .Right = UpWidth
        .Bottom = UpHeight
    End With
    wTextParams.cbSize = Len(wTextParams)
    Call SetTextColor(UpDC, UpColor)
    Call DrawTextEx(UpDC, Text, Len(Text), rc, DT_FLAGS, wTextParams)
End Sub


Private Sub EmbossDown(Text As String, dX As Integer, dY As Integer)
    Dim wTextParams As DRAWTEXTPARAMS
    Dim rc As RECT
    With rc
        .Left = 2 + dX
        .Top = 2 + dY
        .Right = DownWidth
        .Bottom = DownHeight
    End With
    wTextParams.cbSize = Len(wTextParams)
    Call SetTextColor(DownDC, Brighten(GetPixel(DownDC, DownWidth / 2, DownHeight / 2), 0.4))
    Call DrawTextEx(DownDC, Text, Len(Text), rc, DT_FLAGS, wTextParams)
    With rc
        .Left = 0 + dX
        .Top = 0 + dY
        .Right = DownWidth
        .Bottom = DownHeight
    End With
    wTextParams.cbSize = Len(wTextParams)
    Call SetTextColor(DownDC, DownColor)
    Call DrawTextEx(DownDC, Text, Len(Text), rc, DT_FLAGS, wTextParams)
End Sub



Private Sub RaiseBevel(bPic As PictureBox, bLevel As Single, bEdge As Integer, Trans As Boolean)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim bW As Integer
Dim bH As Integer
Dim bL As Integer
Dim bT As Integer
Dim sPix As Long
Dim fPix As Long
Dim M As Single
Dim conHDC As Long
Dim picHDC As Long
Dim BContainer As Object
Set BContainer = bPic.Container
BContainer.ScaleMode = vbPixels
bPic.ScaleMode = vbPixels
BContainer.AutoRedraw = True
bPic.AutoRedraw = True
bW = bPic.ScaleWidth - 1
bH = bPic.ScaleHeight - 1
bL = bPic.Left
bT = bPic.Top
picHDC = bPic.hdc
conHDC = BContainer.hdc
'If transparent, then copy container image as background,
If Trans = True Then
    BitBlt UpDC, 0, 0, bW, bH, conHDC, bL + 1, bT + 1, vbSrcCopy
    BitBlt picHDC, 0, 0, bW, bH, conHDC, bL + 1, bT + 1, vbSrcCopy
Else 'we copy the container content onto the holder image and the backcolor
    ClsUP bPic.BackColor
End If 'Left Edge
M = 1
For i = 0 To bEdge
    For j = i To bH - i
        sPix = Brighten(GetPixel(picHDC, i, j), M * bLevel)
        fPix = GetPixel(conHDC, i + bL, j + bT)
        SetPixel UpDC, i, j, Blend(sPix, fPix, M)
    Next j
    M = M - (1 / bEdge)
Next i
For j = bEdge To bH - bEdge
    SetPixel UpDC, bEdge, j, Brighten(GetPixel(picHDC, bEdge, j), bLevel)
Next j
'Top Edge
M = 1
For i = 0 To bEdge
    For j = i To bW - i
        sPix = Brighten(GetPixel(picHDC, j, i), M * bLevel)
        fPix = GetPixel(conHDC, j + bL, i + bT)
        SetPixel UpDC, j, i, Blend(sPix, fPix, M)
    Next j
    M = M - (1 / bEdge)
Next i
For j = bEdge To bW - bEdge
    SetPixel UpDC, j, i, Brighten(GetPixel(picHDC, j, bEdge), bLevel)
Next j
'Right Edge
M = 0
For i = bW - bEdge To bW
    For j = bW - i To bH - (bW - i)
        sPix = Darken(GetPixel(picHDC, i, j), M * bLevel)
        fPix = GetPixel(conHDC, i + bL, j + bT)
        SetPixel UpDC, i, j, Blend(sPix, fPix, M)
    Next j
    M = M + (1 / bEdge)
Next i
For j = bEdge To bH - bEdge
    SetPixel UpDC, (bW - bEdge), j, Darken(GetPixel(picHDC, (bW - bEdge), j), bLevel)
Next j
'Bottom Edge
M = 0
For i = bH - bEdge To bH
    For j = bH - i To bW - (bH - i)
        sPix = Darken(GetPixel(picHDC, j, i), M * bLevel)
        fPix = GetPixel(conHDC, j + bL, i + bT)
        SetPixel UpDC, j, i, Blend(sPix, fPix, M)
    Next j
    M = M + (1 / bEdge)
Next i
For j = bEdge To bW - bEdge
    SetPixel UpDC, j, (bH - bEdge), Darken(GetPixel(picHDC, j, (bH - bEdge)), bLevel)
Next j
Set BContainer = Nothing
End Sub

Private Sub InsetBevel(bPic As PictureBox, bLevel As Single, bEdge As Integer, Trans As Boolean)
'Creates a bevel around the perimeter of an object
'By blending the outside pixels of the objects container
'on a gradient scale.
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim bW As Integer
Dim bH As Integer
Dim bL As Integer
Dim bT As Integer
Dim sPix As Long