frmatt.frm

用于河南省主体功能区区划的一个小地理信息系统

    For i = 1 To querynamestr.Count
        If attlyrname = querynamestr(i) Then
            querynamestr.Remove attlyrname
            querystr.Remove attlyrname
            queryrecs.Remove attlyrname
            Exit For
        End If
    Next i

    Set queryrec = frmmain.Map1.Layers(attlyrname).Records
    querynamestr.Add attlyrname, attlyrname
    querystr.Add "FeatureId>=1", attlyrname
    queryrecs.Add queryrec, attlyrname
    
    cmdup.Enabled = True
  Case 1
    For m = 1 To lvwatt.ListItems.Count
        lvwatt.ListItems(m).Selected = False
    Next m
    Lblselnum.Caption = "选中 " & 0
    cmdup.Enabled = False
    '判断是否有选定行集，并将其初始化
    For i = 1 To querynamestr.Count
        If attlyrname = querynamestr(i) Then
            querynamestr.Remove attlyrname
            querystr.Remove attlyrname
            queryrecs.Remove attlyrname
            Exit For
        End If
    Next i
 
  Case 2
    Dim selnum As Integer
    For m = 1 To lvwatt.ListItems.Count
        If lvwatt.ListItems(m).Selected = True Then
            selallitems = False
            lvwatt.ListItems(m).Selected = False
        Else
            lvwatt.ListItems(m).Selected = True
            selnum = selnum + 1
        End If
    Next m
    If selnum > 0 Then
        cmdup.Enabled = True
    Else
        cmdup.Enabled = False
    End If
    Lblselnum.Caption = "选中 " & selnum
    
    For i = 1 To querynamestr.Count
        If attlyrname = querynamestr(i) Then
            repeated = True
            query = "not " & "(" & querystr(i) & ")"
            Set queryrec = frmmain.Map1.Layers(attlyrname).SearchExpression(query)
            
            querystr.Remove attlyrname
            queryrecs.Remove attlyrname
            
            querystr.Add query, attlyrname
            queryrecs.Add queryrec, attlyrname
            Exit For
        End If
    Next i

    If repeated = False Then
        Set queryrec = frmmain.Map1.Layers(attlyrname).Records
        querynamestr.Add attlyrname, attlyrname
        querystr.Add "FeatureId>=1", attlyrname
        queryrecs.Add queryrec, attlyrname
    End If

End Select

lvwatt.SetFocus
queryenable = True
frmmain.Map1.TrackingLayer.Refresh True

End Sub

Private Sub Cmdstatistics_Click()
' lvwatt.SetFocus
  
  '判断按钮是否可用
If Cmdstatistics.Enabled = True Then
'    Dim dotnum As Integer
'    Dim desc As MapObjects2.TableDesc
'    Set desc = recs.TableDesc
'    dotnum = desc.FieldScale(3)
    
    '算出统计
    Dim stats As MapObjects2.Statistics
    Set stats = recs.CalculateStatistics(selcoltxt)
    Dim i As Integer
    For i = 1 To querynamestr.Count
        If attlyrname = querynamestr(attlyrname) Then
            Set queryrec = queryrecs(attlyrname)
            Set stats = queryrec.CalculateStatistics(selcoltxt)
            Exit For
        End If
    Next i

    FrmFieldstc.TxtFieldstc.Text = "记录个数：" & CStr(stats.Count) + vbCrLf
    FrmFieldstc.TxtFieldstc.Text = FrmFieldstc.TxtFieldstc.Text + "字段之和：" & CStr(Format(stats.Sum, "##0.00")) + vbCrLf
    FrmFieldstc.TxtFieldstc.Text = FrmFieldstc.TxtFieldstc.Text + "平均值：" & CStr(Format(stats.Mean, "##0.00")) + vbCrLf
    FrmFieldstc.TxtFieldstc.Text = FrmFieldstc.TxtFieldstc.Text + "最大值：" & CStr(Format(stats.Max, "##0.00")) + vbCrLf
    FrmFieldstc.TxtFieldstc.Text = FrmFieldstc.TxtFieldstc.Text + "最小值：" & CStr(Format(stats.Min, "##0.00")) + vbCrLf
    FrmFieldstc.TxtFieldstc.Text = FrmFieldstc.TxtFieldstc.Text + "变化范围：" & CStr(Format(stats.Max - stats.Min, "##0.00")) + vbCrLf
    FrmFieldstc.TxtFieldstc.Text = FrmFieldstc.TxtFieldstc.Text + "标准偏差：" & CStr(Format(stats.StdDev, "##0.00"))
    FrmFieldstc.Show 1
End If
End Sub

Private Sub cmdup_Click()
  '初始化
  lvwatt.Sorted = False
  lvwatt.SetFocus
  Dim j As Integer
  j = 1
  
  Dim itemtxt As String
  Dim subitemtxt As New MapObjects2.Strings
  Dim newlst As ListItem
  
  subitemtxt.Unique = False
  '将选定行提前
  Dim i As Integer
  For i = 1 To lvwatt.ListItems.Count
  If lvwatt.ListItems(i).Selected = True Then
    ' Set lvwatt.ListItems(j) = lvwatt.ListItems(i)
     '先删除行，后重新添加
     itemtxt = lvwatt.ListItems(i).Text
     Dim X As Integer
     For X = 1 To lvwatt.ColumnHeaders.Count - 1
        subitemtxt.Add lvwatt.ListItems(i).SubItems(X)
     Next X
     lvwatt.ListItems.Remove i
     
     Set newlst = lvwatt.ListItems.Add(j, , itemtxt)
     
     For X = 1 To lvwatt.ColumnHeaders.Count - 1
        newlst.SubItems(X) = subitemtxt.item(X - 1)
        'newlst.ListSubItems.Add , , subitemtxt.item(x - 1)
     Next X
     newlst.Selected = True
    
     subitemtxt.Clear
    ' lvwatt.Sorted = True
    ' lvwatt.ListItems(i).Index = j
     j = j + 1
     
  End If
  Next i

End Sub

Private Sub Form_activate()
'在列表浏览器中高亮显示选中记录
'lvwatt.SetFocus
Screen.MousePointer = ccHourglass
Dim i As Integer
For i = 1 To lvwatt.ListItems.Count
    lvwatt.ListItems(i).Selected = False
Next i
lvwatt.SetFocus
getfocus
Screen.MousePointer = ccDefault
End Sub

Private Sub Form_Load()
 '初始化列表浏览器属性
 With lvwatt
   .HideColumnHeaders = False
   .View = lvwReport
   .GridLines = True
   .LabelEdit = lvwManual
   .MultiSelect = True
   .FullRowSelect = True
   .ColumnHeaderIcons = imglsticon
   .AllowColumnReorder = True
 End With
 Lblselnum.Caption = "选中 0"
'判断排序按钮是否可用
appcmdbutton = False
cmdbutton(0).Enabled = False
cmdbutton(1).Enabled = False

cmdup.Enabled = False
Cmdstatistics.Enabled = False

Prgbarsel.Visible = False
Prgbarsel.Min = 0
Prgbarsel.Max = 100
End Sub

Private Sub Form_Resize()
If Not frmatt.WindowState = 1 Then
    If Me.Height > 1400 And Me.Width > 250 Then
    lvwatt.Left = 50
    lvwatt.Top = 600
    
    lvwatt.Width = Me.Width - 250
    lvwatt.Height = Me.Height - 1400
    cmdquery.Left = lvwatt.Left + lvwatt.Width - 375
    Cmdstatistics.Left = cmdquery.Left - 375 - 50
    cmdidentify.Left = Cmdstatistics.Left - 375 - 50
    cmdup.Left = cmdidentify.Left - 375 - 50
    cmdbutton(1).Left = cmdup.Left - 375 - 50
    cmdbutton(0).Left = cmdbutton(1).Left - 375 - 50
    cmdsel(2).Left = cmdbutton(0).Left - 375 - 250
    cmdsel(1).Left = cmdsel(2).Left - 375 - 50
    cmdsel(0).Left = cmdsel(1).Left - 375 - 50
    Cmdarrow.Left = cmdsel(0).Left - 375 - 250
    
    With Lblnum
        .Left = lvwatt.Left + 2000
        .Width = 1200
    End With
    With Lblselnum
        .Left = lvwatt.Left + 500
        .Width = 1200
    End With
    Prgbarsel.Left = lvwatt.Left
    Prgbarsel.Width = 4000
    
    End If
End If
End Sub

Private Sub lvwatt_Click()
'获得记录集
If frmattidentify = False Then
lvwatt.MultiSelect = False
getrecs
End If
End Sub

Private Sub lvwatt_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

'设置icon属性进行选定列判断
 
  'Label1.Caption = ColumnHeader.Index
  lvwatt.SetFocus
  
  Select Case lvwatt.ColumnHeaders(ColumnHeader.Index).Icon
       Case 0
         lvwatt.ColumnHeaders(ColumnHeader.Index).Icon = "selecteditem"
         selcol = ColumnHeader.Index
         appcmdbutton = True
         Dim i As Integer
         For i = 1 To lvwatt.ColumnHeaders.Count
            If i <> ColumnHeader.Index Then
               lvwatt.ColumnHeaders(i).Icon = 0
               lvwatt.ColumnHeaders(i).Alignment = lvwColumnLeft
            End If
          Next i
        Case "selecteditem"
          lvwatt.ColumnHeaders(ColumnHeader.Index).Icon = 0
          lvwatt.ColumnHeaders(ColumnHeader.Index).Alignment = lvwColumnLeft
          appcmdbutton = False
  End Select
  
If appcmdbutton = True Then
    cmdbutton(0).Enabled = True
    cmdbutton(1).Enabled = True
    Cmdstatistics.Enabled = False

    selcoltxt = lvwatt.ColumnHeaders(selcol).Text
          
    If recs.Fields(selcoltxt).Type = moLong Or _
        recs.Fields(selcoltxt).Type = moDouble Or _
        recs.Fields(selcoltxt).Type = moDate Then
        
        Cmdstatistics.Enabled = True
    End If
Else
    cmdbutton(0).Enabled = False
    cmdbutton(1).Enabled = False
    Cmdstatistics.Enabled = False
End If
   'Set recs = frmmain.Map1.Layers(attlyrname).Records
   'Label2.Caption = recs.Fields(lvwatt.ColumnHeaders(selcol).text).Type
End Sub


Private Sub lvwatt_itemclick(ByVal item As MSComctlLib.ListItem)
'获得记录集
' lvwatt.MultiSelect = False
' getrecs
If frmattidentify = True Then
'Dim identifytxt As String
identifytxt = item.Text
Call FrmIdentify.expressionidentify
FrmIdentify.ZOrder 0
End If

End Sub

Private Sub lvwatt_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift And vbShiftMask Then
   lvwatt.MultiSelect = False
End If
If Shift And vbCtrlMask Then
   lvwatt.MultiSelect = False
End If
End Sub

Sub getrecs()

repeated = False
Dim itemtxt As String, postitemtxt As String
Dim k As Integer, i As Integer

For k = 1 To lvwatt.ListItems.Count
    If lvwatt.ListItems(k).Selected = True Then
        Lblselnum.Caption = "选中 " & 1
        itemtxt = lvwatt.ListItems(k).Text
        postitemtxt = "FeatureId=" & itemtxt
        Set queryrec = frmmain.Map1.Layers(attlyrname).SearchExpression(postitemtxt)
        Exit For
    End If
Next k
'得到选定行集的数组
For i = 1 To querynamestr.Count
    If attlyrname = querynamestr(i) Then
        repeated = True
        
        If Not queryrec Is Nothing Then
            querystr.Remove attlyrname
            querystr.Add postitemtxt, attlyrname
                
            queryrecs.Remove attlyrname
            queryrecs.Add queryrec, attlyrname
        Else
            querynamestr.Remove attlyrname
            querystr.Remove attlyrname
            queryrecs.Remove attlyrname
        End If
        
        Exit For
    End If
Next i

If repeated = False Then
    If Not queryrec Is Nothing Then
    querynamestr.Add attlyrname, attlyrname
    querystr.Add postitemtxt, attlyrname
    queryrecs.Add queryrec, attlyrname
    End If
End If
 
cmdup.Enabled = True
queryenable = True
frmmain.Map1.TrackingLayer.Refresh True
'End If
End Sub

Sub getfocus()

Dim i As Integer
Dim j As Integer
Dim selnum As Integer
selnum = -1
'cmdup.Enabled = False
For j = 1 To querynamestr.Count
    If attlyrname = querynamestr(j) Then
        Set queryrec = queryrecs(j)
        queryrec.MoveFirst
        Prgbarsel.Visible = True
        Prgbarsel.Value = 0
        
        Do Until queryrec.EOF
'            For i = 1 To lvwatt.ListItems.Count
'                If lvwatt.ListItems(i).text = queryrec("FeatureId").ValueAsString Then
            Dim Fid As Integer
            Fid = queryrec("FeatureId").Value
            lvwatt.ListItems(Fid).Selected = True
'                    Exit For
'                End If
'            Next i
                    'lvwatt.SetFocus
            queryrec.MoveNext
            selnum = selnum + 1
            If Prgbarsel.Value >= 100 Then Prgbarsel.Value = 0
            Prgbarsel.Value = Prgbarsel.Value + 1
            DoEvents
        Loop
        
        Prgbarsel.Visible = False
        If selnum > 0 Then cmdup.Enabled = True
        Lblselnum.Caption = "选中 " & selnum
        
        Exit For
    End If
Next j

End Sub