frm模拟.frm

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

VERSION 5.00
Begin VB.Form frm模拟 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "模拟XR2105"
   ClientHeight    =   2445
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2070
   Icon            =   "frm模拟.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2445
   ScaleWidth      =   2070
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame模拟屏 
      Caption         =   "模拟操作屏"
      Height          =   1215
      Left            =   30
      TabIndex        =   8
      Top             =   330
      Width           =   2055
      Begin VB.CommandButton cmdOperate 
         Caption         =   "停止"
         Enabled         =   0   'False
         Height          =   285
         Index           =   3
         Left            =   1020
         TabIndex        =   15
         Top             =   870
         Width           =   945
      End
      Begin VB.CommandButton cmdOperate 
         Caption         =   "启动"
         Enabled         =   0   'False
         Height          =   285
         Index           =   2
         Left            =   60
         TabIndex        =   14
         Top             =   870
         Width           =   945
      End
      Begin VB.Timer tmrOnComm2 
         Enabled         =   0   'False
         Left            =   870
         Top             =   360
      End
      Begin VB.CommandButton cmdOperate 
         Caption         =   "停料"
         Enabled         =   0   'False
         Height          =   285
         Index           =   1
         Left            =   1020
         TabIndex        =   12
         Top             =   540
         Width           =   945
      End
      Begin VB.ComboBox cmbAddr 
         Enabled         =   0   'False
         Height          =   300
         ItemData        =   "frm模拟.frx":0442
         Left            =   90
         List            =   "frm模拟.frx":0444
         TabIndex        =   11
         Text            =   "1"
         Top             =   210
         Width           =   750
      End
      Begin VB.CommandButton cmdOperate 
         Caption         =   "上料"
         Enabled         =   0   'False
         Height          =   285
         Index           =   0
         Left            =   60
         TabIndex        =   10
         Top             =   540
         Width           =   945
      End
      Begin VB.TextBox txtFlow 
         Alignment       =   1  'Right Justify
         Height          =   300
         Left            =   1410
         TabIndex        =   9
         Text            =   "600"
         Top             =   210
         Width           =   555
      End
      Begin VB.Label lblRndNumber 
         Caption         =   "流量:"
         Height          =   255
         Left            =   930
         TabIndex        =   13
         Top             =   240
         Width           =   495
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "设定流量"
      Height          =   855
      Left            =   30
      TabIndex        =   2
      Top             =   1590
      Width           =   2055
      Begin VB.TextBox txtSetValue 
         Alignment       =   1  'Right Justify
         Height          =   315
         Index           =   0
         Left            =   90
         TabIndex        =   5
         Text            =   "1"
         Top             =   480
         Width           =   465
      End
      Begin VB.CommandButton cmdSimulate 
         Caption         =   "设置"
         Height          =   315
         Index           =   3
         Left            =   1470
         TabIndex        =   4
         Top             =   480
         Width           =   555
      End
      Begin VB.TextBox txtSetValue 
         Alignment       =   1  'Right Justify
         Height          =   315
         Index           =   1
         Left            =   570
         TabIndex        =   3
         Text            =   "0.00"
         Top             =   480
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "站号"
         Height          =   285
         Left            =   120
         TabIndex        =   7
         Top             =   210
         Width           =   405
      End
      Begin VB.Label Label2 
         Caption         =   "流量"
         Height          =   255
         Left            =   840
         TabIndex        =   6
         Top             =   210
         Width           =   405
      End
   End
   Begin VB.CommandButton cmdSimulate 
      Caption         =   "结束模拟"
      Enabled         =   0   'False
      Height          =   315
      Index           =   1
      Left            =   1050
      TabIndex        =   1
      Top             =   0
      Width           =   945
   End
   Begin VB.CommandButton cmdSimulate 
      Caption         =   "开始模拟"
      Height          =   315
      Index           =   0
      Left            =   90
      TabIndex        =   0
      Top             =   0
      Width           =   945
   End
End
Attribute VB_Name = "frm模拟"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Option Explicit
'
'模块说明:
'
'目的:接受TechXR通信
'
'-------------- 模拟 ---------------------------------
Private RndNumber As Integer '模拟设置,0:按设定流量变化,其他:按随机流量变化
Private bMei() As Boolean '模拟上煤
Private simulateTotal() As Double '模拟主累计
Private simulateFlow() As Double '模拟流量(T/h)
Private simulateSpeed() As Double '模拟速度
'-------------- 模拟 ---------------------------------
Private WriteValue() As Single '写入仪表的值
'>0 为写入的值,=0 为不允许写的仪表,数组的索引为仪表的地址

'缺省属性值:
Const m_def_XRCount = TechCount
'属性变量:
Dim m_XRCount As Integer

'事件声明:
Event EvOnComm(ByVal ScanAddr As Integer, ByVal Total As Double, ByVal Flow As Double, ByVal Speed As Double, ByVal SetValue As Double)


Private Sub Form_Load()

    m_XRCount = m_def_XRCount
    '
    ReDim WriteValue(1 To m_XRCount) As Single '初始化写入仪表的设定流量数组
    Dim i As Integer
    For i = 1 To m_XRCount
        WriteValue(i) = GetSetting("模拟仪表", "设定", "WriteValue" & CStr(i), "0.00")
    Next i
    
    Call cmdSimulate_Click(0)
End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        If UnloadMode = vbFormControlMenu Then
            Cancel = 1
            Me.Hide

        Else
            Call cmdSimulate_Click(1)
        End If

End Sub

Private Sub tmrOnComm2_Timer() '200s
    '累计和流量
      Dim i As Integer
      
      Dim dblTotal As Double
      Dim dblRate  As Double
      Dim dblSpeed As Double
      Dim iAddr  As Integer
      '====================================
      
      Static outStr_Addr As Integer
      outStr_Addr = outStr_Addr Mod (m_XRCount) + 1
'            Debug.Print "ourAddr=" & CStr(iAddr)
      '=====================================
       iAddr = outStr_Addr 'CInt(outstr(2))
          '-------------输出站号----------------
   If Not ((iAddr < (m_XRCount + 1)) And (iAddr > 0)) Then Exit Sub '1..5
      '=====================================
        '--------------输出流量(T/h)---------------
        '--------------输出主累计---------------
    If bMei(iAddr) Then
        Select Case RndNumber
            Case 0 '设定值变化
                dblRate = Format(simulateFlow(iAddr), "#0.00")
            Case -1 '随机值变化
                Dim boundFlow As Integer
                boundFlow = simulateFlow(iAddr) * 0.1
                dblRate = Format(((2 * boundFlow + 1) * Rnd - boundFlow + simulateFlow(iAddr)), "#0.00")
'                dblRate = Format(Rnd(iAddr) * simulateFlow(iAddr), "#0.00")
'                Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        End Select
        simulateTotal(iAddr) = simulateTotal(iAddr) + dblRate / 18000 '[200ms,单位:T/h]= (Flow/3600)/5
    Else
        dblRate = 0
    End If
    dblTotal = simulateTotal(iAddr)
    dblSpeed = simulateSpeed(iAddr)
'    If iAddr = 3 Then Debug.Assert False
    RaiseEvent EvOnComm(iAddr, dblTotal, dblRate, dblSpeed, WriteValue(iAddr))
End Sub

Public Sub cmdOperate_Click(Index As Integer)
Dim simuAddr As Integer
On Error Resume Next
simuAddr = CInt(cmbAddr.Text)
If simuAddr < 1 Or (simuAddr > m_XRCount) Then simuAddr = 1
Select Case Index '
    Case 0 '上料
        bMei(simuAddr) = True
        cmdOperate(0).Enabled = False
        cmdOperate(1).Enabled = True
    Case 1 '停料
        bMei(simuAddr) = False
        cmdOperate(0).Enabled = True
        cmdOperate(1).Enabled = False
    Case 2 '启动
        simulateSpeed(simuAddr) = 2 + Rnd(simuAddr)
        cmdOperate(0).Enabled = True
        cmdOperate(2).Enabled = False
        cmdOperate(3).Enabled = True
    Case 3 '停止
        simulateSpeed(simuAddr) = 0
        bMei(simuAddr) = False
        cmdOperate(0).Enabled = False
        cmdOperate(1).Enabled = False
        cmdOperate(2).Enabled = True
        cmdOperate(3).Enabled = False
