📄 放线-支点.frm
字号:
VERSION 5.00
Begin VB.Form Form3
BorderStyle = 1 'Fixed Single
Caption = "支导线输入"
ClientHeight = 6840
ClientLeft = 6315
ClientTop = 2910
ClientWidth = 5535
Icon = "放线-支点.frx":0000
LinkTopic = "Form3"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6840
ScaleWidth = 5535
Begin VB.CommandButton Command2
Caption = "返回"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 3480
TabIndex = 12
Top = 5640
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "计算"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 840
TabIndex = 11
Top = 5640
Width = 1095
End
Begin VB.TextBox Text3
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 2
Top = 4800
Width = 2175
End
Begin VB.TextBox Text2
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 1
Top = 3960
Width = 2175
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 0
Top = 3120
Width = 1695
End
Begin VB.Label Label6
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 375
Left = 2160
TabIndex = 10
Top = 2040
Width = 2175
End
Begin VB.Label Label5
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 375
Left = 2160
TabIndex = 9
Top = 1440
Width = 2175
End
Begin VB.Label Label1
Caption = "测站点:"
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 375
Index = 0
Left = 600
TabIndex = 8
Top = 1440
Width = 1215
End
Begin VB.Label Label3
Caption = "后视点:"
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 375
Index = 0
Left = 600
TabIndex = 7
Top = 2040
Width = 1215
End
Begin VB.Label Label4
Caption = "支 点 输 入"
BeginProperty Font
Name = "隶书"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 495
Index = 0
Left = 840
TabIndex = 6
Top = 240
Width = 3855
End
Begin VB.Line Line2
X1 = 0
X2 = 5280
Y1 = 0
Y2 = 0
End
Begin VB.Label Label3
Caption = "平距:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 840
TabIndex = 5
Top = 4800
Width = 1095
End
Begin VB.Label Label2
Caption = "水平角:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 4
Top = 3960
Width = 1455
End
Begin VB.Label Label1
Caption = "支点点号:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 600
TabIndex = 3
Top = 3120
Width = 1575
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public CZDM, DXDM As String
Private Sub Command1_Click()
Dim LJ As String, ZFC1 As String, ZFC2 As String, PDH1 As Integer, PDH2 As Integer
Dim XZD As Double, YZD As Double, PJ As Double, JD As Double, ZDDH As String
Dim ZFC3 As Double, ZFC4 As Double, ZFC5 As Double, CZFWJ As Double
Dim XCZ As Double, YCZ As Double, XDX As Double, YDX As Double
LJ = App.Path & "\KZCG.DAT"
'读取 KZCG.DAT 文件
Open LJ For Input As #1
PDH1 = 0: PDH2 = 0
Do While Not EOF(1)
Input #1, ZFC1, ZFC2, ZFC3, ZFC4, ZFC5
If CZDM = Trim(ZFC1) Then
XCZ = ZFC3: YCZ = ZFC4: PDH1 = PDH1 + 1
End If
If DXDM = Trim(ZFC1) Then
XDX = ZFC3: YDX = ZFC4: PDH2 = PDH2 + 1
End If
Loop
Close #1
If PDH1 > 1 Then MsgBox "程序认为KZCG里已知点：" + CZDM + "的坐标重复，请核对！", 16, "放线计算": Exit Sub
If PDH2 > 1 Then MsgBox "程序认为KZCG里已知点：" + DXDM + "的坐标重复，请核对！", 16, "放线计算": Exit Sub
If PDH1 < 1 Then MsgBox "程序认为KZCG里缺少已知点：" + CZDM + "的坐标，请核对！", 16, "放线计算": Exit Sub
If PDH2 < 1 Then MsgBox "程序认为KZCG里缺少已知点：" + DXDM + "的坐标，请核对！", 16, "放线计算": Exit Sub
CZFWJ = FWJ(XCZ, YCZ, XDX, YDX)
ZDDH = Trim(Text1.Text): ZFC1 = Trim(Text2.Text): ZFC2 = Trim(Text3.Text)
If ZDDH = "" Or ZFC1 = "" Or ZFC2 = "" Then
MsgBox "观测数据不能为空，请重新输入!", 0, "支导线输入"
Else
JD = Jdtoxs(Val(ZFC1)) + CZFWJ: PJ = Val(ZFC2)
If JD < 0 Then JD = JD + 360
If JD > 360 Then JD = JD - 360
XZD = XCZ + PJ * Cos(JD * 3.1415926 / 180)
YZD = YCZ + PJ * Sin(JD * 3.1415926 / 180)
Open LJ For Append As #1
Print #1, Trim(ZDDH); ",118,"; Trim(Str(Int(XZD * 1000) / 1000)); ","; Trim(Str(Int(YZD * 1000) / 1000)); ",999"
Close #1
' 清空数据
Text1.Text = "": Text2.Text = "": Text3.Text = ""
'输出到文件
Open "c:\fx.txt" For Append As #2
Print #2, CZDM; ","; DXDM
Print #2, ZDDH; ","; ZFC1; ","; ZFC2
Close #2
End If
End Sub
Private Sub Command2_Click()
Close #1
Me.Hide
Unload Me
Form1.Show
End Sub
Private Sub Form_Load()
Open "c:\q.q" For Input As #1
Input #1, CZDM
Input #1, DXDM
Close #1
Label5.Caption = CZDM
Label6.Caption = DXDM
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If (KeyAscii < 46 Or KeyAscii > 57) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If (KeyAscii < 46 Or KeyAscii > 57) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -