如何利用用户定义的规则创建定制的排序

 

利用ITableSort接口可以完成普通的对记录排序的功能。ITableSortCallBack机制允许用户通过执行自定义的排序算法来完成定制的排序。本例演示了如何创建这样的用户类，通过实现ITableSortCallBack接口来完成该功能。

假设有如下原始数据：其中“Address”字段描述了道路（Street）的道路编号（Street Number）如“2805”，和道路名(Stree Name)如“Citrus Ave”。

 

现在要按道路名排序所有的记录。因为排序字段时必须忽略道路编号，故需要自定排序规则。

l   要点

首先需要创建用户自定义的类，并生成其实例。该类实现了ITableSortCallBack接口。然后把它的引用赋给ITableSort的Compare属性。最后用ITableSort的Sort方法完成排序。

l   程序说明

过程UIBCustomSort_Click是实现模块，调用过程CustomSort实现功能。

类模块clsTailSort为自定义模块，实现ITalbeSortCallBack接口。包括两个函数：ITableSortCallBack_Compare（用于定义字符串比较的规则）和Get_String（用于得到地址字段的道路名部分）。

过程CustomSort中创建Tablesort和clsTailSort的实例，并对结果进行排序，然后调用过程CreateTable，将排序后的结果存入C:\temp目录的NewSortTable.dbf文件，并作为独立表加入当前Map。

l   代码

  类模块clsTailSort

Option Explicit

' Custom class for ITableSortCallBack

' ClassName:  clsTailSort

Implements ItableSortCallBack

Private Function ITableSortCallBack_Compare(ByVal value1 As Variant, ByVal value2 As_

Variant,ByVal FieldIndex As Long, ByVal fieldSortIndex As Long) As Long

    ' Custom table sort

    ' Get_string function gets the first block of characters (e.g street numbers)

    ' in each value.

    ' Comparison is then made on the remaining characters (e.g. street names).

    On Error GoTo ErrorHandler

    value1 = Get_String(value1)

    value2 = Get_String(value2)   

    If value1 > value2 Then

        ITableSortCallBack_Compare = 1

    ElseIf value1 < value2 Then

        ITableSortCallBack_Compare = -1

    Else: value1 = value2

        ITableSortCallBack_Compare = 0

    End If

    Exit Function

ErrorHandler:

    MsgBox Err.Description

End Function

Private Function Get_String(ByVal sMyStr As Variant) As Variant

    ' This function gets the tail of the string

    '   after the first block of characters

    Dim sFindString     As String

    Dim nPosition       As Integer

    Dim nStringLen      As Integer

    On Error GoTo ErrorHandler

    nStringLen = Len(sMyStr)

    nPosition = 1

    Do Until nPosition = nStringLen

        sFindString = Mid(sMyStr, nPosition, 1)

        If sFindString = " " Then

            Exit Do

        End If

        nPosition = nPosition + 1

    Loop

    Get_String = Mid(sMyStr, nPosition + 1)

    Exit Function

ErrorHandler:

    MsgBox Err.Description

End Function

功能模块

Option Explicit

 

Private pMxDocument         As IMxDocument

Private pMap                As IMap

Private pApplication        As IApplication

Public Sub CustomSort()

    Dim pSelectedItem       As IUnknown

    Dim pStandaloneTable    As IStandaloneTable

    Dim pTable              As ITable

    Dim pTableSort          As ITableSort

    Dim pTableSortCallBack  As ITableSortCallBack

    Dim pCursor             As ICursor

    Dim pRow                As IRow

   

    On Error GoTo ErrorHandler

   

    Set pMxDocument = ThisDocument

    Set pMap = pMxDocument.FocusMap

    Set pApplication = Application

    Set pSelectedItem = pMxDocument.SelectedItem

   

    If pSelectedItem Is Nothing Then

        MsgBox "Nothing selectd.", vbExclamation

        Exit Sub

    ' If a table is selected

    ElseIf Not TypeOf pSelectedItem Is IStandaloneTable Then

        MsgBox "No table selectd.", vbExclamation

        Exit Sub

    Else

        Set pStandaloneTable = New esriCore.StandaloneTable

        Set pStandaloneTable = pSelectedItem

    End If

   

    Set pTable = pStandaloneTable.Table

   

    ' Create a new custom TableSortCallBack and TableSort object

    '   Class clsTailSort defined in Class Modules

    Set pTableSortCallBack = New clsTailSort

    Set pTableSort = New TableSort

   

    ' Set up the parameters for the sort and excute

    With pTableSort

        .Fields = "Address"

        .Ascending("Address") = True

        .CaseSensitive("Address") = True

        Set .Table = pTable

        Set .Compare = pTableSortCallBack

    End With

    pTableSort.Sort Nothing

   

    ' Create a new cursor object to hold the sorted rows

    Set pCursor = pTableSort.Rows

   

    ' Create a new sorted table

    Call CreateTable(pTable, pCursor)

   

    Set pTableSortCallBack = Nothing

    Set pTableSort = Nothing

   

    Exit Sub

ErrorHandler:

    MsgBox Err.Description

End Sub

 

Public Sub CreateTable(pTab As ITable, pCur As ICursor)

    ' Create a new .dbf file of the sorted data

    Dim pWorkspaceFactory       As IWorkspaceFactory

    Dim pFeatureWorkspace       As IFeatureWorkspace

    Dim pWorkspace              As IWorkspace

    Dim pDatasetWkSp            As IDataset

    Dim pWorkspaceName          As IWorkspaceName

    Dim pDatasetNameOut         As IDatasetName

    Dim pFields                 As IFields

    Dim pFields2                As esriCore.IFields

    Dim pDataset                As IDataset

    Dim pDatasetName            As IDatasetName

    Dim pDS                     As IDataset

    Dim pEnumDS                 As IEnumDataset

   

    Dim pStandaloneTable2       As IStandaloneTable

    Dim pTable2                 As ITable

    Dim pTableNew               As ITable

    Dim pCursor2                As ICursor

    Dim pRowBuffer              As IRowBuffer

    Dim pRow                    As IRow

    Dim pName                   As IName

    Dim pStandaloneTable        As IStandaloneTable

    Dim pStandaloneTableC       As IStandaloneTableCollection

   

    Dim j                       As Integer

    Dim i                       As Integer

   

    On Error GoTo ErrorHandler

   

    ' Get the dataset name for the input table

    Set pDataset = pTab

    Set pDatasetName = pDataset.FullName

   

    ' Set the output dataset name.

    ' New .dbf file will be created in c:\temp

    Set pFields = pTab.Fields

    Set pWorkspaceFactory = New ShapefileWorkspaceFactory

    Set pWorkspace = pWorkspaceFactory.OpenFromFile("c:\temp", 0)

    Set pFeatureWorkspace = pWorkspace

    Set pDatasetWkSp = pWorkspace

    Set pWorkspaceName = pDatasetWkSp.FullName

    Set pDatasetNameOut = New TableName

    pDatasetNameOut.Name = "NewSortTable"

    Set pDatasetNameOut.WorkspaceName = pWorkspaceName

   

    ' Check if .dbf file already exist: if yes, delete it

    Set pEnumDS = pWorkspace.Datasets(esriDTTable)

    Set pDS = pEnumDS.Next

    Do Until pDS Is Nothing

        If pDS.Name = pDatasetNameOut.Name Then

            pDS.Delete

            Exit Do

        End If

        Set pDS = pEnumDS.Next

    Loop

 

    ' Create a new .dbf table

    pFeatureWorkspace.CreateTable pDatasetNameOut.Name, pFields, Nothing, Nothing, ""

          

    ' Create a new stand alone table object to represent the .dbf table

    Set pStandaloneTable2 = New StandaloneTable

    Set pStandaloneTable2.Table = pFeatureWorkspace.OpenTable(pDatasetNameOut.Name)

    Set pTable2 = pStandaloneTable2.Table

    Set pFields2 = pTable2.Fields

   

    ' Open an insert cursor on the new table

    Set pCursor2 = pTable2.Insert(True)

   

    ' Create a row buffer for the row inserts

    Set pRowBuffer = pTable2.CreateRowBuffer

   

    ' Loop through the sorted cursor and write to new table

    For j = 0 To pTab.RowCount(Nothing) - 1

        Set pRow = pCur.NextRow

        If Not pRow Is Nothing Then

            i = 1

            Do Until i = pFields2.FieldCount

                If Not IsEmpty(pRow.Value(i)) Then

                    If pFields.Field(i).Editable Then

                        pRowBuffer.Value(i) = pRow.Value(i)

                    End If

                End If

                i = i + 1

            Loop

        pCursor2.InsertRow pRowBuffer

        End If

    Next j

   

    ' Add the new sorted table to map document

    Set pName = pDatasetNameOut

    Set pTableNew = pName.Open

    Set pStandaloneTable = New StandaloneTable

    Set pStandaloneTable.Table = pTableNew

    Set pStandaloneTableC = pMap

    pStandaloneTableC.AddStandaloneTable pStandaloneTable

 

    pMxDocument.UpdateContents   

 

    Exit Sub

ErrorHandler:

    MsgBox Err.Description

End Sub