📄 frmatt.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmatt
Caption = "属性浏览"
ClientHeight = 5205
ClientLeft = 3600
ClientTop = 2985
ClientWidth = 7590
Icon = "frmatt.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5205
ScaleWidth = 7590
Begin MSComctlLib.ProgressBar Prgbarsel
Height = 255
Left = 720
TabIndex = 13
Top = 240
Width = 1935
_ExtentX = 3413
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin VB.CommandButton Cmdstatistics
Height = 375
Left = 6360
Picture = "frmatt.frx":0442
Style = 1 'Graphical
TabIndex = 12
ToolTipText = "统计"
Top = 120
Width = 375
End
Begin VB.CommandButton Cmdarrow
Height = 375
Left = 2880
Picture = "frmatt.frx":0C64
Style = 1 'Graphical
TabIndex = 10
ToolTipText = "指针"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdsel
Height = 375
Index = 2
Left = 4080
Picture = "frmatt.frx":11A6
Style = 1 'Graphical
TabIndex = 9
ToolTipText = "反转"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdsel
Height = 375
Index = 0
Left = 3240
Picture = "frmatt.frx":1870
Style = 1 'Graphical
TabIndex = 8
ToolTipText = "全选"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdsel
Height = 375
Index = 1
Left = 3600
Picture = "frmatt.frx":213A
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "清除选择"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdquery
Height = 375
Left = 6720
Picture = "frmatt.frx":29B0
Style = 1 'Graphical
TabIndex = 6
ToolTipText = "条件查询"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdidentify
Height = 375
Left = 5880
MaskColor = &H00FFFFFF&
Picture = "frmatt.frx":31D2
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "查询"
Top = 120
Width = 375
End
Begin MSComctlLib.ImageList imglsticon
Left = 6840
Top = 2400
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmatt.frx":3714
Key = "selecteditem"
EndProperty
EndProperty
End
Begin VB.CommandButton cmdup
Height = 375
Left = 5520
MaskColor = &H00FFFFFF&
Picture = "frmatt.frx":3B66
Style = 1 'Graphical
TabIndex = 3
ToolTipText = "提上"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdbutton
Height = 375
Index = 1
Left = 5040
Picture = "frmatt.frx":4440
Style = 1 'Graphical
TabIndex = 2
ToolTipText = "降序"
Top = 120
Width = 375
End
Begin VB.CommandButton cmdbutton
BackColor = &H8000000A&
Height = 375
Index = 0
Left = 4560
MaskColor = &H00E0E0E0&
Picture = "frmatt.frx":4CB6
Style = 1 'Graphical
TabIndex = 1
ToolTipText = "升序"
Top = 120
Width = 375
End
Begin MSComctlLib.ListView lvwatt
Height = 3495
Left = 600
TabIndex = 0
Top = 600
Width = 5895
_ExtentX = 10398
_ExtentY = 6165
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
_Version = 393217
ForeColor = 0
BackColor = 16777215
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Label Lblnum
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1560
TabIndex = 11
Top = 240
Width = 1095
End
Begin VB.Label Lblselnum
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 4
Top = 240
Width = 975
End
End
Attribute VB_Name = "frmatt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义记录集
Dim recs As MapObjects2.Recordset
'定义选定列索引
Dim selcol As Integer
'判断按钮是否可用
Dim appcmdbutton As Boolean
'判断选定标题行是否可用
Dim appselcol As Boolean
'判断是否按cmdsel为全选
Dim selallitems As Boolean
Dim queryname As String, query As String
Dim queryrec As MapObjects2.Recordset
'声明属性浏览框对应的图层名
Dim attlyrname As String
Dim repeated As Boolean
'选择的字段
Dim selcoltxt As String
Sub filllvwatt()
On Error GoTo cancel
'判断活动图层
Dim Index As Integer
Index = frmmain.TuLi.getActiveLayer
If Index = -1 Then
MsgBox "当前没有活动图层。", vbCritical, "停止"
Exit Sub
End If
'判断活动图层属性，获得图层记录集和字段特性集
attlyrname = frmmain.Map1.Layers(Index).Name
If frmmain.Map1.Layers(attlyrname).LayerType = moMapLayer Then
Set recs = frmmain.Map1.Layers(attlyrname).Records
If recs.EOF Then Exit Sub
Frmwait.ProgressBar1.Max = recs.Count
Lblnum.Caption = "记录 " & recs.Count
Dim desc As TableDesc
Set desc = recs.TableDesc
'清空列表浏览器标题行，重新添加
lvwatt.ColumnHeaders.Clear
lvwatt.ColumnHeaders.Add , , "FeatureId"
Dim i As Integer
For i = 0 To desc.FieldCount - 1
lvwatt.ColumnHeaders.Add , , desc.FieldName(i)
Next
'清空列表浏览器项目，逐行添加
lvwatt.ListItems.Clear
Frmwait.Show
Dim Prgs As Long
'Prgs = 0
Do While Not recs.EOF
Dim newitem As ListItem
Set newitem = lvwatt.ListItems.Add()
newitem.Text = recs.Fields("FeatureId").Value 'recs(desc.FieldName(0)).Value '"[" & desc.FieldName(i) & "]"
'逐行添加子项目
For i = 0 To desc.FieldCount - 1
newitem.ListSubItems.Add , , recs(desc.FieldName(i)).ValueAsString
Next i
newitem.Selected = False
recs.MoveNext
Prgs = Prgs + 1
Frmwait.ProgressBar1.Value = Prgs
Frmwait.Label1.Caption = "已完成" & Prgs
DoEvents
Loop
If Prgs = Frmwait.ProgressBar1.Max Then
Unload Frmwait
End If
Else
MsgBox "该图层为栅格图像数据！", vbExclamation, "提示"
Exit Sub
End If
frmatt.Show 1
cancel:
End Sub
Private Sub Cmdarrow_Click()
lvwatt.SetFocus
lvwatt.MousePointer = ccArrow
frmattidentify = False
End Sub
Private Sub cmdbutton_Click(Index As Integer)
lvwatt.SetFocus
'判断按钮是否可用
If appcmdbutton = True Then
selcoltxt = lvwatt.ColumnHeaders(selcol).Text
'Label2.Caption = recs.Fields(selcoltxt).Type
'判断field类型确定排序
If recs.Fields(selcoltxt).Type = moString Or _
recs.Fields(selcoltxt).Type = moBoolean Then
lvwatt.SortKey = selcol - 1
lvwatt.Sorted = True
'判断选择按钮
Select Case Index
Case 0
lvwatt.SortOrder = lvwAscending
Case 1
lvwatt.SortOrder = lvwDescending
End Select
ElseIf recs.Fields(selcoltxt).Type = moLong Or _
recs.Fields(selcoltxt).Type = moDouble Or _
recs.Fields(selcoltxt).Type = moDate Then
lvwatt.Sorted = False
'算出统计最小值，写出排序查询字符串
Dim stats As MapObjects2.Statistics
Set stats = recs.CalculateStatistics(selcoltxt)
Dim recs2 As MapObjects2.Recordset
Dim orderstr As String
Select Case Index
Case 0
orderstr = selcoltxt & ">= " & stats.Min & " order by " & selcoltxt & " asc"
Case 1
orderstr = selcoltxt & ">= " & stats.Min & " order by " & selcoltxt & " desc"
End Select
Set recs2 = frmmain.Map1.Layers(attlyrname).SearchExpression(orderstr)
Dim desc As TableDesc
Set desc = recs2.TableDesc
' lvwatt.ColumnHeaders.Clear
'
' lvwatt.ColumnHeaders.Add , , "FeatureId"
' For i = 0 To desc.FieldCount - 1
' lvwatt.ColumnHeaders.Add , , desc.FieldName(i)
' Next
'清空列表浏览器项目，逐行添加
lvwatt.ListItems.Clear
Do While Not recs2.EOF
Dim newitem As ListItem
Set newitem = lvwatt.ListItems.Add()
newitem.Text = recs2.Fields("FeatureId").Value 'recs(desc.FieldName(0)).Value '"[" & desc.FieldName(i) & "]"
'逐行添加子项目
Dim i As Integer
For i = 0 To desc.FieldCount - 1
newitem.ListSubItems.Add , , recs2(desc.FieldName(i)).ValueAsString
Next i
newitem.Selected = False
recs2.MoveNext
Loop
lvwatt.Refresh
'在列表浏览器中高亮显示选中记录
getfocus
End If
End If
End Sub
Private Sub cmdidentify_Click()
lvwatt.MousePointer = ccArrowQuestion
frmattidentify = True
lvwatt.SetFocus
End Sub
Private Sub cmdquery_Click()
Call frmquery.filllvwfield
frmquery.ZOrder 0
End Sub
Private Sub cmdsel_Click(Index As Integer)
repeated = False
lvwatt.MultiSelect = True
Dim m As Integer
Select Case Index
Case 0
For m = 1 To lvwatt.ListItems.Count
lvwatt.ListItems(m).Selected = True
Next m
Lblselnum.Caption = "选中 " & lvwatt.ListItems.Count
'判断是否有选定行集，并将其初始化
Dim i As Integer
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -