Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/message/msgbxcls/msgbxtst.frm

Visual Basic Form | 1996-01-06 | 23.3 KB | 688 lines

VERSION 4.00
Begin VB.Form frmMsgBoxTest
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "MsgBox Class Test Project"
   ClientHeight    =   6150
   ClientLeft      =   1140
   ClientTop       =   1560
   ClientWidth     =   6765
   Height          =   6585
   Icon            =   "MSGBXTST.frx":0000
   Left            =   1065
   MaxButton       =   0   'False
   ScaleHeight     =   410
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   451
   ShowInTaskbar   =   0   'False
   Top             =   1200
   Width           =   6915
   Begin VB.TextBox txtObjectName
      Height          =   285
      Left            =   5520
      TabIndex        =   33
      Text            =   "MB"
      Top             =   3930
      Width           =   1005
   End
   Begin VB.TextBox txtGeneratedCode
      Height          =   915
      Left            =   270
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   35
      Top             =   4860
      Width           =   6285
   End
   Begin VB.Frame fmeCallFormat
      Caption         =   "Call Format"
      Height          =   885
      Left            =   240
      TabIndex        =   26
      Top             =   3810
      Width           =   2415
      Begin VB.OptionButton optCallFormat
         Caption         =   "Set Properties First"
         Height          =   225
         Index           =   0
         Left            =   240
         TabIndex        =   27
         Top             =   240
         Value           =   -1  'True
         Width           =   1950
      End
      Begin VB.OptionButton optCallFormat
         Caption         =   "Use Values In-line"
         Height          =   225
         Index           =   1
         Left            =   240
         TabIndex        =   28
         Top             =   510
         Width           =   1950
      End
   End
   Begin VB.Frame fmeCallType
      Caption         =   "Call Type"
      Height          =   885
      Left            =   2880
      TabIndex        =   29
      Top             =   3810
      Width           =   1725
      Begin VB.OptionButton optCallType
         Caption         =   "Sub"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   30
         Top             =   240
         Value           =   -1  'True
         Width           =   1155
      End
      Begin VB.OptionButton optCallType
         Caption         =   "Function"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   31
         Top             =   510
         Width           =   1155
      End
   End
   Begin VB.CommandButton cmdGenerateCall
      Caption         =   "&Generate Call"
      Height          =   360
      Left            =   4890
      TabIndex        =   34
      Top             =   4350
      Width           =   1665
   End
   Begin VB.Frame fmeIcon
      Caption         =   "Icon"
      Height          =   2205
      Left            =   4890
      TabIndex        =   18
      Top             =   1230
      Width           =   1665
      Begin VB.OptionButton optIcon
         Caption         =   "In&formation"
         Height          =   225
         Index           =   4
         Left            =   240
         TabIndex        =   23
         Top             =   1500
         Width           =   1275
      End
      Begin VB.OptionButton optIcon
         Caption         =   "E&xclamation"
         Height          =   225
         Index           =   3
         Left            =   240
         TabIndex        =   22
         Top             =   1200
         Width           =   1275
      End
      Begin VB.OptionButton optIcon
         Caption         =   "&Question"
         Height          =   225
         Index           =   2
         Left            =   240
         TabIndex        =   21
         Top             =   900
         Width           =   1275
      End
      Begin VB.OptionButton optIcon
         Caption         =   "Cr&itical"
         Height          =   225
         Index           =   1
         Left            =   240
         TabIndex        =   20
         Top             =   600
         Width           =   1275
      End
      Begin VB.OptionButton optIcon
         Caption         =   "Non&e"
         Height          =   225
         Index           =   0
         Left            =   240
         TabIndex        =   19
         Top             =   300
         Value           =   -1  'True
         Width           =   1275
      End
   End
   Begin VB.Frame fmeModality
      Caption         =   "Modality"
      Height          =   885
      Left            =   2880
      TabIndex        =   15
      Top             =   2550
      Width           =   1725
      Begin VB.OptionButton optModality
         Caption         =   "&System"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   17
         Top             =   510
         Width           =   1155
      End
      Begin VB.OptionButton optModality
         Caption         =   "&Application"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   16
         Top             =   240
         Value           =   -1  'True
         Width           =   1155
      End
   End
   Begin VB.Frame fmeDefaultButton
      Caption         =   "Default Button"
      Height          =   1275
      Left            =   2880
      TabIndex        =   11
      Top             =   1230
      Width           =   1725
      Begin VB.OptionButton optDefaultButton
         Caption         =   "Button &3"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   14
         Top             =   900
         Width           =   1215
      End
      Begin VB.OptionButton optDefaultButton
         Caption         =   "Button &2"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   13
         Top             =   600
         Width           =   1215
      End
      Begin VB.OptionButton optDefaultButton
         Caption         =   "Button &1"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   12
         Top             =   300
         Value           =   -1  'True
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdTestMsgBox
      Caption         =   "Test Message Box"
      Height          =   360
      Left            =   4890
      TabIndex        =   24
      Top             =   255
      Width           =   1665
   End
   Begin VB.CommandButton cmdClose
      Caption         =   "Close"
      Height          =   360
      Left            =   4890
      TabIndex        =   25
      Top             =   705
      Width           =   1665
   End
   Begin VB.Frame fmeButtons
      Caption         =   "Buttons"
      Height          =   2205
      Left            =   210
      TabIndex        =   4
      Top             =   1230
      Width           =   2415
      Begin VB.OptionButton optButtons
         Caption         =   "&Retry + Cancel"
         Height          =   225
         Index           =   5
         Left            =   240
         TabIndex        =   10
         Top             =   1800
         Width           =   1950
      End
      Begin VB.OptionButton optButtons
         Caption         =   "Yes + &No"
         Height          =   225
         Index           =   4
         Left            =   240
         TabIndex        =   9
         Top             =   1500
         Width           =   1950
      End
      Begin VB.OptionButton optButtons
         Caption         =   "&Yes + No + Cancel"
         Height          =   225
         Index           =   3
         Left            =   240
         TabIndex        =   8
         Top             =   1200
         Width           =   1950
      End
      Begin VB.OptionButton optButtons
         Caption         =   "A&bort + Retry +Ignore"
         Height          =   225
         Index           =   2
         Left            =   240
         TabIndex        =   7
         Top             =   900
         Width           =   1950
      End
      Begin VB.OptionButton optButtons
         Caption         =   "OK + &Cancel"
         Height          =   225
         Index           =   1
         Left            =   240
         TabIndex        =   6
         Top             =   600
         Width           =   1950
      End
      Begin VB.OptionButton optButtons
         Caption         =   "&OK only"
         Height          =   225
         Index           =   0
         Left            =   240
         TabIndex        =   5
         Top             =   300
         Value           =   -1  'True
         Width           =   1950
      End
   End
   Begin VB.TextBox txtTitle
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      Text            =   "Test Title"
      Top             =   330
      Width           =   1425
   End
   Begin VB.TextBox txtMessage
      Height          =   285
      Left            =   1320
      TabIndex        =   3
      Text            =   "Test Message"
      Top             =   750
      Width           =   3285
   End
   Begin VB.Label lblObject
      BackStyle       =   0  'Transparent
      Caption         =   "Object:"
      Height          =   255
      Left            =   4920
      TabIndex        =   32
      Top             =   3990
      Width           =   495
   End
   Begin VB.Line linHorzSep
      BorderColor     =   &H00808080&
      Index           =   1
      X1              =   14
      X2              =   436
      Y1              =   246
      Y2              =   246
   End
   Begin VB.Line linHorzSep
      BorderColor     =   &H00FFFFFF&
      Index           =   0
      X1              =   14
      X2              =   436
      Y1              =   244
      Y2              =   244
   End
   Begin VB.Label lblStatusBar
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Copyright
 1995-1996 Gregg Irwin.  All Rights Reserved."
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   400
         size            =   9.75
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   240
      TabIndex        =   36
      Top             =   5850
      Width           =   4980
   End
   Begin VB.Label lblTitle
      BackStyle       =   0  'Transparent
      Caption         =   "&Title:"
      Height          =   225
      Left            =   270
      TabIndex        =   0
      Top             =   360
      Width           =   885
   End
   Begin VB.Label lblMessage
      BackStyle       =   0  'Transparent
      Caption         =   "&Message:"
      Height          =   225
      Left            =   270
      TabIndex        =   2
      Top             =   780
      Width           =   885
   End
Attribute VB_Name = "frmMsgBoxTest"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' MsgBox Class Test Project
' Copyright
 1995-1996 Gregg Irwin. All Rights Reserved.
Option Explicit
DefInt A-Z
Const STYLE_OP_BUTTON = 0
Const STYLE_OP_DEF_BUTTON = 1
Const STYLE_OP_MODALITY = 2
Const STYLE_OP_ICON = 3
Const OPT_BTN_OK_ONLY = 0
Const OPT_BTN_OK_CANCEL = 1
Const OPT_BTN_ABORT_RETRY_IGNORE = 2
Const OPT_BTN_YES_NO_CANCEL = 3
Const OPT_BTN_YES_NO = 4
Const OPT_BTN_RETRY_CANCEL = 5
Const OPT_DEF_BTN_1 = 0
Const OPT_DEF_BTN_2 = 1
Const OPT_DEF_BTN_3 = 2
Const OPT_DEF_BTN_4 = 3
Const OPT_ICON_NONE = 0
Const OPT_ICON_CRITICAL = 1
Const OPT_ICON_QUESTION = 2
Const OPT_ICON_EXCLAMATION = 3
Const OPT_ICON_INFORMATION = 4
Const OPT_MODALITY_APP = 0
Const OPT_MODALITY_SYSTEM = 1
Const CALL_TYPE_SUB = 0
Const CALL_TYPE_FUNCTION = 1
Const CALL_FORMAT_SET_PROPS_FIRST = 0
Const CALL_FORMAT_USE_VALS_INLINE = 1
Const DEF_OBJECT_NAME = "MB"
Private mStyleOp(3) As Long         '-- selected Style options
'=======================================================
'== EVENTS
'=======================================================
Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdGenerateCall_Click()
    Dim ObjName As String
    Dim GenCode As String
    ObjName = txtObjectName.Text
    If ObjName = "" Then
        ObjName = DEF_OBJECT_NAME
    End If
    GenCode = ""
    GenCode = GenCode & "Dim " & ObjName & " As New clsMsgBox" & vbCrLf
    GenCode = GenCode & "Dim " & ObjName & "Rtn As Integer" & vbCrLf
    GenCode = GenCode & vbCrLf
    Select Case GetCallFormat()
        Case CALL_FORMAT_SET_PROPS_FIRST
            GenCode = GenCode & "With " & ObjName & vbCrLf
            GenCode = GenCode & "    .Title = " & Chr$(34) & txtTitle.Text & Chr$(34) & vbCrLf
            GenCode = GenCode & "    .Message = " & Chr$(34) & txtMessage.Text & Chr$(34) & vbCrLf
            GenCode = GenCode & "    .Style = " & GenerateStyleCode() & vbCrLf
            GenCode = GenCode & "End With" & vbCrLf
            Select Case GetCallType()
                Case CALL_TYPE_SUB
                    GenCode = GenCode & ObjName & ".ShowModal" & vbCrLf
                Case CALL_TYPE_FUNCTION
                    GenCode = GenCode & ObjName & "Rtn = " & ObjName & ".ShowModal" & vbCrLf
                    GenCode = GenCode & GenerateRtnCodeHandler(ObjName) & vbCrLf
                Case Else
            End Select
        Case CALL_FORMAT_USE_VALS_INLINE
            Select Case GetCallType()
                Case CALL_TYPE_SUB
                    GenCode = GenCode & ObjName & ".ShowModal "
                    GenCode = GenCode & " StyleFlags := (" & GenerateStyleCode() & "),"
                    GenCode = GenCode & " Msg := " & Chr$(34) & txtMessage.Text & Chr$(34) & ", "
                    GenCode = GenCode & " BoxTitle := " & Chr$(34) & txtTitle.Text & Chr$(34)
                    GenCode = GenCode & vbCrLf
                Case CALL_TYPE_FUNCTION
                    GenCode = GenCode & ObjName & "Rtn = " & ObjName & ".ShowModal ("
                    GenCode = GenCode & " StyleFlags := (" & GenerateStyleCode() & "),"
                    GenCode = GenCode & " Msg := " & Chr$(34) & txtMessage.Text & Chr$(34) & ", "
                    GenCode = GenCode & " BoxTitle := " & Chr$(34) & txtTitle.Text & Chr$(34) & ")"
                    GenCode = GenCode & vbCrLf
                    GenCode = GenCode & GenerateRtnCodeHandler(ObjName) & vbCrLf
                Case Else
            End Select
        Case Else
    End Select
    txtGeneratedCode = GenCode

