frmld.frm

测绘工程中的前方交会,主要是摄影测量中运用的较多

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmLD 
   Caption         =   "前方交会"
   ClientHeight    =   9480
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9615
   LinkTopic       =   "Form1"
   ScaleHeight     =   9480
   ScaleWidth      =   9615
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox TxtNum 
      Height          =   375
      Left            =   8280
      TabIndex        =   11
      Text            =   "Text1"
      Top             =   240
      Width           =   1095
   End
   Begin MSFlexGridLib.MSFlexGrid Grid2 
      Height          =   3975
      Left            =   240
      TabIndex        =   10
      Top             =   4440
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   7011
      _Version        =   393216
      Cols            =   4
   End
   Begin VB.CommandButton CmdCalc 
      Caption         =   "计算"
      Height          =   495
      Left            =   7560
      TabIndex        =   9
      Top             =   6000
      Width           =   855
   End
   Begin VB.TextBox TxtHA 
      Height          =   495
      Left            =   5880
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   240
      Width           =   1215
   End
   Begin VB.CommandButton CmdIN 
      Caption         =   "导入"
      Height          =   495
      Left            =   8160
      TabIndex        =   6
      Top             =   2640
      Width           =   735
   End
   Begin VB.TextBox TxtH 
      Height          =   495
      Left            =   3360
      TabIndex        =   4
      Top             =   240
      Width           =   1335
   End
   Begin VB.TextBox TxtS 
      Height          =   495
      Left            =   1080
      TabIndex        =   2
      Top             =   240
      Width           =   1335
   End
   Begin VB.CommandButton Cmdsave 
      Caption         =   "保存"
      Height          =   495
      Left            =   8520
      TabIndex        =   1
      Top             =   840
      Width           =   735
   End
   Begin MSFlexGridLib.MSFlexGrid Grid1 
      Height          =   2895
      Left            =   240
      TabIndex        =   0
      Top             =   1200
      Width           =   5655
      _ExtentX        =   9975
      _ExtentY        =   5106
      _Version        =   393216
      Cols            =   5
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "点个数"
      Height          =   180
      Left            =   7680
      TabIndex        =   12
      Top             =   360
      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "A点仪器高"
      Height          =   180
      Left            =   4920
      TabIndex        =   8
      Top             =   360
      Width           =   810
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "AB高差"
      Height          =   180
      Left            =   2640
      TabIndex        =   5
      Top             =   360
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "AB距离"
      Height          =   180
      Left            =   360
      TabIndex        =   3
      Top             =   360
      Width           =   540
   End
End
Attribute VB_Name = "FrmLD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim arecord As Recordset
Dim wgridcol1 As Integer
Dim wgridrow1 As Integer

Private Sub CmdCalc_Click()
Dim i As Integer
  Dim ic
  Call d_r(g_A_H())
  For i = 1 To g_PotNum
      If g_A_H(i) > PI Then
      g_A_H(i) = 2 * PI - g_A_H(i)
      End If
  Next i
  Call d_r(g_A_V())
    For i = 1 To g_PotNum
      g_A_V(i) = (PI / 2) - g_A_V(i)
    Next i
 
   Call d_r(g_B_H())
   Call calc
  
 
    Set arecord = g_d_Base.OpenRecordset("结果表 ", dbOpenTable)
        With arecord
            ic = .RecordCount
            If .RecordCount > 0 Then
               .MoveFirst
              For i = 1 To ic
                   .Delete
                   If i < ic Then
                      .MoveFirst
                  End If
              Next i
            End If
            For i = 1 To g_PotNum
                .AddNew
                .Fields(0) = g_Potname(i)
                If g_XC(i) <> 0 Then .Fields(1) = g_XC(i)
                If g_YC(i) <> 0 Then .Fields(2) = g_YC(i)
                If g_ZC(i) <> 0 Then .Fields(3) = g_ZC(i)
                .Update
               Next i
            .Close
        End With
    Grid2.ColWidth(0) = 800
    Grid2.ColWidth(1) = 1500
    Grid2.ColWidth(2) = 1500
    Grid2.ColWidth(3) = 1500
 
    Grid2.ColAlignment(0) = 4
    Grid2.ColAlignment(1) = 4
    Grid2.ColAlignment(2) = 4
    Grid2.ColAlignment(3) = 4
 
    
    Grid2.Row = 0
    Grid2.Col = 0
    Grid2.Text = "点号"
    Grid2.Col = 1
    Grid2.Text = "X"
    Grid2.Col = 2
    Grid2.Text = "Y"
    Grid2.Col = 3
    Grid2.Text = "Z"

     
     
    Grid2.Rows = g_PotNum + 1
    Grid2.Col = 1: Grid2.ColSel = 3
    Grid2.Row = 1: Grid2.RowSel = g_PotNum
    For i = 1 To g_PotNum
         Grid2.Col = 0
        Grid2.Row = i
        Grid2.Text = g_Potname(i)
        Grid2.Col = 1
        Grid2.Row = i
        Grid2.Text = Format(g_XC(i), ".00000")
        Grid2.Col = 2
        Grid2.Row = i
        Grid2.Text = Format(g_YC(i), ".00000")
        Grid2.Col = 3
        Grid2.Row = i
        Grid2.Text = Format(g_ZC(i), ".00000")
   Next i
       
        CmdCalc.Enabled = False
