clsinteraction.cls

This application provides much functionality for creating data-driven reports, including preview, gr

                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