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

📄 form1.frm

📁 连点成线VB。是由点连成线的动态方法!
💻 FRM
字号:
VERSION 5.00
Object = "{E760686B-BC9E-4802-9ECF-175FDF4062CE}#5.0#0"; "MAPX50.DLL"
Begin VB.Form Form1 
   Caption         =   "从点创建线"
   ClientHeight    =   7875
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8145
   LinkTopic       =   "Form1"
   ScaleHeight     =   7875
   ScaleWidth      =   8145
   StartUpPosition =   3  'Windows Default
   Begin MapXLib.Map Map1 
      Height          =   4575
      Left            =   600
      TabIndex        =   7
      Top             =   720
      Width           =   6255
      _Version        =   500012
      _ExtentX        =   11033
      _ExtentY        =   8070
      _StockProps     =   1
      MapCatalog.GeoDictionary=   "GeoDictionary"
      GeoSet          =   "Empty GeosetName {9A9AC2F4-8375-44d1-BCEB-476AE986F190}"
      DefaultStyle.TextFontBackColor=   16777215
      DefaultStyle.SupportsBitmapSymbols=   -1  'True
      DefaultStyle.SymbolChar=   55
      DefaultStyle.SymbolFontBackColor=   16777215
      BeginProperty DefaultStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty DefaultStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Map Symbols"
         Size            =   14.25
         Charset         =   2
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DefaultStyle.LineStyle=   1
      DefaultStyle.LineWidth=   1
      DefaultStyle.RegionColor=   16777215
      DefaultStyle.LinePattern=   2
      DefaultStyle.RegionBackColor=   16777215
      DefaultStyle.RegionBorderStyle=   1
      DefaultStyle.RegionBorderWidth=   1
      Title.Visible   =   0   'False
      Title.Text      =   "Empty Title {01A9504B-CE13-4415-A5A0-51D8C2F15204}"
      Title.Style.TextFontBackColor=   16777215
      Title.Style.TextFontOpaque=   -1  'True
      Title.Style.SymbolChar=   0
      BeginProperty Title.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   23.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Title.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   23.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Title.X         =   2084
      Title.Y         =   304
      Map.NumericCoordSys.ProjectionInfo=   "Form1.frx":0000
      Map.DisplayCoordSys.ProjectionInfo=   "Form1.frx":0130
   End
   Begin VB.CommandButton Command4 
      Caption         =   "移动"
      Height          =   375
      Left            =   3840
      TabIndex        =   6
      Top             =   6720
      Width           =   1095
   End
   Begin VB.CommandButton Command3 
      Caption         =   "缩小"
      Height          =   375
      Left            =   2280
      TabIndex        =   5
      Top             =   6720
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "放大"
      Height          =   375
      Left            =   840
      TabIndex        =   4
      Top             =   6720
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "全图"
      Height          =   375
      Left            =   3360
      TabIndex        =   3
      Top             =   7320
      Width           =   975
   End
   Begin VB.CommandButton cmdBtnAddLayer 
      Caption         =   "增加图层"
      Height          =   375
      Left            =   720
      TabIndex        =   2
      Top             =   7320
      Width           =   975
   End
   Begin VB.CommandButton cmdBtnLayer 
      Caption         =   "图层控制"
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Top             =   7320
      Width           =   975
   End
   Begin VB.CommandButton cmdBtnCreate 
      Caption         =   "创建线"
      Height          =   375
      Left            =   4920
      TabIndex        =   0
      Top             =   7320
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdBtnAddLayer_Click()
    Me.Map1.Layers.AddUserDrawLayer "Line", 2
End Sub

Private Sub cmdBtnCreate_Click()
    Dim ftrs As MapXLib.Features
    Set ftrs = Me.Map1.Layers.Item(1).AllFeatures
    Dim intCount As Integer
    intCount = ftrs.Count
    Dim pts As MapXLib.Points
    Set pts = New MapXLib.Points
    Dim ftr As MapXLib.Feature
    Dim i As Integer
    Dim objStyle As New MapXLib.Style
    objStyle.LineStyle = miPenSolid
    Dim j As Integer
    j = 0
    For i = 1 To intCount
        Set ftr = ftrs.Item(i)
        pts.Add ftr.Point, 1
       ' j = j + 1
        'If j = 2 Then
        '    Set ftr = Me.Map1.FeatureFactory.CreateLine(pts)
          '  Me.Map1.Layers.Item(1).AddFeature ftr
          '  pts.RemoveAll
         '   j = 0
       ' End If
    Next i
    Set ftr = Me.Map1.FeatureFactory.CreateLine(pts)
    Me.Map1.Layers.Item(1).AddFeature ftr
    MsgBox "连接完毕"
End Sub

Private Sub cmdBtnLayer_Click()
    Me.Map1.Layers.LayersDlg
End Sub


Private Sub Command1_Click()
    Me.Map1.Bounds = Me.Map1.Layers.Bounds
End Sub

Private Sub Command2_Click()
    Me.Map1.CurrentTool = miZoomInTool
End Sub

Private Sub Command3_Click()
    Me.Map1.CurrentTool = miZoomOutTool
End Sub

Private Sub Command4_Click()
    Me.Map1.CurrentTool = miPanTool
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -