frmbrowser.frm

一个vb+oracle的例子

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