frmobjedit.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmObjEdit 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "精确编辑对象"
   ClientHeight    =   3540
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   5835
   Icon            =   "frmObjEdit.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3540
   ScaleWidth      =   5835
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton btnCancel 
      Caption         =   "放弃"
      Height          =   345
      Left            =   3150
      TabIndex        =   15
      Tag             =   "3058"
      Top             =   3150
      Width           =   1200
   End
   Begin VB.CommandButton btnClose 
      Cancel          =   -1  'True
      Caption         =   "确定"
      Height          =   345
      Left            =   1800
      TabIndex        =   14
      Tag             =   "3057"
      Top             =   3150
      Width           =   1200
   End
   Begin VB.CommandButton btnApply 
      Caption         =   "应用"
      Height          =   345
      Left            =   4500
      TabIndex        =   13
      Tag             =   "3209"
      Top             =   3150
      Width           =   1200
   End
   Begin VB.Frame Frame1 
      Height          =   2865
      Left            =   3690
      TabIndex        =   4
      Top             =   -15
      Width           =   2025
      Begin VB.ComboBox cmbCurrentPart 
         Height          =   315
         Left            =   75
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   2415
         Width           =   1845
      End
      Begin VB.Label lblCurrentLayer 
         BackColor       =   &H80000014&
         BorderStyle     =   1  'Fixed Single
         Height          =   315
         Left            =   75
         TabIndex        =   12
         Top             =   1095
         Width           =   1845
      End
      Begin VB.Label Label9 
         Caption         =   "当前地图窗口"
         Height          =   210
         Left            =   105
         TabIndex        =   11
         Tag             =   "3199"
         Top             =   225
         Width           =   1845
      End
      Begin VB.Label lblCurrentMap 
         BackColor       =   &H80000014&
         BorderStyle     =   1  'Fixed Single
         Height          =   315
         Left            =   75
         TabIndex        =   10
         Top             =   435
         Width           =   1845
      End
      Begin VB.Label Label1 
         Caption         =   "当前图层"
         Height          =   210
         Left            =   105
         TabIndex        =   9
         Tag             =   "3200"
         Top             =   875
         Width           =   1845
      End
      Begin VB.Label Label2 
         Caption         =   "子对象总数"
         Height          =   225
         Left            =   105
         TabIndex        =   8
         Tag             =   "3201"
         Top             =   1525
         Width           =   1845
      End
      Begin VB.Label lblPartCount 
         BackColor       =   &H80000014&
         BorderStyle     =   1  'Fixed Single
         Height          =   315
         Left            =   75
         TabIndex        =   7
         Top             =   1755
         Width           =   1845
      End
      Begin VB.Label Label3 
         Caption         =   "当前子对象"
         Height          =   240
         Left            =   105
         TabIndex        =   6
         Tag             =   "3202"
         Top             =   2190
         Width           =   1845
      End
   End
   Begin VB.CommandButton btnDel 
      Caption         =   "删除顶点"
      Height          =   345
      Left            =   2475
      TabIndex        =   3
      Tag             =   "3148"
      Top             =   2100
      Width           =   1170
   End
   Begin VB.CommandButton btnUpdate 
      Caption         =   "更新列表"
      Height          =   345
      Left            =   2475
      TabIndex        =   2
      Tag             =   "3206"
      Top             =   2550
      Width           =   1170
   End
   Begin VB.TextBox txtY 
      BackColor       =   &H80000018&
      Height          =   315
      Left            =   705
      TabIndex        =   1
      Top             =   2550
      Width           =   1680
   End
   Begin VB.TextBox txtX 
      BackColor       =   &H80000018&
      Height          =   315
      Left            =   705
      TabIndex        =   0
      Top             =   2115
      Width           =   1680
   End
   Begin MSComctlLib.ListView lsvPartXY 
      Height          =   1905
      Left            =   60
      TabIndex        =   16
      Top             =   60
      Width           =   3525
      _ExtentX        =   6218
      _ExtentY        =   3360
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   3
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "No."
         Object.Width           =   794
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Object.Tag             =   "3203"
         Text            =   "X 坐标"
         Object.Width           =   2822
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Object.Tag             =   "3204"
         Text            =   "Y 坐标"
         Object.Width           =   2822
      EndProperty
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000006&
      X1              =   75
      X2              =   5790
      Y1              =   3000
      Y2              =   3000
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      X1              =   75
      X2              =   5790
      Y1              =   3015
      Y2              =   3015
   End
   Begin VB.Label Label4 
      Caption         =   "X坐标"
      Height          =   285
      Left            =   180
      TabIndex        =   18
      Top             =   2175
      Width           =   540
   End
   Begin VB.Label Label6 
      Caption         =   "Y坐标"
      Height          =   285
      Left            =   180
      TabIndex        =   17
      Top             =   2610
      Width           =   540
   End
End
Attribute VB_Name = "frmObjEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Option Base 1
Dim objError As soError                  '定义错误变量
Dim sUpdataNodeIndex() As String         '修改过的节点号数组，数组值为当前子对象的修改过的节点号
Dim iNodeCount As Integer                '当前子对象的节点总数
Dim iOldAction As Integer
Dim bModify As Boolean

Private Sub btnApply_Click()             '应用
      If lsvPartXY.ListItems.Count < 1 Then Exit Sub
      Dim objRecordset As soRecordset    '定义记录对象，用来接受包含几何对象的记录
      Dim objPoints As New soPoints      '定义点集合对象，用来作为更新的过渡点集合
      Dim objRegion As soGeoRegion       '定义面状几何对象，接受面状数据集的几何对象
      Dim objLine As soGeoLine           '定义线状几何对象，接受线状数据集的几何对象
      Dim objPoint As soGeoPoint         '定义点状几何对象，接受点状数据集的几何对象
      Dim iDtType As Integer
      Dim i As Integer
      Dim nID As Long                    '当前记录再数据记录集的ID号
      If Not (frmMain.SuperMap.selection.Dataset Is Nothing) Then