?? frmshowfeatures.frm
字號:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmShowFeatures
Caption = "顯示選擇集"
ClientHeight = 6135
ClientLeft = 60
ClientTop = 345
ClientWidth = 7995
LinkTopic = "Form1"
ScaleHeight = 6135
ScaleWidth = 7995
StartUpPosition = 1 'CenterOwner
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid
Height = 5535
Left = 0
TabIndex = 2
Top = 600
Width = 8055
_ExtentX = 14208
_ExtentY = 9763
_Version = 393216
FixedCols = 0
BackColorBkg = 16777215
AllowUserResizing= 1
End
Begin VB.ComboBox cbLayers
Height = 315
Left = 1200
TabIndex = 1
Top = 200
Width = 3135
End
Begin VB.Label lblFtrCount
Height = 255
Left = 4800
TabIndex = 3
Top = 240
Width = 2295
End
Begin VB.Label Label1
Caption = "圖層名稱:"
Height = 255
Left = 120
TabIndex = 0
Top = 240
Width = 975
End
End
Attribute VB_Name = "frmShowFeatures"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************************
'File Name :frmShowFeatures.frm
'Description :show features property data selected in layers
'Author :James Liu
'Copyright :MapInfo China
'Create Date :2002年9月11日
'********************************************************************************
Private m_scurLayerName As String
Private Sub cbLayers_Click()
If StrComp(m_scurLayerName, Trim(cbLayers.Text), vbTextCompare) <> 0 Then
m_scurLayerName = Trim(cbLayers.Text)
FillData m_scurLayerName
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim oLayer As MapXLib.Layer
Dim oDS As MapXLib.Dataset
Dim oFtr As MapXLib.Feature
Dim oFtrs As MapXLib.Features
Dim bHasFtr As Boolean
Dim sLayerName As String
Dim i As Integer
For Each oLayer In frmMain.Map.Layers
If oLayer.Selection.Count > 0 Then
cbLayers.AddItem Trim(oLayer.Name)
End If
Next oLayer
If cbLayers.ListCount > 0 Then
cbLayers.ListIndex = 0
m_scurLayerName = cbLayers.List(0)
'開始填充數據
FillData m_scurLayerName
Else
cbLayers.Enabled = False
MSFlexGrid.Enabled = False
MsgBox "沒有選擇任何要素!"
End If
End Sub
Private Sub FillData(ByVal sLayerName As String)
Dim oLayer As MapXLib.Layer
Dim oDS As MapXLib.Dataset
Dim oFtr As MapXLib.Feature
Dim oFtrs As MapXLib.Features
Dim bHasFtr As Boolean
Dim i As Integer, j As Integer, k As Integer
On Error Resume Next
Set oLayer = frmMain.Map.Layers(sLayerName)
lblFtrCount.Caption = oLayer.Selection.Count & " 個要素"
Err.Clear
Set oDS = frmMain.Map.DataSets(oLayer.Name)
If Err.Number > 0 Then
Set oDS = frmMain.Map.DataSets.Add(miDataSetLayer, oLayer, oLayer.Name)
Err.Clear
End If
' Set oFtrs = New MapXLib.Features
Set oFtrs = oLayer.Selection
MSFlexGrid.Cols = oDS.Fields.Count
MSFlexGrid.Rows = oLayer.Selection.Count + 1
For i = 1 To oDS.Fields.Count
MSFlexGrid.TextMatrix(0, i - 1) = oDS.Fields(i).Name
Next i
Screen.MousePointer = vbHourglass
For k = 1 To oLayer.Selection.Count
Set oFtr = oLayer.Selection.Item(k)
For j = 1 To oDS.Fields.Count
MSFlexGrid.TextMatrix(k, j - 1) = oDS.value(oFtr, j)
Next j
Next k
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Resize()
MSFlexGrid.Left = 0
MSFlexGrid.Width = Me.Width - 100
MSFlexGrid.Top = cbLayers.Top + cbLayers.Height + 200
MSFlexGrid.Height = Me.Height - MSFlexGrid.Top - 400
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -