mdl2.bas

此为交通信号机的方案生成软件

Attribute VB_Name = "Mdl2"
   Global instring(1 To 4) As String
   Global steps As Integer
    Global DataMatrix(1 To 40, 1 To 40) As Integer
    Global go As Boolean
  
Public Function StringToVal(Str1 As String) As Long
         Dim qq() As Integer
         Dim i As Integer
         ReDim qq(1 To Len(Str1))
         For i = Len(Str1) To 1 Step -1
           Select Case Mid(Str1, i, 1)
             Case "1", "0", "2", "3", "4", "5", "6", "7", "8", "9"
             qq(Len(Str1) - i + 1) = Mid(Str1, i, 1)
                
             Case "A"
               qq(Len(Str1) - i + 1) = 10
             Case "B"
               qq(Len(Str1) - i + 1) = 11
             Case "C"
               qq(Len(Str1) - i + 1) = 12
             Case "D"
               qq(Len(Str1) - i + 1) = 13
             Case "E"
               qq(Len(Str1) - i + 1) = 14
             Case "F"
               qq(Len(Str1) - i + 1) = 15
           End Select
         Next
         StringToVal = 0
        For i = 1 To Len(Str1)
           StringToVal = StringToVal + qq(i) * 16 ^ (i - 1)
        Next
End Function


Public Function HexStringToBinString(Hex As String) As String
         Dim i As Integer
         Dim Str1, Str2 As String
         HexStringToBinString = ""
         For i = 1 To Len(Hex)
              Str1 = Mid(Hex, i, 1)
              Select Case Str1
                Case "0"
                Str2 = "0000"
                Case "1"
                Str2 = "0001"
                 Case "2"
                Str2 = "0010"
                Case "3"
                Str2 = "0011"
                 Case "4"
                Str2 = "0100"
                Case "5"
                Str2 = "0101"
                 Case "6"
                Str2 = "0110"
                Case "7"
                Str2 = "0111"
                 Case "8"
                Str2 = "1000"
                Case "9"
                Str2 = "1001"
                 Case "A"
                Str2 = "1010"
                Case "B"
                Str2 = "1011"
                 Case "C"
                Str2 = "1100"
                Case "D"
                Str2 = "1101"
                 Case "E"
                Str2 = "1110"
                Case "F"
                Str2 = "1111"
                End Select
              HexStringToBinString = HexStringToBinString + Str2
        Next i
End Function

Public Function BinStringToHexString(BinString As String) As String
        Dim Str1 As String
        Dim Str2 As String
        Dim i As Integer
        BinStringToHexString = ""
        For i = 1 To Len(BinString) / 4
            Str1 = Mid(BinString, (i - 1) * 4 + 1, 4)
            
            Select Case Str1
                Case "0000"
                    Str2 = "0"
                Case "0001"
                    Str2 = "1"
                Case "0010"
                    Str2 = "2"
                Case "0011"
                    Str2 = "3"
                Case "0100"
                    Str2 = "4"
                Case "0101"
                    Str2 = "5"
                Case "0110"
                    Str2 = "6"
                Case "0111"
                    Str2 = "7"
                Case "1000"
                    Str2 = "8"
                Case "1001"
                    Str2 = "9"
                Case "1010"
                    Str2 = "A"
                Case "1011"
                    Str2 = "B"
                Case "1100"
                    Str2 = "C"
                Case "1101"
                    Str2 = "D"
                Case "1110"
                    Str2 = "E"
                Case "1111"
                    Str2 = "F"
             End Select
             BinStringToHexString = BinStringToHexString + Str2
         Next i
End Function