publicfun_module.bas

应用研究计算上的许多地方上用的到的算法

Attribute VB_Name = "PublicFun_Module"
Option Explicit
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Sub main()
    If App.PrevInstance = True Then
        MsgBox LoadResString(146), , LoadResString(124)
        Exit Sub
    End If
    Form1.Show 1
End Sub
Public Sub InterfaceInit()
    Dim i As Byte
    Form1.Caption = LoadResString(101)
    Form1.mnuexit.Caption = LoadResString(102)
    Form1.mnuhelp.Caption = LoadResString(103)
    Form1.mnuContents.Caption = LoadResString(104)
    Form1.mnuabout.Caption = LoadResString(105)
    Form1.mnufile.Caption = LoadResString(106)
    Form1.mnuSearch.Caption = LoadResString(107)
    If isEnglish = False Then
        Form1.Frame.Width = 3015
        Form1.Label13.Left = 1440
        Form1.Combo_baud.Left = 1440
        Form1.Label15.Left = 1440
        Form1.Label18.Left = 1440
        Form1.Label17.Left = 1440
        Form1.Label16.Left = 1440
        Form1.Text3.Left = 1440
    Else
        Form1.Frame.Width = 3855
        Form1.Label13.Left = 2400
        Form1.Combo_baud.Left = 2400
        Form1.Label15.Left = 2400
        Form1.Label18.Left = 2400
        Form1.Label17.Left = 2400
        Form1.Label16.Left = 2400
        Form1.Text3.Left = 2400
    End If
    Form1.Frame.Caption = LoadResString(115)
    Form1.Label24.Caption = LoadResString(108)
    Form1.Label23.Caption = LoadResString(109)
    Form1.Label14.Caption = LoadResString(110)
    Form1.Label21.Caption = LoadResString(111)
    Form1.Label22.Caption = LoadResString(112)
    Form1.Label20.Caption = LoadResString(113)
    Form1.Label19.Caption = LoadResString(114)
    
    Form1.Frame2(0).Caption = LoadResString(130)
    Form1.Full_Lab(0).Caption = LoadResString(119)
    Form1.Label1(0).Caption = LoadResString(117)
    Form1.Label1(2).Caption = LoadResString(131)
    Form1.Label1(3).Caption = LoadResString(132)
    Form1.Label1(4).Caption = LoadResString(133)
    Form1.Check1(0).Caption = LoadResString(134)
    Form1.Command2(1).Caption = LoadResString(135)
    
    Form1.Frame2(1).Caption = LoadResString(130)
   ' Form1.Full_Lab(1).Caption = LoadResString(136)
    Form1.Label1(9).Caption = LoadResString(117)
    Form1.Label1(7).Caption = LoadResString(131)
    Form1.Label1(6).Caption = LoadResString(132)
    Form1.Label1(5).Caption = LoadResString(133)
    Form1.Check1(1).Caption = LoadResString(134)
    Form1.Command2(3).Caption = LoadResString(135)
    
    Form1.Frame2(2).Caption = LoadResString(130)
  '  Form1.Full_Lab(2).Caption = LoadResString(137)
    Form1.Label1(14).Caption = LoadResString(117)
    Form1.Label1(12).Caption = LoadResString(131)
    Form1.Label1(11).Caption = LoadResString(132)
    Form1.Label1(10).Caption = LoadResString(133)
    Form1.Check1(2).Caption = LoadResString(134)
    Form1.Command2(5).Caption = LoadResString(135)
    
    Form1.Frame2(3).Caption = LoadResString(130)
   ' Form1.Full_Lab(3).Caption = LoadResString(138)
    Form1.Label1(15).Caption = LoadResString(117)
    Form1.Label1(17).Caption = LoadResString(131)
    Form1.Label1(18).Caption = LoadResString(132)
    Form1.Label1(19).Caption = LoadResString(133)
    Form1.Check1(3).Caption = LoadResString(134)
    Form1.Command2(7).Caption = LoadResString(135)
    
    Form1.Frame2(4).Caption = LoadResString(130)
  '  Form1.Full_Lab(4).Caption = LoadResString(139)
    Form1.Label1(20).Caption = LoadResString(117)
    Form1.Label1(22).Caption = LoadResString(131)
    Form1.Label1(23).Caption = LoadResString(132)
    Form1.Label1(24).Caption = LoadResString(133)
    Form1.Check1(4).Caption = LoadResString(134)
    Form1.Command2(9).Caption = LoadResString(135)
    
    Form1.Frame2(5).Caption = LoadResString(130)
   ' Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(25).Caption = LoadResString(117)
    Form1.Label1(27).Caption = LoadResString(131)
    Form1.Label1(28).Caption = LoadResString(132)
    Form1.Label1(29).Caption = LoadResString(133)
    Form1.Check1(5).Caption = LoadResString(134)
    Form1.Command2(11).Caption = LoadResString(135)
    
    Form1.Frame2(6).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(34).Caption = LoadResString(117)
    Form1.Label1(32).Caption = LoadResString(131)
    Form1.Label1(31).Caption = LoadResString(132)
    Form1.Label1(30).Caption = LoadResString(133)
    Form1.Check1(6).Caption = LoadResString(134)
    Form1.Command2(13).Caption = LoadResString(135)
    
    Form1.Frame2(7).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(35).Caption = LoadResString(117)
    Form1.Label1(37).Caption = LoadResString(131)
    Form1.Label1(38).Caption = LoadResString(132)
    Form1.Label1(39).Caption = LoadResString(133)
    Form1.Check1(7).Caption = LoadResString(134)
    Form1.Command2(15).Caption = LoadResString(135)
    
    Form1.Frame2(8).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(44).Caption = LoadResString(117)
    Form1.Label1(42).Caption = LoadResString(131)
    Form1.Label1(41).Caption = LoadResString(132)
    Form1.Label1(40).Caption = LoadResString(133)
    Form1.Check1(8).Caption = LoadResString(134)
    Form1.Command2(17).Caption = LoadResString(135)
    
    Form1.Frame2(9).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(45).Caption = LoadResString(117)
    Form1.Label1(47).Caption = LoadResString(131)
    Form1.Label1(48).Caption = LoadResString(132)
    Form1.Label1(49).Caption = LoadResString(133)
    Form1.Check1(9).Caption = LoadResString(134)
    Form1.Command2(19).Caption = LoadResString(135)
    
    Form1.Label4(0).Caption = LoadResString(153)
    Form1.Label4(1).Caption = LoadResString(153)
    Form1.Label4(2).Caption = LoadResString(153)
    Form1.Label4(3).Caption = LoadResString(153)
    Form1.Label4(4).Caption = LoadResString(153)
    Form1.Label4(5).Caption = LoadResString(153)
    Form1.Label4(6).Caption = LoadResString(153)
    Form1.Label4(7).Caption = LoadResString(153)
    Form1.Label4(8).Caption = LoadResString(153)
    Form1.Label4(9).Caption = LoadResString(153)
    Form1.Label4(10).Caption = LoadResString(153)
    Form1.Label4(11).Caption = LoadResString(153)
    Form1.Label4(12).Caption = LoadResString(153)
    
    Form1.Label5(0).Caption = LoadResString(109)
    Form1.Label5(1).Caption = LoadResString(109)
    Form1.Label5(2).Caption = LoadResString(109)
    Form1.Label5(3).Caption = LoadResString(109)
    Form1.Label5(4).Caption = LoadResString(109)
    Form1.Label5(5).Caption = LoadResString(109)
    Form1.Label5(6).Caption = LoadResString(109)
    Form1.Label5(7).Caption = LoadResString(109)
    Form1.Label5(8).Caption = LoadResString(109)
    Form1.Label5(9).Caption = LoadResString(109)
    Form1.Label5(10).Caption = LoadResString(109)
    Form1.Label5(11).Caption = LoadResString(109)
    Form1.Label5(12).Caption = LoadResString(109)
    
    Form1.Full_Lab(0).Caption = LoadResString(119)
    Form1.Full_Lab(1).Caption = LoadResString(119)
    Form1.Full_Lab(2).Caption = LoadResString(119)
    Form1.Full_Lab(3).Caption = LoadResString(119)
    Form1.Full_Lab(4).Caption = LoadResString(119)
    Form1.Full_Lab(5).Caption = LoadResString(119)
    Form1.Full_Lab(6).Caption = LoadResString(119)
    Form1.Ex33Full(0).Caption = LoadResString(119)
    Form1.Ex33Full(1).Caption = LoadResString(119)
    Form1.Ex33Full(2).Caption = LoadResString(119)
    Form1.Ex33Full(3).Caption = LoadResString(119)
    Form1.Ex33Full(4).Caption = LoadResString(119)
    Form1.Ex33Full(5).Caption = LoadResString(119)
    
    Form1.Frame2(10).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(53).Caption = LoadResString(117)
    Form1.Label1(55).Caption = LoadResString(131)
    Form1.Label1(56).Caption = LoadResString(132)
    Form1.Label1(57).Caption = LoadResString(133)
    Form1.Check1(10).Caption = LoadResString(134)
    Form1.Command2(20).Caption = LoadResString(135)
    
    Form1.Frame2(11).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(62).Caption = LoadResString(117)
    Form1.Label1(60).Caption = LoadResString(131)
    Form1.Label1(59).Caption = LoadResString(132)
    Form1.Label1(58).Caption = LoadResString(133)
    Form1.Check1(11).Caption = LoadResString(134)
    Form1.Command2(22).Caption = LoadResString(135)
    
    Form1.Frame2(12).Caption = LoadResString(130)
    'Form1.Full_Lab(5).Caption = LoadResString(140)
    Form1.Label1(64).Caption = LoadResString(117)
    Form1.Label1(66).Caption = LoadResString(131)
    Form1.Label1(67).Caption = LoadResString(132)
    Form1.Label1(68).Caption = LoadResString(133)
    Form1.Check1(12).Caption = LoadResString(134)
    Form1.Command2(24).Caption = LoadResString(135)
    
    For i = 0 To 12
        Form1.Combo1(i).AddItem ("19200")
        Form1.Combo1(i).AddItem ("9600")
        Form1.Combo1(i).AddItem ("4800")
        Form1.Combo1(i).AddItem ("2400")
        Form1.Combo1(i).AddItem ("1200")
    Next

End Sub
' 将数转为以Ｋ或Ｍ单位的浮点数,　返回数据使用的单位
Public Function DatTurn(ByRef Turndat As Single) As Byte
    Dim tt As Byte
    tt = 0
    If Turndat >= 10000 Then
        Turndat = Turndat / 1000
        tt = 1
    End If
    If Turndat >= 10000 Then
        Turndat = Turndat / 1000
        tt = 2
    End If
    DatTurn = tt
End Function

'求数字里的小数位数， 只求7位以上的
Public Function FindDecNum(ByVal para As Single) As Byte
    Dim t1, t2 As String
    Dim t3, t4, i As Byte
    t1 = CStr(para)
    t3 = Len(t1)
    t4 = InStr(1, t1, ".")
    If t4 = 0 Then
        FindDecNum = 0
    Else
        FindDecNum = t3 - t4
    End If
End Function
'求数字里的小数位数， 只求只4位有效数字的数据
Public Function FindDecNum4(ByVal para As Single) As Byte
    Dim t1, t2 As String
    Dim t3, t4, i As Byte
    t1 = CStr(para)
    t3 = Len(t1)
    t4 = InStr(1, t1, ".")
    If t4 = 0 Then
        FindDecNum4 = 0
    Else
        If t3 > 5 Then
            FindDecNum4 = 5 - t4
        Else
            FindDecNum4 = t3 - t4
        End If
        
    End If
End Function

'数值显示， bitnum 是显示数的有效位
Public Function DataDsp(ByVal dat As Single, ByVal bitnum As Byte) As String
    Dim DatStr As String
    Dim i, j As Integer
    DatStr = dat
    i = Len(DatStr)
    j = i - bitnum
    If (j < 0) Then
        Do While (j <> 0)
            If j = -1 Then
                DatStr = InsertStr(DatStr, "0.", 0)
            Else
                DatStr = InsertStr(DatStr, "0", 0)
            End If
        Loop
    Else
        DataDsp = InsertStr(DatStr, ".", j)
    End If
End Function

' 在原始字符串(OriS)中的Pos位置 插入 InsString 字符串，
Public Function InsertStr(ByVal OriS As String, ByVal InsString As String, ByVal pos As Integer) As String
  '  Dim TempS1 As String
    Dim SLen, SLLen, SRLen As Integer   '字符串长度， 插入位置左边字符串长，插入位置右边字符串长
    SLen = Len(OriS)
    SRLen = SLen - pos      '字串总长 -位置 =右边字符串长度
    SLLen = SLen - SRLen
    InsertStr = Left(OriS, SLLen) & InsString & Right(OriS, SRLen)
End Function

Public Function CalWuCha(ByVal data As Single) As Byte
  Dim a As Integer
    a = (data * 100 / 10) * 2
    If data < 0 Then a = a + 256
    a = a - 2
    CalWuCha = a
End Function

Public Function FormatHex(ByVal InputStr As String, ByVal Gs As String) As String
    Dim StrLen, i As Byte
    i = Len(Gs)
    StrLen = Len(InputStr)
    FormatHex = ""
    If (i > StrLen) Then
       FormatHex = String(i - StrLen, "0")
    End If
    FormatHex = FormatHex & InputStr
End Function

'将字符串里的数据转为数字
Public Function StrToNum(ByVal InputStr As String, ByVal CHLen As Byte) As Single
    Dim StrLen, i As Byte
    Dim TempS As String
    Dim demcal, dir As Boolean
    Dim IntPart, DePart As Single
    demcal = False
    If CHLen = 0 Then
        StrLen = Len(InputStr)
    Else
        StrLen = CHLen
    End If
    dir = False
    IntPart = 0
    DePart = 10
    For i = 1 To StrLen
        TempS = Mid$(InputStr, i, 1)
        If TempS = "." Then
            demcal = True
        ElseIf (TempS = "-") Then
            dir = True
        ElseIf ((TempS < "0") Or (TempS > "9")) Then
          If i = 1 Then
           StrToNum = -1
            MsgBox LoadResString(129), , LoadResString(124)
            Exit Function
          Else
            Exit For
          End If
        Else
            If demcal = False Then
                IntPart = IntPart * 10 + Val(TempS)
            Else
                IntPart = IntPart + Val(TempS) / DePart
                DePart = DePart * 10
            End If
            
        End If
        
    Next i
    If dir = True Then
        'IntPart = 256 - IntPart
        IntPart = -IntPart
    End If
    StrToNum = IntPart

End Function

Public Function SymbolToNot(ByVal SymbolNum As Integer) As Byte
    Dim result As Byte
    
    If SymbolNum > 255 Then
       SymbolNum = SymbolNum Mod 256
    End If
    
    If SymbolNum < 0 Then
        SymbolNum = SymbolNum + 256
    End If
    result = SymbolNum
    SymbolToNot = SymbolNum
End Function

'*************************************************************
'将要设入的值,
Public Function TonFloat(ByVal InValue As Single)
    Dim i As Integer

    i = -3
    InValue = CSng(InValue * 1000)
'    If (InValue Mod 1000) = 0 Then InValue = InValue / 1000
    
    If InValue < 1000 And InValue > 0 Then
        RNum = InValue
        Mi = i
        Exit Function
    End If
    i = 0
    Do While (InValue >= 10000)
       InValue = InValue \ 10
       i = i + 1
    Loop
    i = i - 3
    Do While (((InValue Mod 10) = 0) And (i < 0))
        InValue = InValue / 10
        i = i + 1
    Loop
    RNum = InValue
    Mi = i
End Function

Public Function CRC16(ByVal DataLen As Long) As Long
    Dim CRCHi As Byte
    Dim CrcLOW As Byte
    Dim temp, i As Long
    Dim Index As Long
    Dim Templen As Long
    Templen = DataLen
    CRCHi = 255
    CrcLOW = 255
Nxt:
    If Templen > 0 Then
        Index = CRCHi Xor DataArr(DataLen - Templen)
        CRCHi = CrcLOW Xor CRCListHi(Index)
        CrcLOW = CRCListLo(Index)
        Templen = Templen - 1
        
        GoTo Nxt
    End If
    CrcDataHI = CRCHi
    CrcDataLO = CrcLOW
    temp = 0
    For i = 1 To 256
         temp = (temp + CRCHi) Mod &H100
    Next i
    CRC16 = temp + CrcLOW
End Function
Public Sub SystemLanguage()
    Dim id As Long
    id = GetSystemDefaultLCID
    Select Case id