dialog.frm

这是一个实际的工程中所用的源程序

VERSION 5.00
Begin VB.Form Dialog 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "对话框标题"
   ClientHeight    =   2340
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   3720
   Icon            =   "Dialog.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2340
   ScaleWidth      =   3720
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox txtValue 
      Height          =   375
      IMEMode         =   1  'ON
      Left            =   60
      TabIndex        =   1
      Top             =   1410
      Width           =   3585
   End
   Begin VB.CommandButton ApplyButton 
      Caption         =   "应用"
      Height          =   375
      Left            =   1350
      TabIndex        =   3
      Top             =   1920
      Width           =   900
   End
   Begin VB.CommandButton CancelButton 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   2400
      TabIndex        =   4
      Top             =   1920
      Width           =   900
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   330
      TabIndex        =   2
      Top             =   1920
      Width           =   900
   End
   Begin VB.Label lblMsg 
      Caption         =   "Label1"
      Height          =   1185
      Left            =   120
      TabIndex        =   0
      Top             =   60
      Width           =   3495
   End
End
Attribute VB_Name = "Dialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public Enum enumApply
    regApplyTechName = 1
    regApplyPortWL = 2
    regApplyPort = 3
    regApplyMima = 4
    regApplyNewMima = 5
    regApplyFlowScale = 7
    regApplyFlowWidth = 8
    regApplyCompanyName = 9
    regApplyScd = 10
End Enum
Private bWillChange As Boolean
Private m_Apply As enumApply
Private m_Param
Private m_Default


Public Sub initApply(ByVal Apply As enumApply, Optional ByVal Param As Integer)
    m_Apply = Apply
    If m_Apply = regApplyTechName Then  '仪表名称
        m_Param = Param
        Call initTechName
    ElseIf m_Apply = regApplyPort Then '串口
        Call initPort
    ElseIf m_Apply = regApplyPortWL Then '串口
        Call initPortWL
    ElseIf m_Apply = regApplyMima Then
        Call initMima
    ElseIf m_Apply = regApplyNewMima Then
        Call initNewMima
    ElseIf m_Apply = regApplyFlowScale Then '流量刻度
        Call initFlowScale
    ElseIf m_Apply = regApplyFlowWidth Then '流量刻度
        Call initFlowWidth
    ElseIf m_Apply = regApplyCompanyName Then '公司名称
        Call initCompanyName
    ElseIf m_Apply = regApplyScd Then
        m_Param = Param
        Call initScd
    End If
End Sub


Private Sub ApplyButton_Click()
        If m_Apply = regApplyTechName Then
            Call ValidateTechName
        ElseIf m_Apply = regApplyPort Then
            Call validatePort
        ElseIf m_Apply = regApplyPortWL Then
            Call validatePortWL
        ElseIf m_Apply = regApplyMima Then
            Call ValidateMima
        ElseIf m_Apply = regApplyNewMima Then
            Call ValidateNewMima
        ElseIf m_Apply = regApplyFlowScale Then
            Call ValidateFlowScale
        ElseIf m_Apply = regApplyFlowWidth Then
            Call ValidateFlowWidth
        ElseIf m_Apply = regApplyCompanyName Then
            Call ValidateCompanyName
        ElseIf m_Apply = regApplyScd Then
            Call ValidateScd
        End If
    If bWillChange Then
        If m_Apply = regApplyTechName Then
                Call ApplyTechName
        ElseIf m_Apply = regApplyPort Then
                Call ApplyPort
        ElseIf m_Apply = regApplyPortWL Then
                Call ApplyPortWL
        ElseIf m_Apply = regApplyMima Then
                Call ApplyMima
        ElseIf m_Apply = regApplyNewMima Then
                Call ApplyNewMima
        ElseIf m_Apply = regApplyFlowScale Then
                Call ApplyFlowScale
        ElseIf m_Apply = regApplyFlowWidth Then
                Call ApplyFlowWidth
        ElseIf m_Apply = regApplyCompanyName Then
                Call ApplyCompanyName
        ElseIf m_Apply = regApplyScd Then
                Call ApplyScd
        End If
    End If
End Sub

Private Sub CancelButton_Click()
Unload Me
End Sub


Private Sub OKButton_Click()
ApplyButton_Click
Unload Me
End Sub

Private Sub txtValue_Change()
    bWillChange = True
End Sub
Private Sub initNewMima()
    Dim msg As String
    msg = "请输入新的口令:" & _
        vbCrLf & "(只能输入字母（a..z,A..Z），且不超过十个)"
    Me.Caption = "设置口令"
    lblMsg.Caption = msg
    txtValue.Alignment = 0
'    txtValue.PasswordChar = "*"
    txtValue.Text = "" ' pMima
End Sub
Private Sub initMima()
    Dim msg As String
    msg = "请输入口令:"
    Me.Caption = "口令"
    lblMsg.Caption = msg
    txtValue.Alignment = 0
    txtValue.PasswordChar = "*"
    txtValue.Text = "******"
End Sub
Private Sub ValidateNewMima()
    Dim bOK As Boolean
    Dim ch As String * 1
    If Len(Trim(txtValue.Text)) = 0 Or Len(Trim(txtValue.Text)) > 10 Then
        bOK = False
    Else
        Dim i As Integer
        bOK = True
        For i = 1 To Len(txtValue.Text)
            ch = Mid(txtValue.Text, i, 1)
            If Not (((Asc(ch) >= Asc("A")) And (Asc(ch) <= Asc("Z"))) Or _
               ((Asc(ch) >= Asc("a")) And (Asc(ch) <= Asc("z")))) Then
               bOK = False
               Exit For
            End If
        Next i
    End If
    bWillChange = bOK And bWillChange
    If Not bOK Then
        MsgBox "输入的口令无效！", vbExclamation, "口令"
    End If
End Sub
Private Sub ValidateMima()
    Dim bOK As Boolean
    If Len(Trim(txtValue.Text)) = 0 Or Len(Trim(txtValue.Text)) > 10 Then
        bOK = False
    Else
        bOK = True
    End If
    bWillChange = bOK And bWillChange
    If Not bOK Then
        MsgBox "输入的口令无效！", vbExclamation, "口令"
    End If
End Sub

Private Sub ApplyNewMima()
    Dim jmMima As String
    pMima = UCase(Trim(txtValue.Text))
    jmMima = getMima(True, pMima)
    SaveSetting App.Title, "设置", "Mima", jmMima
End Sub
Private Sub ApplyMima()
    Dim bMimaOK As Boolean  '设置
    Dim strMima As String
    strMima = UCase(Trim(txtValue.Text))
    
    bMimaOK = (strMima = pMima) Or (strMima = "RAMSEY")
    If bMimaOK Then
'        Call fQM.EnableMenu(True)
    Else
        MsgBox "口令错误！", vbExclamation, "口令"
    End If
    
End Sub
Private Sub initPort()
    Dim msg As String
    msg = "请输入仪表通信的串口(有效值:3,4):"
    Me.Caption = "串口设置"
    lblMsg.Caption = msg
    txtValue.Alignment = 1
    txtValue.Text = COMM_PORT1
End Sub
Private Sub initPortWL()
    Dim msg As String
    msg = "请输入调度室通信的串口(有效值:3,4):"
    Me.Caption = "串口设置"
    lblMsg.Caption = msg
    txtValue.Alignment = 1
    txtValue.Text = COMM_PORT2
End Sub
Private Sub validatePort()
    Dim bOK As Boolean
    
    If Not IsNumeric(txtValue.Text) Then
        bOK = False
        txtValue.SetFocus
        MsgBox "要求输入数字！", vbExclamation, Me.Caption
    Else
        If (Val(txtValue.Text) < 10) And (Val(txtValue.Text) > 0) Then
            bOK = True
        Else
            bOK = False
            MsgBox "输入的数值无效！", vbExclamation, "串口"
        End If
    End If
    bWillChange = bOK And bWillChange
End Sub
Private Sub validatePortWL()
    Dim bOK As Boolean
    
    If Not IsNumeric(txtValue.Text) Then
        bOK = False
        txtValue.SetFocus
        MsgBox "要求输入数字！", vbExclamation, Me.Caption
    Else
        If (Val(txtValue.Text) < 10) And (Val(txtValue.Text) > 0) Then
            bOK = True
        Else
            bOK = False
            MsgBox "输入的数值无效！", vbExclamation, "串口"
        End If
    End If
    bWillChange = bOK And bWillChange
End Sub
Private Sub ApplyPort()
    COMM_PORT1 = CInt(txtValue.Text)
    SaveSetting App.Title, Sc_Comm, "秤仪表", COMM_PORT1
    Call MsgBox("须重新启动程序后,设置才能生效!", vbInformation, App.Title)
End Sub
Private Sub ApplyPortWL()
    COMM_PORT2 = CInt(txtValue.Text)
    SaveSetting App.Title, Sc_Comm, "调度室", COMM_PORT2
    Call MsgBox("须重新启动程序后,设置才能生效!", vbInformation, App.Title)
End Sub
Private Sub initCompanyName()
    Dim msg As String
    msg = "请输入单位名称:"
    Me.Caption = "单位名称"
    lblMsg.Caption = msg
    txtValue.Alignment = 0
    txtValue.Text = App_CompanyName
End Sub
Private Sub ValidateCompanyName()
    Dim bOK As Boolean
    If Len(Trim(txtValue.Text)) = 0 Then
        bOK = False
    Else
        bOK = True
    End If
    bWillChange = bOK And bWillChange
End Sub
Private Sub ApplyCompanyName()
        App_CompanyName = Trim(txtValue.Text)
        SaveSetting App.Title, "名称", "公司名称", App_CompanyName
        frmMDI.Caption = App.Title + "(" + CStr(App_Major) + CStr(App_Minor) + CStr(App_Revision) + ")" + "  使用于 " + App_CompanyName
        fQM.lblCorp.Caption = App_CompanyName & App_Title
End Sub
Private Sub initTechName()
    Dim msg As String
    msg = "请输入仪表名称:"
    Me.Caption = "仪表名称"
    lblMsg.Caption = msg
    txtValue.Alignment = 0
    txtValue.Text = NameTech(m_Param)
End Sub
Private Sub ValidateTechName()
    Dim bOK As Boolean
    If Trim(txtValue.Text) = "" Or Len(Trim(txtValue.Text)) > 10 Then
        bOK = False
    Else
        bOK = True
    End If
    bWillChange = bOK And bWillChange

End Sub
Private Sub ApplyTechName()
'    RaiseEvent ApplyTechName(Trim(txtValue.Text), m_Param)
End Sub

Private Sub initFlowScale()
    Dim msg As String
    msg = "请输入流量曲线的分度:"
    Me.Caption = "流量曲线分度"
    lblMsg.Caption = msg
    txtValue.Alignment = 1
    txtValue.Text = pFlowScale
End Sub

Private Sub ValidateFlowScale()
    Dim bOK As Boolean
    If Not IsNumeric(txtValue.Text) Then
        bOK = False
        txtValue.SetFocus
        MsgBox "要求输入数字！", vbExclamation, Me.Caption
    Else
        If (Val(txtValue.Text) <= 1000) And (Val(txtValue.Text) >= 5) Then
            bOK = True
        Else
            bOK = False
            MsgBox "输入的数值无效！", vbExclamation, "流量分度"
        End If
    End If
    bWillChange = bOK And bWillChange
End Sub
Private Sub ApplyFlowScale()
    pFlowScale = CInt(txtValue.Text)
    SaveSetting App.Title, SectionFlow, "流量曲线分度", CStr(pFlowScale)
'    With frmFlow.ctl流量曲线1
'        .刻度单位 = pFlowScale
'    End With
End Sub

Private Sub initFlowWidth()
    Dim msg As String
    msg = "请输入流量曲线的线宽:"
    Me.Caption = "流量曲线线宽"
    lblMsg.Caption = msg
    txtValue.Alignment = 1
    txtValue.Text = pFlowWidth
End Sub

Private Sub ValidateFlowWidth()
    Dim bOK As Boolean
    If Not IsNumeric(txtValue.Text) Then
        bOK = False
        txtValue.SetFocus
        MsgBox "要求输入数字！", vbExclamation, Me.Caption
    Else
        If (Val(txtValue.Text) <= 600) And (Val(txtValue.Text) >= 15) Then
            bOK = True
        Else
            bOK = False
            MsgBox "输入的数值无效！", vbExclamation, "流量分度"
        End If
    End If
    bWillChange = bOK And bWillChange
End Sub
Private Sub ApplyFlowWidth()
    pFlowWidth = CInt(txtValue.Text)
    SaveSetting App.Title, SectionFlow, "流量曲线线宽", CStr(pFlowWidth)
'    With frmFlow.ctl流量曲线1
'        .线宽 = pFlowWidth
'    End With
End Sub
Private Sub initScd()
    Dim msg As String
    msg = "请输入煤从仪表输送到船所需要的时间(单位:s):"
    Me.Caption = "到船时间"
    lblMsg.Caption = msg
    txtValue.Alignment = 1
    'm_Default = fQM.Shop2(m_Param).Scd
    txtValue.Text = m_Default
End Sub
Private Sub ValidateScd()
    Dim bOK As Boolean
    If Not IsNumeric(txtValue.Text) Then
        bOK = False
        txtValue.SetFocus
        MsgBox "要求输入数字！", vbExclamation, Me.Caption
    Else
        If (Val(txtValue.Text) <= DefaultUpperSecond) And (Val(txtValue.Text) >= 0) Then
            bOK = True
        Else
            bOK = False
            MsgBox "输入的数值无效！", vbExclamation, "流量分度"
        End If
    End If
    bWillChange = bOK And bWillChange
End Sub
Private Sub ApplyScd()
    Dim d As Long
    d = CLng(txtValue.Text)
    If d <> m_Default Then
        'fQM.Shop2(m_Param).Scd = d
        frmMDI.mnuScd(m_Param).Caption = NameTech(m_Param) & "(" & CStr(d) & " 秒)"
        MsgBox "新的到船时间设置是：" & CStr(d) & " 秒."
    End If
End Sub