VB6.0 中 如何做一个好看点的 MsgBox InputBox.

vb 中提供了 msgbox用来推消息，inputbox用来输入信息，但是都不美观，字体太小

自己重新做了一个稍微好看点的，这里记录下。

1、新建一个Dialog 窗口，BorderStyle 为 3-Fixed Dialog ，窗口里面控件清单见下图

其中Label_test  的AutoSize属性为True ，Visible属性为False

2、Dialog 窗口 代码为

Option Explicit

Public Style As String     '用于传递给Dialog窗口
Public PostMsg As String   '用于传递给Dialog窗口TextBox内容
Public RetVal As Variant   '用于返回Dialog窗口信息
Const vbInputBox = -1


Private Sub Form_Load()
    Dim i, TxtLine, TxtHeight As Integer
    Dim Stemp() As String
    
    Stemp = Split(Style, "|")
    Text1.Alignment = CInt(Stemp(1))
    Dialog.Width = CInt(Stemp(2))
    Text1.BorderStyle = CInt(Stemp(3))
    Text1.BackColor = CLng(Stemp(4))
    Dialog.Caption = Stemp(5)
    
    
    Text1.Width = Dialog.Width - 500
    Text1.Left = Int((Dialog.Width - Text1.Width) / 2) - 40
    If Int(Stemp(0)) = vbInputBox Then
        Text1.Height = SetTextBoxHeight(PostMsg, True)
    Else
        Text1.Height = SetTextBoxHeight(PostMsg)
    End If
    
    Text1.Text = PostMsg
    
    Select Case Int(Stemp(0))
        Case vbOKOnly
            RetVal = vbCancel
            OKButton.Visible = True
            CancelButton.Visible = False
            Text_InputBox.Visible = False
            Text_InputBox.Top = Text1.Top + Text1.Height - Text_InputBox.Height
            Text_InputBox.Width = Dialog.Width - 1000
            Text_InputBox.Left = Int((Dialog.Width - Text_InputBox.Width) / 2)
            OKButton.Left = Int((Dialog.Width - OKButton.Width) / 2)
            OKButton.Top = Text_InputBox.Top + Text_InputBox.Height + 100
            CancelButton.Top = OKButton.Top
            CancelButton.Left = OKButton.Left + OKButton.Width + 200
        Case vbOKCancel
            RetVal = vbCancel
            OKButton.Visible = True
            CancelButton.Visible = True
            Text_InputBox.Visible = False
            Text_InputBox.Top = Text1.Top + Text1.Height - Text_InputBox.Height
            Text_InputBox.Width = Dialog.Width - 1000
            Text_InputBox.Left = Int((Dialog.Width - Text_InputBox.Width) / 2)
            OKButton.Left = Int((Dialog.Width - OKButton.Width - CancelButton.Width - 200) / 2)
            OKButton.Top = Text_InputBox.Top + Text_InputBox.Height + 100
            CancelButton.Top = OKButton.Top
            CancelButton.Left = OKButton.Left + OKButton.Width + 200
        Case vbInputBox
            RetVal = ""
            OKButton.Visible = True
            CancelButton.Visible = True
            Text_InputBox.Visible = True
            Text_InputBox.Top = Text1.Top + Text1.Height + 200
            Text_InputBox.Width = Dialog.Width - 1000
            Text_InputBox.Left = Int((Dialog.Width - Text_InputBox.Width) / 2)
            Text_InputBox.Text = Stemp(6)
            OKButton.Left = Int((Dialog.Width - OKButton.Width - CancelButton.Width - 200) / 2)
            OKButton.Top = Text_InputBox.Top + Text_InputBox.Height + 100
            CancelButton.Top = OKButton.Top
            CancelButton.Left = OKButton.Left + OKButton.Width + 200
            
            
    End Select
    
    Dialog.Height = OKButton.Top + OKButton.Height + 600
    Dialog.Left = Form1.Left + (Form1.Width - Dialog.Width) / 2
    Dialog.Top = Form1.Top + (Form1.Height - Dialog.Height) / 2
End Sub

Private Sub CancelButton_Click()
    Dim Stemp() As String
    
    Stemp = Split(Style, "|")
    Select Case Int(Stemp(0))
        Case vbOKOnly, vbOKCancel
            RetVal = vbCancel
        Case vbInputBox
            RetVal = ""
    End Select
    Unload Me
End Sub
Private Sub OKButton_Click()
    Dim Stemp() As String
    
    Stemp = Split(Style, "|")
    Select Case Int(Stemp(0))
        Case vbOKOnly, vbOKCancel
            RetVal = vbOK
        Case vbInputBox
            RetVal = Text_InputBox.Text
    End Select
    Unload Me
End Sub

'确定文本框的高度
Private Function SetTextBoxHeight(ByVal TXT As String, Optional ByVal AutoJudge As Boolean = False) As Integer
    Dim i, TxtHeight As Integer
    Dim Stemp() As String

    Stemp = Split(TXT, vbCrLf)
    TxtHeight = 0
    For i = 0 To UBound(Stemp)
        Label_test.Caption = Stemp(i)
        TxtHeight = TxtHeight + (Int(Label_test.Width / Text1.Width) + 1) * Label_test.Height
    Next
    If TxtHeight > Text1.Height Or AutoJudge = True Then
        SetTextBoxHeight = TxtHeight
    Else
        SetTextBoxHeight = Text1.Height
    End If
End Function

3、在主界面中重写 msgbox 和 inputbox 函数，我这里定义为 MyMsgBox 和 MyInputBox

Option Explicit

Const vbInputBox = -1

'优化的信息提示框
Public Function MyMsgBox(ByVal TXT As String, Optional ByVal Style As Integer = vbOKOnly, Optional ByVal WinTitle As String = "告警窗", Optional ByVal Alignment As Integer = vbCenter, _
                    Optional ByVal WinWidth As Integer = 5000, Optional ByVal BoderStyle As Integer = 0, Optional ByVal BackColor As Long = &H8000000F) As Integer
    Dialog.Style = Trim(str(Style)) & "|" & Trim(str(Alignment)) & "|" & Trim(str(WinWidth)) & "|" & Trim(str(BoderStyle)) & "|" & Trim(str(BackColor)) & "|" & WinTitle
    Dialog.PostMsg = TXT
    Dialog.Show 1
    MyMsgBox = Dialog.RetVal
End Function

'优化的inputbox框
Public Function MyInputBox(ByVal TXT As String, Optional ByVal WinTitle As String = "输入窗口", Optional ByVal DefaultTXT As String = "", Optional ByVal Alignment As Integer = vbCenter, _
                    Optional ByVal WinWidth As Integer = 8000, Optional ByVal BoderStyle As Integer = 0, Optional ByVal BackColor As Long = &H8000000F) As String
    Dim Style As Integer
    
    Style = vbInputBox
    Dialog.Style = Trim(str(Style)) & "|" & Trim(str(Alignment)) & "|" & Trim(str(WinWidth)) & "|" & Trim(str(BoderStyle)) & "|" & Trim(str(BackColor)) & "|" & WinTitle & "|" & DefaultTXT
    Dialog.PostMsg = TXT
    Dialog.Show 1
    MyInputBox = Dialog.RetVal
End Function

4、具体调用格式：

Private Sub Command1_Click()
    Dim S As String
    
    S = "选择题题目格式要求：" & vbCrLf & vbCrLf & _
        "序号+“|”+题目+“|”+选项1 +“|”+选项2+“|”+选项3+“|”+选项4+“|”+题目答案" & vbCrLf & vbCrLf & _
        "判断题格式要求:" & vbCrLf & vbCrLf & _
        "序号+“|”+题目+“|”+答案 ，   案例： 1|14.巡察组是各级纪委派出，对纪委负责。|错误" & vbCrLf & vbCrLf & _
        "注意:" & vbCrLf & vbCrLf & _
        "1、选择题选项最多为8个，答案格式是A-H的字母。如下所示单选题和多选题案例" & vbCrLf & vbCrLf & _
        "   2|电容式电压互感器中的阻尼器的作用是(  )。|A.产生铁磁谐振|B.分担二次压降|C.改变二次阻抗角|D.消除铁磁谐振|D" & vbCrLf & vbCrLf & _
        "   3|220kV并联电抗器的作用有(  )。|A.吸收容性无功|B.限制短路电流|C.改善线路电压|D.限制高次谐波|AC" & vbCrLf & vbCrLf & _
        "2、题目需保存为ANSI编码的TXT文本，文件名中必须带“单选题”或“多选题”或“判断题”关键字" & vbCrLf & vbCrLf
    Debug.Print MyMsgBox(S, vbOKOnly, "题目格式说明", vbLeftJustify, 9000, 1, &H8000000E)
    Debug.Print MyMsgBox ("FTP连接失败", vbOKOnly, "提示")
    Debug.Print MyMsgBox("即将下载  文件，请确认！", vbOKCancel, "下载信息确认")
    Debug.Print MyInputBox("请输入在FTP上需创建的目录的名称", "创建目录")
End Sub