Attribute currentButtonIndex.VB_VarDescription = "The index of the current button being referenced in code. This property is a 0 based array and must be set/specified before setting the [Caption] or [PopupText] of any 1 individual button"
' local variables
Dim bEnter As Boolean, bOrientationChanged As Boolean
Dim m_bDoExecuteCode As Boolean
Dim btnRECT() As RECT, captRECT() As RECT
Dim peiceRECT() As RECT, ctrlsRect As RECT
Dim mArrMouseIsIn&, mOldArrMouseIsIn&
' api declarations
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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 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 DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Pointapi) As Long
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) 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 SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
' Default Property Values:
Const m_def_ButtonArrayOrientation = 0
Const m_def_ButtonArrayCount = 2
Const m_def_CaptionFX = 0
Const m_def_Caption = ""
Const m_def_CaptionColor = 0
Const m_def_Align = 0
Const m_def_BorderStyle = 0
Const m_def_PopupText = ""
Const m_def_MouseOverHiliteColor = &HFFC0C0
Const m_def_MouseOverCaptionColor = &HFFFFFF
Const m_def_MouseOverHiliteBorderColor = 0
Const m_def_ControlImageTransparency = 7
Const m_def_HiliteShape = 0
Const m_def_CaptionAlign = &H0
Const m_def_RestingButtonDepth = 0
Const m_def_ButtonPictureStretch = 0
Const m_def_ButtonDividers = 0
' Property Variables:
Dim m_ButtonArrayOrientation As enArrOrient
Dim m_ButtonArrayCount As enBtnArrCnt
Dim m_CaptionFX As enCaptFX
Dim m_Caption As String, m_tempCaption() As String
Dim m_CaptionColor As OLE_COLOR
Dim m_Align As enAlign
Dim m_ToggleVal As enToggleVal
Dim m_BorderStyle As enBordStyle
Dim m_PopupText As String, m_tempPopupText() As String
Dim m_MouseOverHiliteColor As OLE_COLOR
Dim m_MouseOverCaptionColor As OLE_COLOR
Dim m_MouseOverHiliteBorderColor As OLE_COLOR
Dim m_ControlImageTransparency As enCtrlImgTransparency
Public Sub Launch(strAppPathOrUrl$, Optional ShowHow As enShowApp = 1)
Attribute Launch.VB_Description = "Launches a file or application, or, a web address in the systems default browser if a string enclosed in quotes that specifies a web address, i.e ""www.yahoo.com"""
Call ShellExecute(hwnd&, _
"open", _
strAppPathOrUrl$, _
vbNullString, _
vbNullString, _
ShowHow)
End Sub
'PUBLIC SUB VISUALPRESS'-------------------------
'this sub allows the user to not only execute code
'for the mousedown or mouseup button visual create
'the press down and up as well
'------------------------------------------------
Public Sub VisualPress(buttonState As enBtnState, buttonIndex&, _
Optional DoCodeExecute As Boolean = True, _
Optional mouseButton% = 1)
Attribute VisualPress.VB_Description = "Creates a button press, both visually, and in code (if DoCodeExecute=True)"
'if user selected a valid button in the control
If buttonIndex& >= 0 Then
If buttonIndex& <= m_ButtonArrayCount Then
mArrMouseIsIn& = buttonIndex&
m_bDoExecuteCode = DoCodeExecute
If buttonState = buttonDown Then
'press down
Call UserControl_MouseDown(mouseButton%, 0, 0, 0)
Else
'press up
Call UserControl_MouseUp(mouseButton%, 0, 0, 0)
'------------------------------------------
'the press down caused the button to be
'hilited just as if it was really pressed
'so clear the hiliting with a repaint
'-----------------------------------------
'repaint the buttons
Call SetRects(, _
, DFCS_HOT)
'repaint the captions
Call DrawCaption
End If
'-----------------------------------------
m_bDoExecuteCode = True
End If
End If
End Sub
'
''ALIGN
Public Property Get Align() As enAlign
Attribute Align.VB_Description = "The layout relationship between the button and caption (Left: button left of caption; Right: button right of caption)"
Align = m_Align
End Property
Public Property Let Align(ByVal New_Align As enAlign)
m_Align = New_Align
PropertyChanged "Align"
Call UserControl_Resize
End Property
'BACKCOLOR
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "The overall color of the control"
of As A Widt Call UserCU----- an tsaYrlgned in .WriteProperty("BordIRgg | chararcttonArrayClgned in .WritePropeMMMMMMMMMM=== cutcIuf edErty!ritePrlgned in .WritePropeMMMMMMMMMM=== cutcIuf edErty N ORENTATIy Get Buttof thDty!rite'MMMMMMMM===cton arr