End Sub

Private Sub Cmdin_Click()
   Dim i As Integer
   Dim Recnum As Integer
   Set arecord = g_d_Base.OpenRecordset("点号表", dbOpenTable)
    With arecord
       If .RecordCount > 0 Then
          Recnum = .RecordCount
          .MoveFirst
        For i = 1 To Recnum
           If .Fields(0) <> "" Then g_Potname(i) = .Fields(0)
           If .Fields(1) <> "" Then g_A_H(i) = .Fields(1)
           If .Fields(2) <> "" Then g_A_V(i) = .Fields(2)
           If .Fields(3) <> "" Then g_B_H(i) = .Fields(3)
           If .Fields(4) <> "" Then g_B_V(i) = .Fields(4)
           If i < Recnum Then
              .MoveNext
           End If
       Next i
       End If
  End With
   arecord.Close
    Grid1.ColWidth(0) = 800
    Grid1.ColWidth(1) = 1400
    Grid1.ColWidth(2) = 1200
    Grid1.ColWidth(3) = 1400
    Grid1.ColWidth(4) = 1400
    Grid1.ColAlignment(0) = 4
    Grid1.ColAlignment(1) = 4
    Grid1.ColAlignment(2) = 4
    Grid1.ColAlignment(3) = 4
    Grid1.ColAlignment(4) = 4
    
    Grid1.Row = 0
    Grid1.Col = 0
    Grid1.Text = "点号"
    Grid1.Col = 1
    Grid1.Text = "A_H"
    Grid1.Col = 2
    Grid1.Text = "A_V"
    Grid1.Col = 3
    Grid1.Text = "B_H"
    Grid1.Col = 4
    Grid1.Text = "B_V"
     
     
    Grid1.Rows = g_PotNum + 1
    Grid1.Col = 1: Grid1.ColSel = 3
    Grid1.Row = 1: Grid1.RowSel = g_PotNum
    For i = 1 To g_PotNum
        Grid1.Col = 0
        Grid1.Row = i
        Grid1.Text = g_Potname(i)
        Grid1.Col = 1
        Grid1.Row = i
        Grid1.Text = g_A_H(i)
        Grid1.Col = 2
        Grid1.Row = i
        Grid1.Text = g_A_V(i)
        Grid1.Col = 3
        Grid1.Row = i
        Grid1.Text = g_B_H(i)
        Grid1.Col = 4
        Grid1.Row = i
        Grid1.Text = g_B_V(i)
      Next i
      

End Sub
Private Sub Form_Load()
  
   Me.Left = (Screen.Width - Me.Width) / 2
   Me.Top = (Screen.Height - Me.Height) / 2
   Set arecord = g_d_Base.OpenRecordset("基本参数表", dbOpenTable)
    With arecord
       If .RecordCount > 0 Then
            .MoveFirst

            If .Fields(0) <> "" Then g_S_AB = .Fields(0)
            If .Fields(1) <> "" Then g_H_AB = .Fields(1)
            If .Fields(2) <> "" Then g_HA = .Fields(2)
            If .Fields(3) <> "" Then g_PotNum = .Fields(3)
       End If
    End With
    arecord.Close
    TxtS.Text = g_S_AB
    TxtH.Text = g_H_AB
    TxtHA.Text = g_HA
   TxtNum.Text = g_PotNum
End Sub


Private Sub TxtH_Change()
 g_H_AB = Val(TxtH.Text)
End Sub

Private Sub TxtHA_Change()
g_HA = Val(TxtHA.Text)
End Sub

Private Sub TxtNum_Change()
g_PotNum = Val(TxtNum.Text)
End Sub

Private Sub TxtS_Change()
  g_S_AB = Val(TxtS.Text)
End Sub