基于MO的属性编辑工具
一、实验目的与要求：
图形绘制功能也是GIS必须的功能，MO也提供了相应的功能，可以在MAP控件上使用drawshape方法方便地绘制point,line,points,rectangle,polygon等，另外还可以在动态跟踪层中显示运动的物体。通过本实验使学生掌握简单的图形绘制功能。
二、实验内容：
1.新建一个工程，加入MO组件库
2.在图像列表框中加入图标，分别表示绘点，绘线，绘多边形等。
3.实现功能：在工具栏上点击相应的绘图按钮，绘制相应的图形
4.在工程中加入标准模块和类模块，用于定义公共变量。
设计变量如下
1）新建一个标准EXE工程，如图1.1所示，并命名为Sample1.vbp。
在工程中添加MO对象库
在Form1窗体上创建一个Map控件并命名为Map，右键单击该控件，在弹出的快捷菜单中选择[特性……]选项（图2.1），打开[属性页]对话框
图2.1
图2.2
图2.3
1）在Form1的代码编辑窗中添加如下代码：
Private Sub Form_Load()
Map.Top = 0
Map.Left = 0
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
Map.Width = Me.ScaleWidth
Map.Height = Me.ScaleHeight
End If
End Sub
1）在工程中加入[MicroSoft Windows Common Controls 6.0 (SP6)]组件库，接着在Form1窗体中分别创建一个工具栏控件ToolBar和图像库控件ImageList。
2）如图3.1所示，在ImageList控件的[属性页]对话框依次插入四个分别对应地图放大、缩小、漫游和全图缩放功能的位图图片。
图 3.1
3）在ToolBar控件的[属性页]对话框中，首先在[通用]选项栏中将ImageList属性绑定到ImageList控件，然后在[按钮]选项栏中依次插入四个实现地图放大、缩小、漫游和全图缩放功能的按钮并将各个按钮的Image属性分别对应ImageList控件中插入的四个图片。
图 3.2
4）选择主菜单[工程]—>[添加模块]菜单项，在项目中添加一个定义公共变量的模块Common，并在模块中添加如下代码：
Public Enum Tools
ToolNone = 0
ToolZoomIn = 1
ToolZoomout = 2
ToolPan = 3
End Enum
Public CurrentTool As Tools
5）在Form1的代码编辑窗中添加如下代码：
Private Sub Form_Load()
Map.Top = Toolbar.Height
Map.Left = 0
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
Map.Width = Me.ScaleWidth
Map.Height = Me.ScaleHeight - Toolbar.Height
End If
End Sub
Private Sub Map_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Dim pMapExtent As New MapObjects2.Rectangle
Set pMapExtent = Map.Extent
If Button = vbLeftButton Then
Select Case CurrentTool
Case ToolZoomIn
pMapExtent .ScaleRectangle 0.5
Map.Extent = pMapExtent .Extent
Case ToolZoomout
pMapExtent .ScaleRectangle 2
Map.Extent = pMapExtent .Extent
Case ToolPan
Map.Pan
End Select
End If
End Sub
Private Sub Toolbar_ButtonClick(ByV al Button As MSComctlLib.Button)
Select Case Button.Key
Case "ZoomIn"
CurrentTool = ToolZoomIn
Case "ZoomOut"
CurrentTool = ToolZoomout
Case "Pan"
CurrentTool = ToolPan
Case "ZoomAll"
Map.Extent = Map.FullExtent
End Select
End Sub
1）在工程中加入[MicroSoft Common Dialog Control 6.0 (SP6)]组件库，接着在Form1窗体中创建一个通用对话框控件CommonDialog1。
2）在Form1窗体中创建一个项目列表控件List1作为图层管理器，将List1控件的Style属性设置为VbListBoxCheckbox，使图层列表项的左侧出现一个复选框用于控制图层的显示，并修改Form1的Load事件和ReSize事件的代码如下：
Private Sub Form_Load()
List1.Top = Toolbar.Height
List1.Left = 0
Map.Top = Toolbar.Height
Map.Left = List1.Width + 50
Dim pLayer As Object
For Each pLayer In https://www.doczj.com/doc/3d13453008.html,yers
List1.AddItem https://www.doczj.com/doc/3d13453008.html,
Next
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
Map.Width = Me.ScaleWidth - List1.Width - 50
Map.Height = Me.ScaleHeight - Toolbar.Height
List1.Height = Map.Height
End If
End Sub
3）启动VB 6.0集成开发环境的菜单编辑器，如图4.1所示。创建一个名为PopMenu1的快捷菜单，并在该菜单中创建mnuAddLayermnu和mnuRemoveLayer菜单项，然后在Form1的代码编辑窗中添加如下代码：
Private Sub mnuAddLayer_Click()
On Error GoTo Trap
With CommonDialog1
.DialogTitle = "添加图层"
.CancelError = True
.Filter = "ESRI ShapeFiles 文件(*.Shp)|*.Shp"
.Flags = cdlOFNFileMustExist & cdlOFNHideReadOnly
.ShowOpen
End With
Dim oConnect As New DataConnection
Dim oDataset As GeoDataset
Dim sName As String
Dim oLayer As MapObjects2.MapLayer
oConnect.Database = CurDir
If Not oConnect.Connect Then Exit Sub
sName = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) –
Set oDataset = oConnect.FindGeoDataset(sName)
If oDataset Is Nothing Then Exit Sub
Set oLayer = New MapLayer
oLayer.GeoDataset = oDataset
https://www.doczj.com/doc/3d13453008.html,yers.Add oLayer
List1.AddItem sName, 0
List1.Selected(0) = True
Exit Sub
Trap:
End Sub
Private Sub mnuRemoveLayer_Click()
https://www.doczj.com/doc/3d13453008.html,yers.Remove List1.ListIndex
Map.Refresh
List1.RemoveItem List1.ListIndex
End Sub
Private Sub Toolbar_ButtonClick(ByV al Button As MSComctlLib.Button)
Select Case Button.Key
Case "ZoomIn"
CurrentTool = ToolZoomIn
Case "ZoomOut"
CurrentTool = ToolZoomout
Case "Pan"
CurrentTool = ToolPan
Case "ZoomAll"
Map.Extent = Map.FullExtent
End Select
End Sub
Private Sub List1_ItemCheck(Item As Integer)
If List1.ListIndex <> -1 Then
https://www.doczj.com/doc/3d13453008.html,yers(Item).V isible = List1.Selected(Item)
Map.Refresh
End If
End Sub
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
If List1.ListCount = 0 Or List1.ListIndex = -1 Then
mnuRemoveLayer.Enabled = False
Else
mnuRemoveLayer.Enabled = True
End If
PopupMenu PopMenu1
End If
End Sub
1）选择主菜单[工程]—>[添加类模块]菜单项，在项目中新建一个用于存储选择集的类模块SubCollection，并在类模块中添加如下代码：
Public LayerName As String
Public SelectCollection As MapObjects2.Recordset
2）在ImageList控件的[属性页]对话框中插入对应点选、窗口选择功能的位图图片。
3）在ToolBar控件的[属性页]对话框中，首先在[按钮]选项栏中插入一个分组栏，然后插入对应实现点选、窗口选择功能的按钮并将各个按钮的Image属性分别对应ImageList控件中新插入的图片。
4）在Form1窗体中创建一个PictureBox控件View，剪切Map控件并粘贴到View控件中。
5）在工程中加入[MicroSoft Hierarchical FlexGrid Control 6.0 (OLEDB)]组件库，接着在Form1窗体的View控件中创建一个MSHFlexGrid控件InfoGrid。
6）在Common模块的代码窗口中修改并添加代码如下：
Public Enum Tools
ToolNone = 0
ToolZoomIn = 1
ToolZoomout = 2
ToolPan = 3
ToolSelByPt = 4
ToolSelByBox = 5
End Enum
Public CurrentTool As Tools
Public LayerRecords As MapObjects2.Recordset
Public LayerDesc As New MapObjects2.TableDesc
Public SelectShape As Object
Public Selection As SubCollection
7）在Form1窗体的代码窗口中修改和添加代码如下：
Private Sub Form_Load()
TOC.Top = Toolbar.Height
TOC.Left = 0
V iew.Top = Toolbar.Height
V iew.Left = TOC.Width + 50
Dim pLayer As Object
For Each pLayer In https://www.doczj.com/doc/3d13453008.html,yers
TOC.AddItem https://www.doczj.com/doc/3d13453008.html,
TOC.Selected(TOC.NewIndex) = True
Next
Set Selection = New SubCollection
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
V iew.Width = Me.ScaleWidth - TOC.Width - 50
V iew.Height = Me.ScaleHeight - Toolbar.Height
TOC.Height = V iew.Height
End If
End Sub
Private Sub InfoGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As
Single)
With InfoGrid
If Button = vbLeftButton Then
If x < .ColWidth(0) And y > .RowHeight(0) Then
FlashFeature .TextMatrix(.Row, 0), True
End If
End If
End With
End Sub
Private Sub Map_AfterTrackingLayerDraw(hDC As stdole.OLE_HANDLE)
Dim SelectedSymbol As New MapObjects2.Symbol, i As Integer
If Selection.SelectCollection Is Nothing Then Exit Sub
If Selection.SelectCollection.Count = 0 Then Exit Sub
SelectedSymbol.SymbolType=https://www.doczj.com/doc/3d13453008.html,yers(https://www.doczj.com/doc/3d13453008.html,yerName).Symbol.SymbolType
SelectedSymbol.Size = https://www.doczj.com/doc/3d13453008.html,yers(https://www.doczj.com/doc/3d13453008.html,yerName).Symbol.Size
SelectedSymbol.Style = https://www.doczj.com/doc/3d13453008.html,yers(https://www.doczj.com/doc/3d13453008.html,yerName).Symbol.Style
Select Case https://www.doczj.com/doc/3d13453008.html,yers(https://www.doczj.com/doc/3d13453008.html,yerName).shapeType
Case moShapeTypePoint
SelectedSymbol.Color = moCyan
SelectedSymbol.Outline = True
SelectedSymbol.OutlineColor = moBlue
Case moShapeTypeLine
SelectedSymbol.Color = moBlue
Case moShapeTypePolygon
SelectedSymbol.Color = moCyan
SelectedSymbol.Outline = True
SelectedSymbol.OutlineColor = moBlue
SelectedSymbol.Style = moLightGrayFill
End Select
Map.DrawShape Selection.SelectCollection, SelectedSymbol
End Sub
Private Sub Map_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim pMapExtent As New MapObjects2.Rectangle
Set pMapExtent = Map.Extent
If Button = vbLeftButton Then
Select Case CurrentTool
Case ToolZoomIn
pMapExtent.ScaleRectangle 0.5
Map.Extent = pMapExtent.Extent
Case ToolZoomout
pMapExtent.ScaleRectangle 2
Map.Extent = pMapExtent.Extent
Case ToolPan
Map.Pan
Case ToolSelByPt
Set SelectShape = Map.ToMapPoint(x, y)
SelectEntity
ShowInfo
Case ToolSelByBox
Set SelectShape = Map.TrackRectangle
SelectEntity
ShowInfo
End Select
End If
End Sub
Private Sub mnuRemoveLayer_Click()
If Not (Selection.SelectCollection Is Nothing) Then
If Selection.SelectCollection.Count > 0 Then
If https://www.doczj.com/doc/3d13453008.html,yerName = TOC.Text Then
Set Selection.SelectCollection = Nothing
ShowInfo
End If
End If
End If
https://www.doczj.com/doc/3d13453008.html,yers.Remove TOC.ListIndex
Map.Refresh
TOC.RemoveItem TOC.ListIndex
End Sub
Private Sub Toolbar_ButtonClick(ByV al Button As MSComctlLib.Button) Select Case Button.Key
Case "ZoomIn"
CurrentTool = ToolZoomIn
Case "ZoomOut"
CurrentTool = ToolZoomout
Case "Pan"
CurrentTool = ToolPan
Case "ZoomAll"
Map.Extent = Map.FullExtent
Case "SelByPt"
CurrentTool = ToolSelByPt
Case "SelByBox"
CurrentTool = ToolSelByBox
End Select
End Sub
Private Sub V iew_Resize()
Map.Width = V iew.ScaleWidth
InfoGrid.Width = View.ScaleWidth
If InfoGrid.Visible Then
InfoGrid.Top = V iew.ScaleHeight - InfoGrid.Height
Map.Height = View.ScaleHeight - InfoGrid.Height - 50
Else
Map.Height = View.ScaleHeight
End If
End Sub
Public Sub SelectEntity()
Dim i As Integer
Dim CLayer As MapObjects2.MapLayer
Set Selection = New SubCollection
If TOC.ListIndex = -1 Then Exit Sub
Screen.MousePointer = vbHourglass
Set CLayer = https://www.doczj.com/doc/3d13453008.html,yers(TOC.Text)
https://www.doczj.com/doc/3d13453008.html,yerName = https://www.doczj.com/doc/3d13453008.html,
If Not SelectShape Is Nothing Then
Select Case SelectShape.shapeType
Case moShapeTypePoint
Set Selection.SelectCollection =
CLayer.SearchShape(SelectShape.Buffer(Map.ToMapDistance(8)), moAreaIntersect, "")
Case moShapeTypeRectangle
Set Selection.SelectCollection = CLayer.SearchShape(SelectShape, moAreaIntersect, "")
End Select
Map.Refresh
End If
Screen.MousePointer = vbDefault
End Sub
Private Sub ShowInfo()
InfoGrid.ClearStructure
InfoGrid.Clear
If Not (Selection.SelectCollection Is Nothing) Then
If Selection.SelectCollection.Count > 0 Then
Dim i As Integer, j As Integer
Set LayerRecords = https://www.doczj.com/doc/3d13453008.html,yers(TOC.Text).Records
Set LayerDesc = LayerRecords.TableDesc
InfoGrid.Rows = 2
InfoGrid.FixedRows = 1
InfoGrid.Cols = 1 + LayerDesc.FieldCount
InfoGrid.ColWidth(0) = 800
InfoGrid.Row = 0
InfoGrid.Col = 0
InfoGrid.Text = "系统标识"
For i = 0 To LayerDesc.FieldCount - 1
InfoGrid.Col = i + 1
InfoGrid.ColWidth(i + 1) = 1000
InfoGrid.Text = LayerDesc.FieldName(i)
Next
j = 1
Selection.SelectCollection.MoveFirst
Do While Not Selection.SelectCollection.EOF
If j <> 1 Then
InfoGrid.AddItem "", j
End If
InfoGrid.Row = j
InfoGrid.Col = 0
InfoGrid.Text = Selection.SelectCollection.Fields("featureID").V alueAsString
For i = 1 To LayerDesc.FieldCount
InfoGrid.Col = i
InfoGrid.Text = Selection.SelectCollection.Fields(LayerDesc.FieldName(i -
1)).V alueAsString
Next i
j = j + 1
Selection.SelectCollection.MoveNext
Loop
InfoGrid.Row = 1
InfoGrid.Col = 1
InfoGrid.ColSel = InfoGrid.Cols - 1
InfoGrid.Visible = True
InfoGrid.Top = V iew.ScaleHeight - InfoGrid.Height
Map.Height = View.ScaleHeight - InfoGrid.Height - 50
Else
InfoGrid.Visible = False
Map.Height = View.ScaleHeight
End If
Else
InfoGrid.Visible = False
Map.Height = View.ScaleHeight
End If
Set LayerDesc = Nothing
Set LayerRecords = Nothing
End Sub
Private Sub FlashFeature(fid As String, Flash As Boolean)
Selection.SelectCollection.MoveFirst
Do While Not Selection.SelectCollection.EOF
If Selection.SelectCollection.Fields("FeatureID").V alueAsString = fid Then
If Flash Then
Map.FlashShape Selection.SelectCollection.Fields("Shape").V alue, 2
End If
Exit Do
End If
Selection.SelectCollection.MoveNext
Loop
End Sub
1）在Common模块的代码窗口中添加如下代码：
Public OkCancel As Boolean
2）在Form1窗体的下方中添加一个状态栏控件StatusBar，并在状态栏添加三个窗格。窗格1用于实时显示鼠标所在位置的坐标，窗格2用于显示当前地图比例尺，窗格3用于显示当前的命令状态和相关提示。
3）选择主菜单[工程]—>[添加窗体]菜单项，在项目中新建一个对话框窗体Query作为用户交互输入属性查询条件表达式的界面。
4）如图6.1所示，在Query对话框对象窗口中分别添加四个ComboBox控件（ComboLayers 、
ComboFields、ComboOperators、ComboV alues）、一个多行文本框控件TxtExpression、三个命令按钮（CmdAdd、CmdOk、CmdCancel）并在对话框窗体的代码窗口中添加如下代码：
图6.1
Dim recset As MapObjects2.Recordset
Private Sub ComboLayers_Click()
Dim i As Long
Set recset = https://www.doczj.com/doc/3d13453008.html,yers(ComboLayers.Text).Records
ComboFields.Clear
For i = 0 To recset.TableDesc.FieldCount - 1
ComboFields.AddItem recset.TableDesc.FieldName(i)
ComboFields.ItemData(ComboFields.ListCount - 1) = recset.TableDesc.FieldType(i)
Next i
If ComboFields.ListCount > 0 Then
ComboFields.ListIndex = 0
End If
TxtExpression.Text = ""
End Sub
Private Sub ComboFields_Click()
Dim SearchText As New MapObjects2.Strings, i As Long
ComboOperators.Clear
Select Case ComboFields.ItemData(ComboFields.ListIndex)
Case moString
ComboOperators.AddItem "="
ComboOperators.AddItem "Like"
Case moLong, moDouble, moDate
ComboOperators.AddItem ">"
ComboOperators.AddItem "<"
ComboOperators.AddItem "="
ComboOperators.AddItem "<>"
ComboOperators.AddItem ">="
ComboOperators.AddItem "<="
Case moBoolean
ComboOperators.AddItem "="
End Select
If ComboOperators.ListCount > 0 Then
ComboOperators.ListIndex = 0
End If
ComboV alues.Clear
If ComboFields.ItemData(ComboFields.ListIndex) = moBoolean Then
ComboV alues.AddItem "True"
ComboV alues.AddItem "Flase"
Else
SearchText.Unique = True
recset.MoveFirst
For i = 0 To recset.Count - 1
SearchText.Add recset.Fields(ComboFields.Text).V alueAsString
recset.MoveNext
Next
SearchText.Sort 0
For i = 0 To SearchText.Count2 - 1
ComboV alues.AddItem SearchText.Item(i)
Next i
End If
If ComboV alues.ListCount > 0 Then
ComboV alues.ListIndex = 0
End If
End Sub
Private Sub cmdAdd_Click()
Dim Expression As String
If (Not Trim(ComboFields.Text) = "") And (Not Trim(ComboFields.Text) = "") And (Not Trim(ComboFields.Text) = "") Then
Select Case ComboFields.ItemData(ComboFields.ListIndex)
Case moString
Expression = ComboFields.Text & " " & ComboOperators.Text & " '" & ComboV alues.Text & "'"
Case moLong, moDouble, moDate
Expression = ComboFields.Text & " " & ComboOperators.Text & " " & ComboV alues.Text
Case moBoolean
If Trim(ComboV alues.Text) = "True" Then
Expression = ComboFields.Text & " = True"
Else
Expression = ComboFields.Text & " = False"
End If
End Select
If Trim(TxtExpression.Text) = "" Then
TxtExpression.Text = Expression
Else
TxtExpression.Text = TxtExpression.Text & " AND " & Expression
End If
End If
End Sub
Private Sub cmdOk_Click()
OkCancel = True
Set Selection = New SubCollection
https://www.doczj.com/doc/3d13453008.html,yerName = ComboLayers.Text
Set Selection.SelectCollection = https://www.doczj.com/doc/3d13453008.html,yers(ComboLayers.Text).SearchExpression(TxtExpression.Text)
If Selection.SelectCollection.EOF Then
Form1.StatusBar.Panels(3).Text = "未搜索到任何满足条件的要素。"
Else
Dim i As Long
i = 0
Do While Not Selection.SelectCollection.EOF
i = i + 1
Selection.SelectCollection.MoveNext
Loop
Form1.StatusBar.Panels(3).Text = "搜索到" & i & "个满足条件的要素。"
End If
Form1.Map.Refresh
Unload Me
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 0 To https://www.doczj.com/doc/3d13453008.html,yers.Count - 1
If https://www.doczj.com/doc/3d13453008.html,yers(i).LayerType = moMapLayer Then
ComboLayers.AddItem https://www.doczj.com/doc/3d13453008.html,yers(i).Name
ComboLayers.ItemData(ComboLayers.ListCount - 1) = i
End If
Next
ComboLayers.Text = Form1.TOC.Text
End Sub
5）在ImageList控件的[属性页]对话框中插入SQL查询功能的位图图片，接着在ToolBar 控件的[属性页]对话框中插入SQL查询按钮并将该按钮的Image属性对应ImageList控件中新插入的图片。
6）在Form1窗体的代码窗口中修改并添加如下代码：
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
V iew.Width = Me.ScaleWidth - TOC.Width - 50
V iew.Height = Me.ScaleHeight - Toolbar.Height - StatusBar.Height
TOC.Height = V iew.Height
End If
End Sub
Private Sub Map_AfterLayerDraw(ByV al index As Integer, ByV al canceled As Boolean,
ByV al hDC As stdole.OLE_HANDLE)
Dim DispScale As Double
DispScale = ScaleY(Map.Extent.Top - Map.Extent.Bottom, 6, 1) * 1000 / Map.Height
StatusBar.Panels(2).Text = "1:" & FormatNumber(DispScale, 0, vbTrue, vbFalse,
vbFalse)
End Sub
Private Sub Map_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single)
StatusBar.Panels(1).Text = FormatNumber(Map.ToMapPoint(X, Y).Y, 2, vbTrue,
vbFalse, vbFalse) _
& " , " & FormatNumber(Map.ToMapPoint(X, Y).X, 2, vbTrue, vbFalse, vbFalse)
End Sub
1）在Common模块的代码窗口中添加如下代码：
Public Function FindFirst(ByRef recs As MapObjects2.Recordset, ByV al fid As Long)
As Boolean
FindFirst = False
recs.MoveFirst
Do While Not recs.EOF
If recs.Fields("FeatureID").V alue = fid Then
FindFirst = True
Exit Do
Else
recs.MoveNext
End If
Loop
End Function
2）在项目中新建一个对话框窗体EditIno作为编辑属性的用户界面，在EditIno对话框对象
窗口中分别添加一个文本框TxtV alue、一个MSHFlexGrid控件FieldsGrid和二个命令按钮（CmdOk、CmdCancel），并在该对话框的代码窗口中添加如下代码：Dim Modify As Boolean
Private Sub CmdOk_Click()
Modify = True
Unload Me
End Sub
Private Sub CmdCancel_Click()
Modify = False
Unload Me
End Sub
Private Sub Form_Load()
If Not FindFirst(Selection.SelectCollection, https://www.doczj.com/doc/3d13453008.html,Grid.TextMatrix(https://www.doczj.com/doc/3d13453008.html,Grid.Row, 0)) Then
Unload Me
End If
Dim j As Integer
Modify = False
FieldsGrid.ColWidth(0) = FieldsGrid.Width * 0.25
FieldsGrid.ColWidth(1) = FieldsGrid.Width * 0.75
FieldsGrid.ColAlignment(1) = 1
FieldsGrid.Row = 0
FieldsGrid.Col = 0
FieldsGrid.ColSel = 1
FieldsGrid.Clip = "字段名称" & Chr(9) & "字段值"
For j = 0 To LayerDesc.FieldCount - 1
If j = 0 Then
FieldsGrid.Row = 1
FieldsGrid.Col = 0
FieldsGrid.ColSel = 1
FieldsGrid.Clip = LayerDesc.FieldName(j) & Chr(9) & Selection.SelectCollection.Fields(LayerDesc.FieldName(j)).V alueAsString
Else
FieldsGrid.AddItem LayerDesc.FieldName(j) & Chr(9) & Selection.SelectCollection.Fields(LayerDesc.FieldName(j)).V alueAsString
End If
Next
FieldsGrid.Row = 1
FieldsGrid.Col = 1
LblField.Caption = FieldsGrid.TextMatrix(1, 0)
TxtV alue.Text = FieldsGrid.TextMatrix(1, 1)
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Modify Then
If Selection.SelectCollection.Updatable Then
Call FindFirst(Selection.SelectCollection, https://www.doczj.com/doc/3d13453008.html,Grid.TextMatrix(https://www.doczj.com/doc/3d13453008.html,Grid.Row, 0))
Selection.SelectCollection.Edit
Dim i As Integer
For i = 0 To FieldsGrid.Rows - 2
Select Case Selection.SelectCollection.Fields(LayerDesc.FieldName(i)).Type
Case moBoolean
If FieldsGrid.TextMatrix(i + 1, 1) = "True" Then
Selection.SelectCollection.Fields(LayerDesc.FieldName(i)).V alue = 1
End If
If FieldsGrid.TextMatrix(i + 1, 1) = "False" Then
Selection.SelectCollection.Fields(LayerDesc.FieldName(i)).V alue = 0
End If
Case moDate
Selection.SelectCollection.Fields(LayerDesc.FieldName(i)).V alue = Format(FieldsGrid.TextMatrix(i + 1, 1), "yyyy-mm-dd")
Case Else
Selection.SelectCollection.Fields(LayerDesc.FieldName(i)).V alue = FieldsGrid.TextMatrix(i + 1, 1)
End Select
Next
Selection.SelectCollection.Update
Selection.SelectCollection.StopEditing
Else
MsgBox "当前图层的编辑模式处于锁定状态！", vbOKOnly
End If
End If
End Sub
Private Sub FieldsGrid_EnterCell()
On Error Resume Next
TxtV alue.Text = FieldsGrid.Text
If FieldsGrid.Row > 0 Then
Dim FldType As String
Select Case LayerDesc.FieldType(FieldsGrid.Row - 1)
Case moString
FldType = "(文本型)"
Case moDate
FldType = "(日期型)"
Case moLong
FldType = "(长整型)"
Case moDouble
FldType = "(数值型)"
Case moBoolean
FldType = "(逻辑型)"
End Select
LblField.Caption = LayerDesc.FieldName(FieldsGrid.Row - 1) & Chr(13) & FldType
TxtV alue.Tag = FldType
TxtV alue.SetFocus
End If
End Sub
Private Sub TxtV alue_Change()
If FieldsGrid.Row > 0 Then
FieldsGrid.Text = TxtV alue.Text
End If
End Sub
Private Sub TxtV alue_GotFocus()
TxtV alue.SelStart = 0
TxtV alue.SelLength = Len(TxtV alue.Text)
End Sub
Private Sub TxtV alue_V alidate(Cancel As Boolean)
Select Case TxtV alue.Tag
Case "(文本型)"
Case "(日期型)"
If IsDate(TxtV alue.Text) Then
TxtV alue.Text = Format(TxtV alue.Text, "YYYY-MM-DD")
Else
Cancel = True
MsgBox "请输入一个日期值！", vbCritical, "错误"
TxtV alue_GotFocus
End If
Case "(长整型)"
If Not IsNumeric(TxtV alue.Text) Then
Cancel = True
MsgBox "请输入一个长整型值！", vbCritical, "错误"
TxtV alue_GotFocus
Else
TxtV alue.Text = Fix(TxtV alue.Text)
End If
Case "(数值型)"
If Not IsNumeric(TxtV alue.Text) Then
Cancel = True
MsgBox "请输入一个数值型值！", vbCritical, "错误"
TxtV alue_GotFocus
End If
Case "(逻辑型)"
If Not IsNumeric(TxtV alue.Text) Then
If UCase(TxtV alue.Text) = "Y" Or UCase(TxtV alue.Text) = "TRUE" Or TxtV alue.Text = "是" Or TxtV alue.Text = "真" Then
TxtV alue.Text = "True"
ElseIf UCase(TxtV alue.Text) = "N" Or UCase(TxtV alue.Text) = "FALSE" Or TxtV alue.Text = "否" Or TxtV alue.Text = "假" Then
TxtV alue.Text = "False"
Else
Cancel = True
MsgBox "请输入一个逻辑型值！", vbCritical, "错误"
TxtV alue_GotFocus
End If
Else
If TxtV alue.Text <> 0 Then
TxtV alue.Text = "True"
Else
TxtV alue.Text = "False"
End If
End If
End Select
End Sub
3）启动VB 6.0集成开发环境的菜单编辑器，创建一个名为PopMenu2的快捷菜单，并在该菜单中创建mnuEditInfo和mnuDelEntity菜单项，然后在Form1的代码编辑窗中添加如下代码：
Private Sub mnuDelEntity_Click()
If MsgBox("你是否真的决定删除当前要素？", vbYesNo, "提示") = vbYes Then
If Selection.SelectCollection.Updatable Then
If FindFirst(Selection.SelectCollection, InfoGrid.TextMatrix(InfoGrid.Row, 0)) Then
Selection.SelectCollection.Delete
Selection.SelectCollection.StopEditing
If SelExpression = "" Then
SelectEntity
Else
Set Selection.SelectCollection = https://www.doczj.com/doc/3d13453008.html,yers(https://www.doczj.com/doc/3d13453008.html,yerName).SearchExpression(SelExpression)
End If
ShowInfo
Map.Refresh
End If
End If
End If