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

Public Enum MsgBoxExReturnValues
    btn1& = 1
    btn2& = 2
    btn3& = 3
    btn4& = 4
End Enum

Public Enum MsgBoxExImgConstants
    imgCriticalEx& = 0   'IDI_HAND
    imgQuestionEx& = 1   'IDI_QUESTION
    imgExclamationEx& = 2 'IDI_EXCLAMATION
    imgInformationEx& = 3  'IDI_ASTERISK
    imgCustomEx& = 4
End Enum

Private Const IDI_HAND& = 32513&
Private Const IDI_QUESTION& = 32514&
Private Const IDI_EXCLAMATION& = 32515&
Private Const IDI_ASTERISK& = 32516&
    
Private Const MB_ICONHAND& = &H10&
Private Const MB_ICONQUESTION& = &H20&
Private Const MB_ICONEXCLAMATION& = &H30&
Private Const MB_ICONASTERISK& = &H40&
Private Const MB_ICONINFORMATION& = MB_ICONASTERISK

Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function LoadIconByNum Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long

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

Private Const SWP_NOSIZE& = &H1
Private Const SWP_NOMOVE& = &H2
Private Const HWND_TOPMOST& = -1


Public Function ShowMsgBox(Optional ByVal Title As String = "Attention", _
                                                         Optional ByVal Text As String = vbNullString, _
                                                         Optional ByVal btn1Caption As String = "OK", _
                                                         Optional ByVal btn2Caption As String = vbNullString, _
                                                         Optional ByVal btn3Caption As String = vbNullString, _
                                                         Optional ByVal btn4Caption As String = vbNullString, _
                                                         Optional ByVal Img As MsgBoxExImgConstants = imgInformationEx, _
                                                         Optional ByVal DefaultIdx As Integer = 1, _
                                                         Optional ByVal CancelIdx As Integer = 0, _
                                                         Optional ByVal wLeft As Integer = 0, _
                                                         Optional ByVal wTop As Integer = 0, _
                                                         Optional ByVal wTopMost As Boolean = False, _
                                                         Optional ByVal CustomImg As IPictureDisp, _
                                                         Optional ByVal AutoCloseButton As Integer = 0, _
                                                         Optional ByVal AutoCloseInterval As Integer = 0) As MsgBoxExReturnValues
                                                         
Const WidthLimit12 As Integer = 3800
Const WidthLimit3 As Integer = 4500
Const WidthLimit4 As Integer = 5400
Const BottomInterval As Integer = 570

Dim MsgSound As Long, hIcon As Long, lngIcon As Long
Dim lngHeight As Long, lngWidth As Long
Dim strBin As String, btnWidth As Long
Dim WndRect As RECT

Dim frmMsgBoxEx_ As New frmMsgBoxEx

    With frmMsgBoxEx_
        If DefaultIdx > 0 And DefaultIdx <= 4 Then
            .btn(DefaultIdx).Default = True
            .btn(DefaultIdx).TabIndex = 0
        ElseIf DefaultIdx > 4 Then
            Err.Raise 13, , "Argument must be between 0 and 4"
        End If
        If CancelIdx > 0 And CancelIdx <= 4 Then
            .btn(CancelIdx).Cancel = True
        ElseIf CancelIdx > 4 Then
            Err.Raise 13, , "Argument must be between 0 and 4"
        End If
        .Label1.Caption = " " & Title
        .Label2.Caption = Text
        btnWidth = .btn(1).Width
        lngWidth = .Label2.Width + 1100
        lngHeight = .Label2.Height + 1350
        strBin = Abs(Len(btn1Caption) > 0) & Abs(Len(btn2Caption) > 0) & Abs(Len(btn3Caption) > 0) & Abs(Len(btn4Caption) > 0)
        Select Case strBin
            Case "0000"
                Err.Raise 13
            Case "0001"
                .btn(1).Visible = False
                .btn(2).Visible = False
                .btn(3).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(4).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
            Case "0010"
                .btn(1).Visible = False
                .btn(2).Visible = False
                .btn(4).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(3).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
            Case "0011"
                .btn(1).Visible = False
                .btn(2).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(3).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(4).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
            Case "0100"
                .btn(1).Visible = False
                .btn(3).Visible = False
                .btn(4).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(2).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
            Case "0101"
                .btn(1).Visible = False
                .btn(3).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(2).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(4).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
            Case "0110"
                .btn(1).Visible = False
                .btn(4).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(2).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(3).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
            Case "0111"
                .btn(1).Visible = False
                If lngWidth < WidthLimit3 Then lngWidth = WidthLimit3
                .btn(2).Move (lngWidth - 3 * btnWidth) \ 2 - 80, lngHeight - BottomInterval
                .btn(3).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
                .btn(4).Move (lngWidth + btnWidth) \ 2 + 80, lngHeight - BottomInterval
            Case "1000"
                .btn(2).Visible = False
                .btn(3).Visible = False
                .btn(4).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(1).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
                .btn(1).Caption = btn1Caption
            Case "1001"
                .btn(2).Visible = False
                .btn(3).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(1).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(4).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
            Case "1010"
                .btn(2).Visible = False
                .btn(4).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(1).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(3).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
            Case "1011"
                .btn(2).Visible = False
                If lngWidth < WidthLimit3 Then lngWidth = WidthLimit3
                .btn(1).Move (lngWidth - 3 * btnWidth) \ 2 - 80, lngHeight - BottomInterval
                .btn(3).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
                .btn(4).Move (lngWidth + btnWidth) \ 2 + 80, lngHeight - BottomInterval
            Case "1100"
                .btn(3).Visible = False
                .btn(4).Visible = False
                If lngWidth < WidthLimit12 Then lngWidth = WidthLimit12
                .btn(1).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(2).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
            Case "1101"
                .btn(3).Visible = False
                If lngWidth < WidthLimit3 Then lngWidth = WidthLimit3
                .btn(1).Move (lngWidth - 3 * btnWidth) \ 2 - 80, lngHeight - BottomInterval
                .btn(2).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
                .btn(4).Move (lngWidth + btnWidth) \ 2 + 80, lngHeight - BottomInterval
            Case "1110"
                .btn(4).Visible = False
                If lngWidth < WidthLimit3 Then lngWidth = WidthLimit3
                .btn(1).Move (lngWidth - 3 * btnWidth) \ 2 - 80, lngHeight - BottomInterval
                .btn(2).Move (lngWidth - btnWidth) \ 2, lngHeight - BottomInterval
                .btn(3).Move (lngWidth + btnWidth) \ 2 + 80, lngHeight - BottomInterval
            Case "1111"
                If lngWidth < WidthLimit4 Then lngWidth = WidthLimit4
                .btn(1).Move lngWidth \ 2 - 2 * btnWidth - 120, lngHeight - BottomInterval
                .btn(2).Move lngWidth \ 2 - btnWidth - 40, lngHeight - BottomInterval
                .btn(3).Move lngWidth \ 2 + 40, lngHeight - BottomInterval
                .btn(4).Move lngWidth \ 2 + btnWidth + 120, lngHeight - BottomInterval
            Case Else
                Err.Raise 13, , "?????"
        End Select
        .btn(1).Caption = btn1Caption
        .btn(2).Caption = btn2Caption
        .btn(3).Caption = btn3Caption
        .btn(4).Caption = btn4Caption
        .Width = lngWidth
        .Height = lngHeight
        .Image4.Left = lngWidth - 350
        .Label1.Width = lngWidth - 55
        If wTop <> 0 Or wLeft <> 0 Then
            .Move wLeft, wTop
        Else
           Call GetWindowRect(GetDesktopWindow(), WndRect)
           .Move (.ScaleX(WndRect.Right - WndRect.Left, vbPixels, vbTwips) - lngWidth) \ 2, (.ScaleY(WndRect.Bottom - WndRect.Top, vbPixels, vbTwips) - lngHeight) \ 2
        End If
        
        If Img = imgCustomEx Then
            .Picture1.Picture = CustomImg
        Else
            Select Case Img
                Case imgCriticalEx
                    MsgSound = MB_ICONHAND
                    lngIcon = IDI_HAND
                Case imgQuestionEx
                    MsgSound = MB_ICONQUESTION
                    lngIcon = IDI_QUESTION
                Case imgExclamationEx
                    MsgSound = MB_ICONEXCLAMATION
                    lngIcon = IDI_EXCLAMATION
                Case imgInformationEx
                    MsgSound = MB_ICONASTERISK
                    lngIcon = IDI_ASTERISK
            End Select
            hIcon = LoadIconByNum(0, lngIcon)
            Call DrawIcon(.Picture1.hDC, 0, 0, hIcon)
            Call MessageBeep(MsgSound)
        End If
        If wTopMost Then
            Call SetWindowPos(.hWnd, HWND_TOPMOST, 0, 0, 1, 1, SWP_NOSIZE Or SWP_NOMOVE)
        End If
        
        With .tmrAutoClose
            .Tag = AutoCloseButton
            .Interval = AutoCloseInterval
            .Enabled = (AutoCloseInterval > 0)
        End With
                
        .Show vbModal
        
        ShowMsgBox = .getButton
    End With
    Unload frmMsgBoxEx_
End Function