End Sub
Private Sub cmdTestMsgBox_Click()
    Dim MB      As New clsMsgBox
    Dim Style   As Long
    Dim i       As Integer
    Dim Cap     As String
    Dim Msg     As String
    Dim MBRtn   As Integer  '-- MsgBox Return Value
    '-- Accumulate all the selected style settings
    For i = LBound(mStyleOp) To UBound(mStyleOp)
        Style = Style + mStyleOp(i)
    Next i
    '-- Set message and title
    Msg = txtMessage.Text
    Cap = txtTitle.Text
    '-- Display the message box
    MBRtn = MB.ShowModal(Msg, Style, Cap, (Me.HWnd))
    '-- Display the return value
    lblStatusBar.Caption = MsgBoxReturnCodeDesc(MBRtn) & " was selected"
End Sub
Private Sub Form_Load()
    '-- Center the form on the screen
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
End Sub
Private Sub optButtons_Click(Index As Integer)
    '-- The control array index values just happen
    '   to match the values we need.
    mStyleOp(STYLE_OP_BUTTON) = Index
    Select Case Index
        Case OPT_BTN_OK_ONLY
            Call SetCallType(CALL_TYPE_SUB)
        Case Else
            Call SetCallType(CALL_TYPE_FUNCTION)
    End Select
End Sub
Private Sub optDefaultButton_Click(Index As Integer)
    '-- The control array index values just happen
    '   to match the values we need (when multiplied
    '   by 256).
    mStyleOp(STYLE_OP_DEF_BUTTON) = Index * 256
End Sub
Private Sub optIcon_Click(Index As Integer)
    '-- The control array index values just happen
    '   to match the values we need (when multiplied
    '   by 16).
    mStyleOp(STYLE_OP_ICON) = Index * 16
End Sub
Private Sub optModality_Click(Index As Integer)
    '-- The control array index values just happen
    '   to match the values we need (when multiplied
    '   by 4096).
    mStyleOp(STYLE_OP_MODALITY) = Index * 4096
End Sub
'=======================================================
'== INTERNAL SUPPORT PROCEDURES
'=======================================================
' MsgBoxReturnCodeDesc()
Private Function MsgBoxReturnCodeDesc(MsgBoxRtnCode As Integer) As String
    Dim Desc As String
    Select Case MsgBoxRtnCode
        Case vbAbort
            Desc = "Abort"
        Case vbCancel
            Desc = "Cancel"
        Case vbIgnore
            Desc = "Ignore"
        Case vbNo
            Desc = "No"
        Case vbOK
            Desc = "OK"
        Case vbRetry
            Desc = "Retry"
        Case vbYes
            Desc = "Yes"
        Case Else
            Desc = "Unknown (" & CStr(MsgBoxRtnCode) & ")"
    End Select
    MsgBoxReturnCodeDesc = Desc
End Function
' SetCallType
Private Sub SetCallType(CallType As Integer)
    Select Case CallType
        Case CALL_TYPE_SUB
            optCallType(0).Value = True
        Case CALL_TYPE_FUNCTION
            optCallType(1).Value = True
        Case Else
    End Select
End Sub
' GetCallType()
Private Function GetCallType() As Integer
    If optCallType(0).Value = True Then
        GetCallType = CALL_TYPE_SUB
    Else
        GetCallType = CALL_TYPE_FUNCTION
    End If
End Function
' GetCallFormat()
Private Function GetCallFormat() As Integer
    If optCallFormat(0).Value = True Then
        GetCallFormat = CALL_FORMAT_SET_PROPS_FIRST
    Else
        GetCallFormat = CALL_FORMAT_USE_VALS_INLINE
    End If
End Function
' GetButtonStyleOption()
Private Function GetButtonStyleOption() As Integer
    GetButtonStyleOption = mStyleOp(STYLE_OP_BUTTON)
End Function
' GetDefaultButtonStyleOption()
Private Function GetDefaultButtonStyleOption() As Integer
    GetDefaultButtonStyleOption = mStyleOp(STYLE_OP_DEF_BUTTON) \ 256
End Function
' GetIconStyleOption()
Private Function GetIconStyleOption() As Integer
    GetIconStyleOption = mStyleOp(STYLE_OP_ICON) \ 16
End Function
' GetModalityStyleOption()
Private Function GetModalityStyleOption() As Integer
    GetModalityStyleOption = mStyleOp(STYLE_OP_MODALITY) \ 4096
End Function
' GenerateStyleCode()
Private Function GenerateStyleCode() As String
    Dim BtnStyle    As String
    Dim DefBtnStyle As String
    Dim IconStyle   As String
    Dim ModalStyle  As String
    Dim GenStyle    As String
    Select Case GetButtonStyleOption()
        Case OPT_BTN_OK_ONLY
            BtnStyle = "vbOKOnly"
        Case OPT_BTN_OK_CANCEL
            BtnStyle = "vbOKCancel"
        Case OPT_BTN_ABORT_RETRY_IGNORE
            BtnStyle = "vbAbortRetryIgnore"
        Case OPT_BTN_YES_NO_CANCEL
            BtnStyle = "vbYesNoCancel"
        Case OPT_BTN_YES_NO
            BtnStyle = "vbYesNo"
        Case OPT_BTN_RETRY_CANCEL
            BtnStyle = "vbRetryCancel"
        Case Else
            BtnStyle = ""
    End Select
    Select Case GetDefaultButtonStyleOption()
        Case OPT_DEF_BTN_1
            '-- Default value. No need to generate code
            'DefBtnStyle = "vbDefaultButton1"
        Case OPT_DEF_BTN_2
            DefBtnStyle = "vbDefaultButton2"
        Case OPT_DEF_BTN_3
            DefBtnStyle = "vbDefaultButton3"
        Case OPT_DEF_BTN_4
            DefBtnStyle = "vbDefaultButton4"
        Case Else
            DefBtnStyle = ""
    End Select
    Select Case GetIconStyleOption()
        Case OPT_ICON_NONE
            '-- Default value. No need to generate code
            'IconStyle = ""
        Case OPT_ICON_CRITICAL
            IconStyle = "vbCritical"
        Case OPT_ICON_QUESTION
            IconStyle = "vbQuestion"
        Case OPT_ICON_EXCLAMATION
            IconStyle = "vbExclamation"
        Case OPT_ICON_INFORMATION
            IconStyle = "vbInformation"
        Case Else
            IconStyle = ""
    End Select
    Select Case GetModalityStyleOption()
        Case OPT_MODALITY_APP
            '-- Default value. No need to generate code
            'ModalStyle = "vbApplicationModal"
        Case OPT_MODALITY_SYSTEM
            ModalStyle = "vbSystemModal"
        Case Else
            ModalStyle = ""
    End Select
    GenStyle = ""
    If Len(BtnStyle) Then
        GenStyle = GenStyle & BtnStyle
    End If
    If Len(DefBtnStyle) Then
        GenStyle = GenStyle & " + " & DefBtnStyle
    End If
    If Len(IconStyle) Then
        GenStyle = GenStyle & " + " & IconStyle
    End If
    If Len(ModalStyle) Then
        GenStyle = GenStyle & " + " & ModalStyle
    End If
    GenerateStyleCode = GenStyle
End Function
' GenerateRtnCodeHandler()
Private Function GenerateRtnCodeHandler(ObjName As String) As String
    Dim GenHandler As String
    GenHandler = ""
    GenHandler = "Select Case " & ObjName & "Rtn" & vbCrLf
    Select Case GetButtonStyleOption()
        Case OPT_BTN_OK_ONLY
            GenHandler = GenHandler & "    Case vbOK" & vbCrLf
        Case OPT_BTN_OK_CANCEL
            GenHandler = GenHandler & "    Case vbOK" & vbCrLf
            GenHandler = GenHandler & "    Case vbCancel" & vbCrLf
        Case OPT_BTN_ABORT_RETRY_IGNORE
            GenHandler = GenHandler & "    Case vbAbort" & vbCrLf
            GenHandler = GenHandler & "    Case vbRetry" & vbCrLf
            GenHandler = GenHandler & "    Case vbIgnore" & vbCrLf
        Case OPT_BTN_YES_NO_CANCEL
            GenHandler = GenHandler & "    Case vbYes" & vbCrLf
            GenHandler = GenHandler & "    Case vbNo" & vbCrLf
            GenHandler = GenHandler & "    Case vbCancel" & vbCrLf
        Case OPT_BTN_YES_NO
            GenHandler = GenHandler & "    Case vbYes" & vbCrLf
            GenHandler = GenHandler & "    Case vbNo" & vbCrLf
        Case OPT_BTN_RETRY_CANCEL
            GenHandler = GenHandler & "    Case vbRetry" & vbCrLf
            GenHandler = GenHandler & "    Case vbCancel" & vbCrLf
        Case Else
    End Select
    GenHandler = GenHandler & "    Case Else" & vbCrLf
    GenHandler = GenHandler & "End Select"
    GenerateRtnCodeHandler = GenHandler
End Function