End Select
End Sub
Private Sub lblRndNumber_Click()
Dim msg As String
msg = "请输入流量显示的状态值:"
msg = msg & vbCr & "  0:按设置值变化"
msg = msg & vbCr & " -1:按随机值变化"
RndNumber = CBool(InputBox(msg, , 0))
End Sub


Private Sub txtFlow_LostFocus()
    Dim simuAddr As Integer
    On Error Resume Next
    simuAddr = CInt(cmbAddr.Text)
    If simuAddr < 1 Or (simuAddr > m_XRCount) Then simuAddr = 1
    If Val(txtFlow.Text) > 0 Then
        simulateFlow(simuAddr) = Val(txtFlow.Text)
    End If
    End Sub

Private Sub cmbAddr_Click()
    Dim simuAddr As Integer
    On Error Resume Next
    simuAddr = CInt(cmbAddr.Text)
    If simuAddr < 1 Or (simuAddr > m_XRCount) Then simuAddr = 1
    txtFlow.Text = simulateFlow(simuAddr)
    cmdOperate(0).Enabled = Not bMei(simuAddr)
    cmdOperate(1).Enabled = bMei(simuAddr)
    cmdOperate(2).Enabled = Not (simulateSpeed(simuAddr) > 0)
    cmdOperate(3).Enabled = (simulateSpeed(simuAddr) > 0)
End Sub
Public Property Let LogDiretory(ByVal New_LogDiretory As String)
    '只是模拟属性,
End Property

Public Property Let DenyManipulate(ByVal New_DenyManipulate As Boolean)
    '只是模拟属性,
End Property

Public Sub OpenCommPort(Optional ByVal Port As Integer = 0)
'打开串口通信,使用:程序开始,或重新给出新的串口
    Call cmdSimulate_Click(0)
End Sub
Private Sub cmdSimulate_Click(Index As Integer)
Dim i As Integer
Select Case Index
    Case 0 '开始模拟
    cmdSimulate(0).Enabled = False
    cmdSimulate(1).Enabled = True
    cmbAddr.Enabled = True
    cmdOperate(2).Enabled = True
    
    ReDim bMei(1 To m_XRCount) As Boolean
    ReDim simulateTotal(1 To m_XRCount) As Double
    ReDim simulateFlow(1 To m_XRCount) As Double
    ReDim simulateSpeed(1 To m_XRCount) As Double
    '仪表地址
    cmbAddr.Clear
    For i = 1 To m_XRCount
       cmbAddr.AddItem CStr(i)
    Next i
    cmbAddr.ListIndex = 0
    '平均流量
    For i = 1 To m_XRCount
        simulateFlow(i) = GetSetting("模拟仪表", "流量", "simulateFlow" & CStr(i), 600)
    Next i
    txtFlow.Text = simulateFlow(1)
    '主累计起点
    For i = 1 To m_XRCount
        simulateTotal(i) = GetSetting("模拟仪表", "主累计", "simulateStartTotal" & CStr(i), 0)
    Next i
    
    tmrOnComm2.Interval = 200
    tmrOnComm2.Enabled = True
    Case 1 '结束模拟
    cmdSimulate(0).Enabled = True
    cmdSimulate(1).Enabled = False
    cmbAddr.Enabled = False
    cmdOperate(0).Enabled = False
    cmdOperate(1).Enabled = False
    cmdOperate(2).Enabled = False
    cmdOperate(3).Enabled = False
    tmrOnComm2.Enabled = False
    For i = 1 To m_XRCount
        Call SaveSetting("模拟仪表", "主累计", "simulateStartTotal" & CStr(i), simulateTotal(i))
        Call SaveSetting("模拟仪表", "流量", "simulateFlow" & CStr(i), simulateFlow(i))
    Next i
    Case 3 '设置流量
        Call WriteXR(txtSetValue(0).Text, txtSetValue(1).Text)
End Select
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=5
Public Sub WriteXR(ByVal Addr As Integer, ByVal Value As Single)
    If Value >= 1 Then '写入<1 的值没有意义
        WriteValue(Addr) = Value
        Call SaveSetting("模拟仪表", "设定", "WriteValue" & CStr(Addr), Value)
    End If
End Sub