⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 basmessages.bas

📁 a Tiger Hash algorithmn code
💻 BAS
字号:
Attribute VB_Name = "basMessages"
' *****************************************************************************
'  Module:      basMessages.bas
'
'  Purpose:     This module contains routines designed to provide standard
'               formatting for message boxes.
'
' *****************************************************************************
'                         Modifications
'  Date      Name             Description
' ********** **************** ************************************************
' 09/18/2002 Kenneth Ives     Original
' *****************************************************************************
Option Explicit

' *****************************************************************************
'  Routine:     InfoMsg
'
'  Description: Displays a VB MsgBox with no return values.  It is designed to
'               be used where no response from the user is expected other than
'               "OK".
'
'  Parameters:  strMsg - The message text
'               strCaption - The MsgBox caption (optional)
'
'  Returns:     None
'
' *****************************************************************************
'                         Modifications
'  Date      Name             Description
' ********** **************** *************************************************
' 09/18/2002 Kenneth Ives     Original
' *****************************************************************************
Public Sub InfoMsg(ByVal strMsg As String, _
          Optional ByVal strCaption As String = "")
                   
    Dim strNewCaption As String  ' Formatted MsgBox caption
                           
    ' Format the MsgBox caption
    strNewCaption = strFormatCaption(strCaption)
    
    ' the MsgBox routine
    MsgBox strMsg, vbInformation Or vbOKOnly, strNewCaption
    
End Sub


' *****************************************************************************
'  Routine:     ResponseMsg
'
'  Description: Displays a standard VB MsgBox and returns the MsgBox code. It
'               is designed to be used when the user is prompted for a
'               response.
'
'  Parameters:  strMsg - The message text
'               lngButtons - The standard VB MsgBox buttons (optional)
'               strCaption - The msgbox caption (optional)
'
'  Returns:     The standard VB MsgBox return values
'
' *****************************************************************************
'                         Modifications
'  Date      Name             Description
' ********** **************** *************************************************
' 09/18/2002 Kenneth Ives     Original
' *****************************************************************************
Public Function ResponseMsg(ByVal strMsg As String, _
                   Optional ByVal lngButtons As Long = vbQuestion + vbYesNo, _
                   Optional ByVal strCaption As String = "") As VbMsgBoxResult
    
    Dim strNewCaption As String  ' Formatted MsgBox caption
    
    ' Format the MsgBox caption
    strNewCaption = strFormatCaption(strCaption)
    
    ' the MsgBox routine and return the user's response
    ResponseMsg = MsgBox(strMsg, lngButtons, strNewCaption)
    
End Function

' *****************************************************************************
'  Routine:     ErrorMsg
'
'  Description: Displays a standard VB MsgBox formatted to display severe
'               (Usually application-type) error messages.
'
'  Parameters:  strModule - The module where the error occurred
'               strRoutine - The routine where the error occurred
'               strMsg - The error message
'               strCaption - The MsgBox caption  (optional)
'
'  Returns:     None
'
' *****************************************************************************
'                         Modifications
'  Date      Name             Description
' ********** **************** *************************************************
' 09/18/2002 Kenneth Ives     Original
' *****************************************************************************
Public Sub ErrorMsg(ByVal strModule As String, _
                    ByVal strRoutine As String, _
                    ByVal strMsg As String, _
           Optional ByVal strCaption As String = "")
                     
    Dim strNewCaption As String  ' Formatted MsgBox caption
    Dim strFullMsg As String     ' Formatted message
    
    ' Make sure strModule is populated
    If Len(Trim$(strModule)) = 0 Then
       strModule = "Unknown"
    End If
    
    ' Make sure strRoutine is populated
    If Len(Trim$(strRoutine)) = 0 Then
       strRoutine = "Unknown"
    End If
    
    ' Make sure strMsg is populated
    If Len(Trim$(strMsg)) = 0 Then
       strMsg = "Unknown"
    End If
    
    ' Format the MsgBox caption
    strNewCaption = strFormatCaption(strCaption, True)
    
    ' Format the message
    strFullMsg = "Module: " & vbTab & strModule & vbCr & _
                 "Routine:" & vbTab & strRoutine & vbCr & _
                 "Error:  " & vbTab & strMsg
                     
    ' the MsgBox routine
    MsgBox strFullMsg, vbCritical Or vbOKOnly, strNewCaption
    
End Sub

' *****************************************************************************
'  Routine:     FormatCaption
'
'  Description: Formats the caption text to use the application title as
'               default
'
'  Parameters:  strCaption - The input caption which may be appended to the
'                            application title.
'               bError - Add "Error" to the caption
'
'  Returns:     Formatted string to be used as a msgbox caption
'
' *****************************************************************************
'                         Modifications
'  Date      Name             Description
' ********** **************** *************************************************
' 09/18/2002 Kenneth Ives     Original
' *****************************************************************************
Private Function strFormatCaption(ByVal strCaption As String, _
                         Optional ByVal bError As Boolean = False) As String

    Dim strNewCaption As String  ' The formatted caption
    
    ' Set the caption to either input parm or the application name
    If Len(Trim$(strCaption)) > 0 Then
        strNewCaption = Trim$(strCaption)
    Else
        ' Set the caption default
        strNewCaption = App.EXEName
    End If
    
    ' Optionally, add error text
    If bError Then
        strNewCaption = strNewCaption & " Error"
    End If

    ' Return the new caption
    strFormatCaption = strNewCaption
    
End Function


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -