Skip to content

MrTakrep/Bootstrap_Button

Folders and files

NameName
Last commit message
Last commit date

Latest commit

 

History

4 Commits
 
 
 
 
 
 

Repository files navigation

#If VBA7 And Win64 Then ' // 64bit Private Declare PtrSafe Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long #Else ' // 32bit Private Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long #End If

Public WithEvents mForm As MSForms.UserForm Public WithEvents mPage As MSForms.MultiPage Public WithEvents mframe As MSForms.Frame Public WithEvents btn As MSForms.Label Public WithEvents btnIcon As MSForms.Label

Public cBtn As New Collection Private cButton As New clsBtn Public PassiveBtnHover Public ActiveButton As MSForms.Label ' Public onButton As Boolean Private Const IDC_HAND = 32649&

Private Function MouseCursor(CursorType As Long) Dim lngRet As Long lngRet = LoadCursorBynum(0&, CursorType) lngRet = SetCursor(lngRet) End Function

Private Function MouseMoveIcon() Call MouseCursor(IDC_HAND) End Function

Public Sub classbutton(form As MSForms.UserForm, Optional mPage As MSForms.MultiPage, Optional mframe As MSForms.Frame) Dim ctrl As control Dim IconCode As String Dim btnLabel As control Set mForm = form For Each btnLabel In mForm.Controls If TypeName(btnLabel) = "Label" Then If GetBtnType(btnLabel, 0) = "btn" Then ButtonDesign btnLabel For Each ctrl In frmElement.Controls If GetBtnType(ctrl, 0) = "btn" Then If GetBtnType(ctrl, 1) = GetBtnType(btnLabel, 1) Then With btnLabel .Picture = ctrl.Picture .ForeColor = ctrl.ForeColor End With End If End If Next If btnLabel.ControlTipText <> "" Then Set btnIcon = btnLabel.Parent.Controls.Add("Forms.Label.1", btnLabel.Name & "Icon") With btnIcon IconCode = btnLabel.ControlTipText .Top = btnLabel.Top + (btnLabel.Height / 2) - (.Height / 2) + 2 .Left = btnLabel.Left + 6 .Font.Name = "Poppins Medium" .Caption = ChrW("&H" & IconCode) .Font.Size = 13 .ForeColor = btnLabel.ForeColor .AutoSize = True .BackStyle = fmBackStyleTransparent End With End If btnLabel.ControlTipText = btnLabel.Caption

            Set cButton = New clsBtn
            Set cButton.btn = btnLabel
            Set cButton.mPage = mPage
            Set cButton.btnIcon = btnIcon
            Set cButton.mframe = mframe
            Set cButton.mForm = mForm
            cBtn.Add cButton

' Set btnIcon = Nothing End If End If Next End Sub Sub ButtonDesign(ctrl As Object) With ctrl .Font.Size = 10 .Font.Name = "Poppins Medium" .BackStyle = fmBackStyleTransparent .BorderStyle = fmBorderStyleNone .PicturePosition = 12 .Height = 24 ' If InStr(1, GetBtnType(ctrl, 1), "Outline") <> 0 Then ' .ForeColor = &H404040 ' End If End With End Sub

Private Sub btn_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) MouseMoveIcon btnMouseOut onButton = True Dim ctrl As control For Each ctrl In frmElement.Controls If GetBtnType(ctrl, 0) = "btnHover" Then If InStr(1, GetBtnType(btn, 1), GetBtnType(ctrl, 1)) <> 0 Then With btn .Picture = ctrl.Picture .PicturePosition = fmPicturePositionCenter .ForeColor = ctrl.ForeColor

               If Not btnIcon Is Nothing Then
                    If InStr(1, btnIcon.Name, btn.Name) <> 0 Then
                    btnIcon.ForeColor = ctrl.ForeColor
                    End If
                End If
        End With
        End If
    End If
Next
Set ActiveButton = btn

End Sub

Sub SetForm(form As MSForms.UserForm) Set mForm = form End Sub Private Sub mForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) btnMouseOut End Sub Sub btnMouseOut() Dim ctrl As control

If onButton = True Then For Each ctrl In frmElement.Controls If GetBtnType(ctrl, 0) = "btn" Then If GetBtnType(ctrl, 1) = GetBtnType(ActiveButton, 1) Then ActiveButton.Picture = ctrl.Picture If InStr(1, GetBtnType(ctrl, 1), "Outline") <> 0 Then ActiveButton.ForeColor = &H404040 If Not btnIcon Is Nothing Then If InStr(1, btnIcon.Name, ActiveButton.Name) <> 0 Then btnIcon.ForeColor = &H404040 End If End If End If End If End If Next onButton = False End If End Sub Private Sub mFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) btnMouseOut End Sub

Private Sub mFrame2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) btnMouseOut End Sub Private Sub mPage_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) btnMouseOut End Sub Function GetBtnType(ctrl As control, Index As Integer) On Error Resume Next If InStr(1, ctrl.Tag, "-") <> 0 Then GetBtnType = Split(ctrl.Tag, "-")(Index) Else GetBtnType = ctrl.Tag End If End Function

About

No description, website, or topics provided.

Resources

License

Stars

Watchers

Forks

Releases

No releases published

Packages

 
 
 

Contributors