Public Function ShowInputBox(Optional ByVal Title As String = "Attention", _
                                                         Optional ByVal Text As String = vbNullString, _
                                                         Optional ByVal DefaultTextValue As String = vbNullString, _
                                                         Optional ByVal DefaultValue As String = vbNullString, _
                                                         Optional ByVal MaxTextLen As Integer = 0, _
                                                         Optional ByVal btn1Caption As String = "OK", _
                                                         Optional ByVal btn2Caption As String = vbNullString, _
                                                         Optional ByVal DefaultIdx As Integer = 1, _
                                                         Optional ByVal CancelIdx As Integer = 2, _
                                                         Optional ByVal wLeft As Integer = 0, _
                                                         Optional ByVal wTop As Integer = 0, _
                                                         Optional ByVal wTopMost As Boolean = False) As String
                                                         
Dim lngWidth As Long, lngHeight As Long
Dim WndRect As RECT

Dim frmInputBoxEx_ As New frmInputBoxEx

    With frmInputBoxEx_
        If DefaultIdx > 0 And DefaultIdx <= 2 Then
            .btn(DefaultIdx).Default = True
            '.btn(DefaultIdx).TabIndex = 0
        ElseIf DefaultIdx > 2 Then
            Err.Raise 13, , "Argument must be between 0 and 2"
        End If
        If CancelIdx > 0 And CancelIdx <= 2 Then
            .btn(CancelIdx).Cancel = True
        ElseIf CancelIdx > 2 Then
            Err.Raise 13, , "Argument must be between 0 and 2"
        End If
        .Label1.Caption = " " & Title
        .Label2.Caption = Text
        .txtInputValue.Text = DefaultTextValue
        .txtInputValue.Tag = DefaultValue
        lngWidth = .Width
        lngHeight = .Height
        .btn(1).Caption = btn1Caption
        .btn(2).Caption = btn2Caption
        .Image4.Left = lngWidth - 350
        .Label1.Width = lngWidth - 55
        If wTop <> 0 Or wLeft <> 0 Then
            .Move wLeft, wTop
        Else
            Call GetWindowRect(GetDesktopWindow(), WndRect)
           .Move (.ScaleX(WndRect.Right - WndRect.Left, vbPixels, vbTwips) - lngWidth) \ 2, (.ScaleY(WndRect.Bottom - WndRect.Top, vbPixels, vbTwips) - lngHeight) \ 2
        End If
        If wTopMost Then
            Call SetWindowPos(.hWnd, HWND_TOPMOST, 0, 0, 1, 1, SWP_NOSIZE Or SWP_NOMOVE)
        End If
        
        .Show vbModal
        
        ShowInputBox = .getRetVal
    End With
    Unload frmInputBoxEx_
End Function
 
Public Property Get msgTitleFont() As String
    msgTitleFont = frmMsgBoxEx.Label1.FontName
End Property

Public Property Let msgTitleFont(ByVal sNewValue As String)
    frmMsgBoxEx.Label1.FontName = sNewValue
End Property

Public Property Get msgButtonsFont() As String
    msgButtonsFont = frmMsgBoxEx.btn(1).FontName
End Property

Public Property Let msgButtonsFont(ByVal sNewValue As String)
Dim i As Integer
    
    With frmMsgBoxEx
        For i = .btn.LBound To .btn.UBound
            .btn(i).FontName = sNewValue
        Next i
    End With
End Property

Public Property Get msgTextFont() As String
    msgTextFont = frmMsgBoxEx.Label2.FontName
End Property

Public Property Let msgTextFont(ByVal sNewValue As String)
    frmMsgBoxEx.Label2.FontName = sNewValue
End Property



Public Property Get inpTextBoxFont() As String
    inpTextBoxFont = frmInputBoxEx.txtInputValue.FontName
End Property

Public Property Let inpTextBoxFont(ByVal sNewValue As String)
    frmInputBoxEx.txtInputValue.FontName = sNewValue
End Property

Public Property Get inpTitleFont() As String
    inpTitleFont = frmInputBoxEx.Label1.FontName
End Property

Public Property Let inpTitleFont(ByVal sNewValue As String)
    frmInputBoxEx.Label1.FontName = sNewValue
End Property

Public Property Get inpButtonsFont() As String
    inpButtonsFont = frmInputBoxEx.btn(1).FontName
End Property

Public Property Let inpButtonsFont(ByVal sNewValue As String)
Dim i As Integer
    With frmInputBoxEx
        For i = .btn.LBound To .btn.UBound
            .btn(i).FontName = sNewValue
        Next i
    End With
End Property

Public Property Get inpTextFont() As String
    inpTextFont = frmInputBoxEx.Label2.FontName
End Property

Public Property Let inpTextFont(ByVal sNewValue As String)
    frmInputBoxEx.Label2.FontName = sNewValue
End Property
