module1.bas

测绘仪器的模拟器

Attribute VB_Name = "Module1"
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

Public Type POINTAPI
    X As Long
    Y As Long
End Type
'''Public Function GetProfile(strFileName As String, strSection As String, strName As String) As String
'''  '这个函数是用来对INI文件进行读操作的
'''
'''  '函数说明:
'''  'strFileName 是所要读取的文件名
'''  'strSection  是这个文件中的一个节点名
'''  'strName 是所要查找的字段名
'''  '返回值：
'''  '获得该ini文件中的节点值
'''   Dim strCharA As String
'''   Dim strCharB As String
'''   Dim strSectionTemp As String
'''   Dim strNameTemp As String
'''   Dim strReturn As String
'''   Dim FileNo As Integer
'''
'''   FileNo = FreeFile
'''   strSectionTemp = ""
'''   strNameTemp = ""
'''   strReturn = ""
'''   On Error GoTo ErrSrchSection
'''
'''   Open strFileName For Binary As #FileNo
'''   ' 下面这段程序是用来查找节点的
'''     Do While Not EOF(FileNo)
'''        strCharA = Chr(Asc(InputB(2, #FileNo)))
'''        If strCharA = "[" Then
'''           Do While Not EOF(1)
'''              strCharB = Chr(Asc(InputB(2, #FileNo)))
'''              If strCharB = "]" Then Exit Do
'''              strSectionTemp = strSectionTemp & strCharB
'''           Loop
'''        End If
'''        If strSectionTemp = strSection Then
'''           strCharA = Asc(InputB(4, #FileNo))
'''           Exit Do
'''        Else
'''           strSectionTemp = ""
'''         End If
'''     Loop
'''
'''   On Error GoTo ErrReadFile
'''
'''aa:
'''     '下面这段程序是用来查找所要查找的字段的
'''     strNameTemp = ""
'''     Do While Not EOF(1)
'''        strCharA = Chr(Asc(InputB(2, #FileNo)))
'''        If strCharA <> "=" Then
'''           strNameTemp = strNameTemp & strCharA  '得到名称
'''        Else
'''           Exit Do
'''        End If
'''     Loop
'''
'''     If strNameTemp = strName Then
'''        Line Input #FileNo, strReturn  '如果找到与它匹配的字段名，就返回得到的值
'''     Else
'''        Line Input #FileNo, strReturn  '如果未找到与它匹配的字段名，就继续找
'''        GoTo aa
'''     End If
'''     Close #FileNo
'''     GetProfile = strReturn
'''     Exit Function
'''
'''
'''ErrReadFile:
'''
'''    Dim inrRet As Integer
'''    intret = MsgBox("在文件中没有找到所要查找的字段", vbAbortRetryIgnore, "错误信息")
'''    Select Case intret
'''       Case vbAbort
'''          GetProfile = ""
'''          Close #FileNo
'''          Exit Function
'''       Case vbRetry
'''          Resume
'''       Case vbIgnore
'''          Resume Next
'''     End Select
'''
'''ErrSrchSection:
'''
'''     MsgBox "节点未找到", vbOKOnly
'''     GetProfile = ""
'''     Close #FileNo
'''
'''End Function
'''

Public Function GetProfile(strFileName As String, strSection As String, strName As String) As String
  '这个函数是用来对INI文件进行读操作的
  '函数说明:
  'strFileName 是所要读取的文件名
  'strSection  是这个文件中的一个节点名
  'strName 是所要查找的字段名
  '返回值：
   strSectionTemp = ""
   strNameTemp = ""
   strreturn = ""
   On Error GoTo ErrSrchSection
   Open strFileName For Input As #1
   ' 下面这段程序是用来查找节点的
     Do While Not EOF(1)
        strCharA = Input(1, #1)
        If strCharA = "[" Then
           Do While Not EOF(1)
             strCharB = Input(1, #1)
             If strCharB = "]" Then Exit Do
             strSectionTemp = strSectionTemp & strCharB
           Loop
        End If
        If strSectionTemp = strSection Then
          strCharA = Input(2, #1)
          Exit Do
        Else
          strSectionTemp = ""
        End If
     Loop
 On Error GoTo ErrReadFile
  
aa:
    '下面这段程序是用来查找所要查找的字段的
    strNameTemp = ""
    Do While Not EOF(1)
      strCharA = Input(1, #1)
      If strCharA <> "=" Then
        strNameTemp = strNameTemp & strCharA  '得到名称
      Else
        Exit Do
      End If
    Loop
        If strNameTemp = strName Then
       Line Input #1, strreturn  '如果找到与它匹配的字段名，就返回得到的值
    Else
       Line Input #1, strreturn  '如果未找到与它匹配的字段名，就继续找
       GoTo aa
    End If
    Close #1
    GetProfile = strreturn
    Exit Function
ErrReadFile:
    Dim inrRet As Integer
    intret = MsgBox("在文件中没有找到所要查找的字段", vbAbortRetryIgnore, "错误信息")
    Select Case intret
       Case vbAbort
          GetProfile = ""
          Close #1
          Exit Function
       Case vbRetry
          Resume
       Case vbIgnore
          Resume Next
     End Select
ErrSrchSection:
     MsgBox "节点未找到", vbOKOnly
     GetProfile = ""
     Close #1
End Function


Public Function SetProfile(strFileName As String, strSection As String, strName As String, strSave As String) As Boolean
  '这个函数是用来对INI文件进行写操作的
  '函数说明:
  'strFileName 是所要存储的文件名
  'strSection  是这个文件中的一个节点名
  'strName 是所要查找的字段名
  'strSave 是所要替换字段值
  
  Dim strTemp As String
  Dim strfileback As String
  Dim strreturn As String
  strfileback = App.Path & "\App\Save.tmp" '临时文件是用来存放中转信息的
  DoEvents
  Open strFileName For Input As #1
  Open strfileback For Output As #2
   Do While Not EOF(1)
    Line Input #1, strTemp
    strreturn = strTemp
    Print #2, strreturn
    If InStr(1, Trim(strTemp), "[") <> 0 Then
      If InStr(1, Trim(strTemp), Trim(strSection)) <> 0 And Trim(strTemp) = "[" & Trim(strSection) & "]" Then
        Do While Not EOF(1)
            Line Input #1, strTemp
            If InStr(1, Trim(strTemp), Trim(strName)) <> 0 Then Exit Do   '找到所要修改的字段值
            strreturn = strTemp
            Print #2, strreturn  '拷贝不需要的字段值
         Loop
         strreturn = strName & "=" & strSave  '修改
         Print #2, strreturn
      End If
    End If
   Loop
  Close #1
  Close #2
  Open strfileback For Input As #1
  Open strFileName For Output As #2
  Do While Not EOF(1) And EOF(2)
  Line Input #1, strreturn
   Print #2, strreturn
  Loop
  Close #1
  Close #2
End Function

Public Sub TimeDelay(DT As Long)
Dim t As Long
t = GetTickCount()
Do
  DoEvents
Loop Until GetTickCount - t > DT
End Sub

Public Function CpuAngle(ByVal EBS As Double, ByVal E0 As Double, ByVal NBS As Double, ByVal N0 As Double)
  
Dim Du As Integer
Dim Fen As Integer
Dim Miao As Integer

    CpuAngle = (EBS - E0) / (NBS - N0)
    CpuAngle = Atn(CpuAngle)
    CpuAngle = CpuAngle / 3.1415926 * 180
    If CpuAngle < 0 Then
       Do Until CpuAngle > 0 And CpuAngle < 360
          CpuAngle = CpuAngle + 360
       Loop
    ElseIf CpuAngle > 360 Then
       Do Until CpuAngle > 0 And CpuAngle < 360
          CpuAngle = CpuAngle - 360
       Loop
    End If
    Du = CInt(CpuAngle)
    If CpuAngle < Du Then
       Du = Du - 1
    End If
    Fen = (CpuAngle - Du) * 60
    If (CpuAngle - Du) < Fen Then
       Fen = Fen - 1
    End If
    Miao = CInt((CpuAngle - Du - Fen / 60) * 360)
    CpuAngle = Du & "°" & Fen & "′" & Miao & "″"
End Function