www.pudn.com > mapxoracle.zip > FrmBrowser.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmBrowser
Caption = "浏览窗口"
ClientHeight = 4500
ClientLeft = 60
ClientTop = 345
ClientWidth = 6525
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4500
ScaleWidth = 6525
Begin VB.CommandButton Command2
Caption = "退出"
Height = 375
Left = 600
TabIndex = 5
Top = 120
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "删除记录"
Height = 375
Index = 2
Left = 4320
TabIndex = 4
Top = 120
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "修改记录"
Height = 375
Index = 1
Left = 3120
TabIndex = 3
Top = 120
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "增加记录"
Height = 375
Index = 0
Left = 1920
TabIndex = 2
Top = 120
Width = 1095
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 315
Left = 0
TabIndex = 1
Top = 4200
Width = 6030
_ExtentX = 10636
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 5292
MinWidth = 5292
EndProperty
EndProperty
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 3615
Left = 0
TabIndex = 0
Top = 600
Width = 6015
_ExtentX = 10610
_ExtentY = 6376
_Version = 393216
FixedCols = 0
AllowUserResizing= 1
End
End
Attribute VB_Name = "FrmBrowser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
If Formmain.Map1.Layers.Item(ToolBars.Combo2.Text).Selection.Count = 0 Then
MsgBox "请先选择要编辑的对象.", , "警告"
Else
EditFlag = 1
'增加一列
Grid1.Rows = Grid1.Rows + 1
Grid1.Row = Grid1.Rows - 1
Grid1.RowSel = Grid1.Row
Grid1.Col = 0
Grid1.ColSel = Grid1.Cols - 1
DataSetEdit.Show 1
End If
Case 1
EditFlag = 2
DataSetEdit.Show 1
Case 2
Dim ftr As MapXLib.Feature
Dim lyr As MapXLib.layer
Set lyr = Formmain.Map1.Layers(ToolBars.Combo2.Text)
For Each ftr In lyr.Selection
lyr.DeleteFeature ftr
Next
Grid1.Rows = Grid1.Rows - 1
Set lyr = Nothing
Set ftr = Nothing
End Select
End Sub
Private Sub Command2_Click()
BrowserFlag = False
Unload Me
End Sub
Private Sub Form_Load()
'方法一: ds.value(ftr,field)---连接远程数据库时不能读出其属性值
'没有加入FeatureKey列
' Dim DsName As String
' Dim ftrs As New Features
' Dim lyr As MapXLib.Layer
' Dim ds As New MapXLib.Dataset
' Dim i As Integer, j As Integer
' Dim DsCols As Long, DsRows As Long
'
' BrowserFlag = True
'
' DsName = Trim(ToolBars.Combo2.Text)
' If Trim(DsName) = "" Then
' MsgBox "请选择数据集", , "打开浏览窗口"
' Exit Sub
' End If
'
' Set ds = Formmain.Map1.Datasets(DsName)
' DsCols = ds.Fields.Count
' DsRows = ds.RowCount
'
' '将数据集中的数据显示在表格中
' Grid1.Rows = DsRows + 1
' Grid1.Cols = DsCols
'
' Grid1.Row = 0
' For i = 0 To DsCols -1
' Grid1.Col = i
' Grid1.Text = ds.Fields.Item(i + 1).name
' Next i
'
' ds.Layer.BeginAccess miAccessRead
' For i = 1 To DsRows
' For j = 0 To DsCols - 2
' If Not IsNull(ds.Value(i, j + 1)) Then Grid1.TextArray(i * DsCols + j) = ds.Value(i, j + 1)
' Next j
' Next i
' ds.Layer.EndAccess miAccessEnd
'
'
' StatusBar1.Panels.Item(1).Text = "共有" + " " + Str(DsRows) + " " + "条记录"
'
' StatusBar1.Top = Me.ScaleHeight - StatusBar1.Height
'方法二:rowvalue
Dim ds As MapXLib.Dataset, lyr As MapXLib.layer
Dim ftrs As Features
Dim ftr As Feature
Dim rv As RowValue
Dim rvs As RowValues
Dim DsName As String
Dim DsRows As Long, DsCols As Long
Dim i As Long, j As Long
BrowserFlag = True
DsName = Trim(ToolBars.Combo2.Text)
If Trim(DsName) = "" Then
MsgBox "请选择数据集", , "打开浏览窗口"
Exit Sub
End If
Set ds = Formmain.Map1.Datasets.Item(DsName)
Set lyr = ds.layer
Set ftrs = lyr.AllFeatures
DsCols = ds.Fields.Count
DsCols = DsCols + 1 ''多加一列存放Feature.FeatureKey,作为最后一列
DsRows = ftrs.Count
'将数据集中的数据显示在表格中
Grid1.Rows = DsRows + 1
Grid1.Cols = DsCols
Grid1.ColWidth(Grid1.Cols - 1) = 1 'FeatureKey列宽为1,不让用户看到
Grid1.Row = 0
For i = 0 To DsCols - 2 '减去最后一列
Grid1.Col = i
Grid1.Text = ds.Fields.Item(i + 1).name
Next i
Grid1.Col = DsCols - 1
Grid1.Text = "Fkey"
' For i = 1 To ds.Fields.Count
' MsgBox ds.Fields.Item(i).name
' MsgBox ds.Fields.Item(i).Type
' Next i
lyr.BeginAccess miAccessRead
'For i = 1 To DsRows
' For j = 0 To DsCols - 1
i = 1
For Each ftr In ftrs
'Set Ftr = ftrs.Item(i) 'i=ftrs.count时出错
Set rvs = ds.RowValues(ftr)
'Set rv = rvs.Item(j + 1)
j = 0
For Each rv In rvs
If Not IsNull(rv.Value) Then Grid1.TextArray(i * DsCols + j) = Trim(rv.Value)
j = j + 1
Next
Grid1.TextArray(i * DsCols + j) = ftr.FeatureKey
'MsgBox ftr.FeatureKey
i = i + 1
Next
' Next j
'Next i
lyr.EndAccess miAccessEnd
StatusBar1.Panels.Item(1).Text = "共有" + " " + Str(DsRows) + " " + "条记录"
StatusBar1.Top = Me.ScaleHeight - StatusBar1.Height
Set ftr = Nothing
Set ftrs = Nothing
Set ds = Nothing
Set rv = Nothing
Set rvs = Nothing
Set lyr = Nothing
End Sub
Private Sub Form_Resize()
Grid1.Width = Me.ScaleWidth
Grid1.Height = Me.ScaleHeight - StatusBar1.Height - Grid1.Top
StatusBar1.Top = Me.ScaleHeight - StatusBar1.Height
StatusBar1.Width = Me.ScaleWidth
End Sub
Private Sub Form_Terminate()
BrowserFlag = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
BrowserFlag = False
End Sub
Private Sub Grid1_Click()
Dim SelectStr As String
Dim lyr As MapXLib.layer
Dim ftr As MapXLib.Feature
' On Error GoTo error1
Grid1.Col = Grid1.Cols - 1 'FeatureKey
SelectStr = Grid1.Text
Set lyr = Formmain.Map1.Datasets.Item(ToolBars.Combo2.Text).layer
lyr.Selection.SelectByID SelectStr, miSelectionNew
If lyr.Selection.Count > 0 Then
For Each ftr In lyr.Selection
Formmain.Map1.CenterX = ftr.CenterX
Formmain.Map1.CenterY = ftr.CenterY
Next
End If
'显示选择条
Grid1.RowSel = Grid1.Row
Grid1.Col = 0
Grid1.ColSel = Grid1.Cols - 1
error1:
Select Case Err.Number
Case 1004: '出错在 Set ftr = lyr.Selection.Item(1),提示: 没有找到索引的对象item
'仅在连接odbc数据库时出错.打开一般表不出错.
'避免错误:for each ftr in lyr.selection
On Error GoTo 0
End Select
Set ftr = Nothing
Set lyr = Nothing
End Sub