module1.bas

饮羽公路测设（glcs） 由20多个公路测量、设计、试验和施工组织设计等小软件组成。如《中桩大地坐标》可以计算不等长缓和曲线的中桩和边桩的大地坐标；《缓和曲线反算》可以根据切线长、外距长或缓和曲线长求

Attribute VB_Name = "Module1"
Public A1 As Double, B1 As Double, C1 As Double, D1 As Double, X1 As Double
Public Sjwjs As Double, Dush As Double, Hudu As Double
Public Du As Double, Fen As Double, Miao As Double
Public rjsfzc As Integer

Public yemsz1 As Integer, yemsz2 As Integer
Public yemss As Double, yemsx As Double, yemsz As Double, yemsy As Double
Public bgztsz As String, btmch As String
Public bgzhsz As Integer, bgxsyj As Integer

Public Sfzh As Integer

Public Const pi = 3.1415926

Public Bcwjpd As Integer
Public Wjlj As String

Public Sj(60) As String
Public Wenben As String

Public Xdemc(1) As String




Public Sub yuecfc()
'一元二次方程
        
    On Error GoTo handlerror
    
    D1 = B1 * B1 - 4 * A1 * C1
    If D1 < 0 Then
        X1 = 0
        Exit Sub
    End If
        
        X1 = (-B1 + Sqr(D1)) / 2 / A1
    
    Exit Sub
handlerror:
    
End Sub

Public Sub Dfmhhd()
'度分秒化弧度
    
    On Error GoTo handlerror
    
    dfm = Abs(Sjwjs)
    Du = Int(dfm)
    Fen = Int(dfm * 100) - Du * 100
    Miao = dfm * 10000 - Du * 10000 - Fen * 100
    Dush = Du + Fen / 60 + Miao / 3600
    Hudu = Dush * pi / 180
        
    Exit Sub
handlerror:
    
End Sub

Public Sub fjwb4()
'进行分解4
    
    On Error GoTo handlerror
    
    For i = 1 To 4
        Sj(i) = ""
    Next i
    numm = 0
    changd = Len(Xdemc(1))
    j = 1
    For i = 1 To changd
        If Mid$(Xdemc(1), i, 1) = "," Or Mid$(Xdemc(1), i, 1) = "，" Or i = changd Then
            Do
                If Sj(j) = "" Then
                    If i <> changd Then
                        Sj(j) = Mid$(Xdemc(1), numm + 1, i - numm - 1)
                    End If
                    If i = changd Then
                        Sj(j) = Mid$(Xdemc(1), numm + 1, i - numm)
                    End If
                End If
                
                j = j + 1
                If 4 < j Then Exit Do
                
            Loop While Sj(j) <> ""
            numm = i
        End If
    Next i
        
    Exit Sub
handlerror:

End Sub


Public Sub fjwb50()
'把读入的一列数据文件进行分解

    On Error GoTo handlerror
    
    For i = 1 To 50
        Sj(i) = ""
    Next i
    numm = 0
    changd = Len(Wenben)
    j = 1
    For i = 1 To changd
        If Mid$(Wenben, i, 1) = "," Or Mid$(Wenben, i, 1) = "，" Or i = changd Then
            Do
                If Sj(j) = "" Then
                    If i <> changd Then
                        Sj(j) = Mid$(Wenben, numm + 1, i - numm - 1)
                    End If
                    If i = changd Then
                        Sj(j) = Mid$(Wenben, numm + 1, i - numm)
                    End If
                End If
                j = j + 1
                If 50 < j Then Exit Do
                
            Loop While Sj(j) <> ""
            numm = i
        End If
    Next i
    
    Exit Sub
handlerror:
    
End Sub


Public Function StringToHex(ByVal strjjmwb As String) As String
'加密字符串

    On Error Resume Next
    
    Dim bytearr() As Byte
    bytearr = StrConv(strjjmwb, vbFromUnicode)
    Dim temps As String
    Dim temp As Byte
    Dim i As Long
    Dim outs As String
    
    For i = 0 To UBound(bytearr)
        temp = bytearr(i)
        temps = Hex(temp)
        temps = Right("00" + temps, 2)
        outs = outs + temps
    Next
    StringToHex = outs
    
End Function


Public Function HexToString(ByVal strjjmwb As String) As String
'解密字符串

    On Error Resume Next
    
    Dim bytearr() As Byte
    Dim temps As String
    Dim temp As Byte
    Dim i As Long
    Dim j As Long
    j = 0
    Dim outs As String
    
    For i = 1 To Len(strjjmwb) Step 2
        temps = Mid(strjjmwb, i, 2)
        temp = Val("&H" & temps)
        ReDim Preserve bytearr(j)
        bytearr(j) = temp
        j = j + 1
    Next
    outs = StrConv(bytearr, vbUnicode)
    HexToString = outs
    
End Function