⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 MAPGis投点MAPGis投点MAPGis投点MAPGis投点
💻 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 + -