📄 form1.frm
字号:
VERSION 5.00
Object = "{5A187E03-1FE4-11D3-9C2F-000021DF30C1}#1.0#0"; "EditView.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{C7023ECA-FA9A-49CE-B461-982916E6BE6C}#1.0#0"; "1.ocx"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8310
ClientLeft = 60
ClientTop = 450
ClientWidth = 11940
LinkTopic = "Form1"
ScaleHeight = 8310
ScaleWidth = 11940
StartUpPosition = 3 '窗口缺省
Begin 工程1.Uform zf1
Height = 2535
Left = 120
TabIndex = 7
Top = 4080
Width = 11295
_ExtentX = 19923
_ExtentY = 4471
End
Begin VB.OptionButton Option1
Caption = "Option1"
Height = 375
Left = 4800
TabIndex = 6
Top = 7800
Width = 1935
End
Begin VB.CommandButton Command5
Caption = "Command5"
Height = 855
Left = 10560
TabIndex = 5
Top = 6960
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "Command4"
Height = 975
Left = 8400
TabIndex = 4
Top = 6840
Width = 1095
End
Begin EDITVIEWLib.EditView EditView
Height = 3855
Left = 240
TabIndex = 3
Top = 120
Width = 10815
_Version = 65536
_ExtentX = 19076
_ExtentY = 6800
_StockProps = 0
End
Begin MSComDlg.CommonDialog C1
Left = 9600
Top = 7080
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 735
Left = 6000
TabIndex = 2
Top = 6960
Width = 1935
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 735
Left = 2520
TabIndex = 1
Top = 6840
Width = 2295
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 735
Left = 480
TabIndex = 0
Top = 6840
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zf2 As Integer
Dim PArea As PntArea
Dim LArea As LinArea
Dim pArea1 As PntArea
Dim struflag As Boolean
Dim attflag As Boolean
Dim SiO2(), KNa() As Variant
Private Sub Command1_Click()
form2.Visible = True
'Command5.Enabled = True
'form1.Visible =False
End Sub
Private Sub Command2_Click()
'GisEdit1.EditWndBkFace (0)
'GisEdit1.UpdateWindow
End Sub
Private Sub openpoint()
Dim inf As New Pnt_Info
With inf
.Type = gisPNT_SUB
.Sub.subno = 2
.Sub.Height = 5
.Sub.Width = 5
End With
filename = App & "\1.wt"
If PArea.Empty Then
EditView.PntArea = PArea
EditView.PntArea.Load (filename)
End If
EditView.UpdateWindow
Set inf = Nothing
End Sub
Private Sub openfile()
C1.Filter = "*.wp|*.wp"
C1.ShowOpen
If C1.filename = "" Then
Exit Sub
Else
filename = C1.filename
End If
End Sub
Private Sub openline()
Dim inf As New Lin_Info
With inf
.ltp = 3
.lclr = 6
.lw = 1
.xscale = 10
.yscale = 10
End With
'filename = "c:\1.wl"
If LArea.Empty Then '
EditView.LinArea = LArea
LArea.Clear
EditView.LinArea.Load (filename1)
End If
EditView.UpdateWindow
' EditView.ZoomAll
Set inf = Nothing
End Sub
Private Sub Command4_Click()
Call savefile
End Sub
Private Sub Command5_Click()
'zf2 = 0
zf2 = zf2 + 1
If zf2 <> 1 Then
Call savefile
End If
Call toudian
Call openline
MsgBox "工作顺利完成!"
End Sub
Private Sub Form_Load()
EditView.PopMenuControl = 1
Set PArea = New PntArea
Set LArea = New LinArea
Set pArea1 = New PntArea
EditView.DspBigCross = False
EditView.DspOrg = True
EditView.BackgroundColor = 9
EditView.PopMenuEnable = True
Command5.Enabled = False
End Sub
Private Sub savefile()
EditView.PntArea.SaveAs
EditView.LinArea.SaveAs
End Sub
Private Sub toudian()
zf1.Openexcelfile
Dim collong, rowlong As Long
collong = 149.5
rowlong = 179.5
ReDim SiO2(zf1.rows), KNa(zf1.rows)
Dim i As Integer
For i = 1 To zf1.rows - 1
SiO2(i) = (zf1.Cell(i + 1, 4) * 179.5) / 85 + 100
KNa(i) = zf1.Cell(i + 1, 12) * 149.5 / 20 + zf1.Cell(i + 1, 13) * 149.5 / 20 + 100
Next
Call apendpnt
End Sub
Private Sub apendpnt()
Dim i As Long
Dim tf As Integer
Dim noteDat As String
Dim inf As New Pnt_Info
Dim xy As New D_Dot
PArea.Clear
With inf
.Type = gisPNT_SUB
.Sub.subno = 406
.Sub.Height = 4
.Sub.Width = 4
End With
For i = 1 To zf1.rows - 1
With xy
.X = SiO2(i)
.Y = KNa(i)
End With
EditView.PntArea = PArea
'filename = "c:\1.wt"
i = PArea.Append(xy, noteDat, inf)
Next
PArea.AppendFile (filename)
EditView.UpdateWindow
Set inf = Nothing
Set xy = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -