📄 放线-放线.frm
字号:
VERSION 5.00
Begin VB.Form Form2
BorderStyle = 1 'Fixed Single
Caption = "放线"
ClientHeight = 7470
ClientLeft = 6120
ClientTop = 2535
ClientWidth = 5760
Icon = "放线-放线.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7470
ScaleWidth = 5760
Begin VB.TextBox Text2
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 15
Top = 3120
Width = 2535
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 14
Top = 2520
Width = 2535
End
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 = 1
Top = 6360
Width = 1095
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 = 1080
TabIndex = 0
Top = 6360
Width = 1095
End
Begin VB.Label Label10
BeginProperty Font
Name = "楷体_GB2312"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 495
Left = 2040
TabIndex = 13
Top = 5520
Width = 3015
End
Begin VB.Label Label8
BeginProperty Font
Name = "楷体_GB2312"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 495
Left = 2040
TabIndex = 12
Top = 4680
Width = 3015
End
Begin VB.Label Label4
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000040C0&
Height = 375
Left = 2400
TabIndex = 11
Top = 1800
Width = 2175
End
Begin VB.Label Label2
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000040C0&
Height = 375
Left = 2400
TabIndex = 10
Top = 1200
Width = 2175
End
Begin VB.Label Label12
Caption = "计 算 输 出"
BeginProperty Font
Name = "隶书"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 615
Index = 1
Left = 1080
TabIndex = 9
Top = 3840
Width = 3375
End
Begin VB.Label Label9
Caption = "角度："
BeginProperty Font
Name = "楷体_GB2312"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 720
TabIndex = 8
Top = 5520
Width = 1095
End
Begin VB.Label Label7
Caption = "平距："
BeginProperty Font
Name = "楷体_GB2312"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 720
TabIndex = 7
Top = 4680
Width = 1095
End
Begin VB.Label Label6
Caption = "放样点Y坐标："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 240
TabIndex = 6
Top = 3120
Width = 2055
End
Begin VB.Label Label11
Caption = "坐 标 输 入"
BeginProperty Font
Name = "隶书"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 615
Index = 0
Left = 1080
TabIndex = 5
Top = 240
Width = 3375
End
Begin VB.Line Line1
X1 = 0
X2 = 5520
Y1 = 0
Y2 = 0
End
Begin VB.Label Label5
Caption = "放样点X坐标："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 240
TabIndex = 4
Top = 2520
Width = 2055
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 = 840
TabIndex = 3
Top = 1800
Width = 1215
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 = 840
TabIndex = 2
Top = 1200
Width = 1215
End
End
Attribute VB_Name = "Form2"
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 XFY As Double, YFY As Double, PJ As Double, JD As Single
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"
PDH1 = 0: PDH2 = 0
'读取 KZCG.DAT 文件
Open LJ For Input As #1
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
'放线计算
ZFC1 = Trim(Text1.Text): ZFC2 = Trim(Text2.Text)
If ZFC1 = "" Or ZFC2 = "" Then
MsgBox " 坐标数据不能为空，请重新输入!", 0, "坐标放样"
Else
XFY = Val(ZFC1): YFY = Val(ZFC2)
'计算角度
JD = FWJ(XCZ, YCZ, XFY, YFY) - FWJ(XCZ, YCZ, XDX, YDX)
If JD < 0 Then JD = JD + 360
If JD > 360 Then JD = JD - 360
'计算平距
PJ = Sqr((XCZ - XFY) ^ 2 + (YCZ - YFY) ^ 2)
'输出打印
Label8.Caption = Format(PJ, "####.###")
Label10.Caption = Format(Xstojd(JD), "###.####")
'输出到文件
Open "c:\fx.txt" For Append As #2
Print #2, CZDM; ","; DXDM
Print #2, XFY; ","; YFY; ","; PJ; ","; Xstojd(JD)
Close #2
End If
End Sub
Private Sub Command2_Click()
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
Label2.Caption = CZDM
Label4.Caption = DXDM
End Sub
Private Sub Label12_Click(Index As Integer)
Text1.Text = "": Text2.Text = ""
Label8.Caption = "": Label10.Caption = ""
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii < 46 Or KeyAscii > 57) And KeyAscii <> 8 Then
KeyAscii = 0
End If
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -