mdlmadetext.bas

此为交通信号机

Attribute VB_Name = "MdlMadeText"
Option Explicit

Public Sub MadeLampColar(Mc As Integer, FirstTimes As Boolean)
       Dim Mr As Integer
       Dim String4 As String
       Dim String2 As String                        'String4 4个字符，String2 两个字符
       Dim ValString4 As Long
       Dim ValString2 As Long
       Dim HexString4 As String
       Dim HexString2 As String
       Dim BinString4 As String
       Dim BinString2 As String
       Dim Char As String
       Dim AddressNum As Integer
       Dim Str1 As String
       
       BinString4 = ""
       BinString2 = ""
       
       
        If Mc = 40 Then
            If FirstTimes = True Then
                ValString4 = 18724
                ValString2 = 146
            Else
                ValString4 = 8322
                ValString2 = 8
            End If
        Else
            For Mr = 1 To 32
                Char = Right(Str(DataMatrix(Mr, Mc)), 1)
                If FirstTimes = True Then
                    If Char = "2" Then
                        Char = "1"
                    End If
                Else
                    If Char = "2" Then
                        Char = "0"
                    End If
                End If
                BinString4 = Char + BinString4
            Next
            For Mr = 33 To 40
                Char = Right(Str(DataMatrix(Mr, Mc)), 1)
                If FirstTimes = True Then
                    If Char = "2" Then
                        Char = "1"
                    End If
                Else
                    If Char = "2" Then
                        Char = "0"
                    End If
                End If
                BinString2 = Char + BinString2
            Next
            HexString4 = Mdl3.BinStringToHexString(BinString4)
            HexString2 = Mdl3.BinStringToHexString(BinString2)
        
            '转化为十进制数据
            ValString4 = Mdl2.StringToVal(HexString4)
            If ValString4 >= 2 ^ 31 Then
                ValString4 = ValString4 Mod (2 ^ 31) '32768
                ValString4 = -ValString4
            End If
            ValString2 = Mdl2.StringToVal(HexString2)
       End If
       
       '确定地址
       If FirstTimes = True Then
            AddressNum = (Mc * 2 - 2) + 2000
       Else
            AddressNum = (Mc * 2 - 2) + 2064
       End If
        
       Str1 = "D" + Right(Str(AddressNum), 4)
       Print #1, Str1 + "        " + Str(Val(ValString4))
       
       Str1 = "D" + Right(Str(AddressNum + 1), 4)
       Print #1, Str1 + "        " + Str(Val(ValString2))
End Sub
Public Function MadeStateByte(Mc As Integer) As Boolean
      Dim ByteString As String
      Dim Mr As Integer
      Dim ValByte As Integer
      Dim AddressNum As Integer
      Dim Str1 As String
      
      '判断绿闪标志
      For Mr = 1 To 40
            If DataMatrix(Mr, Mc) = 2 Then
                ByteString = "1"
                Exit For
            Else
                ByteString = "0"
            End If
      Next
  If Mc > steps Then
      ValByte = 0
  Else
      
      '判断步伐检测
      FrmMain.GridScheme.row = 43
      FrmMain.GridScheme.col = Mc
      If FrmMain.GridScheme.Text = "1" Then
            ByteString = "01" + ByteString
      ElseIf FrmMain.GridScheme.Text = "2" Then
            ByteString = "10" + ByteString
      ElseIf FrmMain.GridScheme.Text = "3" Then
            ByteString = "11" + ByteString
      Else: MsgBox "方案表中步伐监测信息出错！"
            MadeStateByte = False
            Exit Function
      
      End If
      
      '判断跟踪否
      FrmMain.GridScheme.row = 42
      FrmMain.GridScheme.col = Mc
      If FrmMain.GridScheme.Text = "" Then
            ByteString = "0" + ByteString
      ElseIf FrmMain.GridScheme.Text = "0" Or FrmMain.GridScheme.Text = "1" Then
            ByteString = FrmMain.GridScheme.Text + ByteString
      Else
            MsgBox "方案表中跟踪步信息出错！"
            MadeStateByte = False
            Exit Function
      End If
      
      '判断可变步
      FrmMain.GridScheme.row = 41
      FrmMain.GridScheme.col = Mc
      ByteString = Mdl2.HexStringToBinString(Hex(Val(FrmMain.GridScheme.Text))) + ByteString
      
      ValByte = Mdl2.StringToVal(Mdl3.BinStringToHexString(ByteString))
 End If
      '计算地址
      AddressNum = 2127 + Mc
      
      Print #1, "D" + Right(Str(AddressNum), 4) + "        " + Str(ValByte)
      MadeStateByte = True
End Function
Public Function MadeStepLength(Mc As Integer) As Boolean
      Dim AddressNum As Integer
      Dim Str1 As String
      Dim StepLength As Integer
      
      If Mc > steps Then
         StepLength = 0
      Else
         FrmMain.GridScheme.row = 44
         FrmMain.GridScheme.col = Mc
         If Val(FrmMain.GridScheme.Text) = 0 Then
                MsgBox "保安时间信息出错！"
                MadeStepLength = False
                Exit Function
         Else
                StepLength = Val(FrmMain.GridScheme.Text)
         End If
      End If
      AddressNum = 2159 + Mc
      Print #1, "D" + Right(Str(AddressNum), 4) + "        " + Str(StepLength)
      MadeStepLength = True
End Function