clsinteraction.cls

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

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