cshellsort.cls

来自「编辑数据库表格,可以显示图形及打印」· CLS 代码 · 共 530 行 · 第 1/2 页

        End If
    
    Case CCLSortIndentation
        lR = vSortItem.lIndent - vItem.lIndent
        bIsEqual = (lR = 0)
        If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
            pbIsGreater = (lR >= 0)
        Else
            pbIsGreater = (lR <= 0)
        End If
    
    Case CCLSortIcon
        lR = vSortItem.iIconIndex - vItem.iIconIndex
        bIsEqual = (lR = 0)
        If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
            pbIsGreater = (lR >= 0)
        Else
            pbIsGreater = (lR <= 0)
        End If
    
    Case CCLSortExtraIcon
        lR = vSortItem.lExtraIconIndex - vItem.lExtraIconIndex
        bIsEqual = (lR = 0)
        If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
            pbIsGreater = (lR >= 0)
        Else
            pbIsGreater = (lR <= 0)
        End If
    
    Case CCLSortForeColor
        lR = vSortItem.oForeColor - vItem.oForeColor
        bIsEqual = (vR = 0)
        If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
            pbIsGreater = (lR >= 0)
        Else
            pbIsGreater = (lR <= 0)
        End If
    
    Case CCLSortBackColor
        lR = vSortItem.oBackColor - vItem.oBackColor
        bIsEqual = (lR = 0)
        If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
            pbIsGreater = (lR >= 0)
        Else
            pbIsGreater = (lR <= 0)
        End If
    
    Case CCLSortNumeric
        vR = Val(vSortItem.sText - vItem.sText)
        bIsEqual = (vR = 0)
        If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
            pbIsGreater = (vR >= 0)
        Else
            pbIsGreater = (vR <= 0)
        End If
        
    Case CCLSortString
      If Not (IsMissing(vSortItem.sText)) Then
         sSortItemText = vSortItem.sText
      End If
      If Not (IsMissing(vItem.sText)) Then
         sItemText = vItem.sText
      End If
      lR = StrComp(sSortItemText, sItemText)
      bIsEqual = (lR = 0)
      If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
          pbIsGreater = (lR > -1)
      Else
          pbIsGreater = (lR < 1)
      End If
      
    Case CCLSortStringNoCase
      If Not (IsMissing(vSortItem.sText)) Then
         sSortItemText = vSortItem.sText
      End If
      If Not (IsMissing(vItem.sText)) Then
         sItemText = vItem.sText
      End If
      lR = StrComp(sSortItemText, sItemText, vbTextCompare)
      bIsEqual = (lR = 0)
      If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
          pbIsGreater = (lR > -1)
      Else
          pbIsGreater = (lR < 1)
      End If
    
    Case CCLSortDate
         If Not (IsMissing(vSortItem.sText)) Then
            sSortItemText = vSortItem.sText
         End If
         If Not (IsMissing(vItem.sText)) Then
            sItemText = vItem.sText
         End If
        bIsEqual = (vSortItem.sText = vItem.sText)
        If Not (bIsEqual) Then
            If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
                pbIsGreater = (vSortItem.sText >= vItem.sText)
            Else
                pbIsGreater = (vItem.sText >= vSortItem.sText)
            End If
        Else
            pbIsGreater = True
        End If
        
    Case CCLSortDateYearAccuracy
      If IsDate(vSortItem.sText) Then
         vSortDate = DateSerial(Year(vSortItem.sText), 1, 1)
         bSortDate = True
      End If
      If IsDate(vItem.sText) Then
         vDate = DateSerial(Year(vItem.sText), 1, 1)
         bDate = True
      End If
      If (bSortDate) And (bDate) Then
         bIsEqual = (vDate = vSortDate)
         If Not (bIsEqual) Then
            If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
                pbIsGreater = (vSortItem.sText >= vItem.sText)
            Else
                pbIsGreater = (vItem.sText >= vSortItem.sText)
            End If
         End If
      ElseIf bSortDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderAscending)
      ElseIf bDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderDescending)
      Else
         bIsEqual = True
      End If
        
    Case CCLSortDateMonthAccuracy
      If IsDate(vSortItem.sText) Then
         vSortDate = DateSerial(Year(vSortItem.sText), Month(vSortItem.sText), 1)
         bSortDate = True
      End If
      If IsDate(vItem.sText) Then
         vDate = DateSerial(Year(vItem.sText), Month(vItem.sText), 1)
         bDate = True
      End If
      If (bSortDate) And (bDate) Then
         bIsEqual = (vDate = vSortDate)
         If Not (bIsEqual) Then
            If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
                pbIsGreater = (vSortItem.sText >= vItem.sText)
            Else
                pbIsGreater = (vItem.sText >= vSortItem.sText)
            End If
         End If
      ElseIf bSortDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderAscending)
      ElseIf bDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderDescending)
      Else
         bIsEqual = True
      End If
        
    Case CCLSortDateDayAccuracy
      If IsDate(vSortItem.sText) Then
         vSortDate = DateSerial(Year(vSortItem.sText), Month(vSortItem.sText), Day(vSortItem.sText))
         bSortDate = True
      End If
      If IsDate(vItem.sText) Then
         vDate = DateSerial(Year(vItem.sText), Month(vItem.sText), Day(vItem.sText))
         bDate = True
      End If
      If (bSortDate) And (bDate) Then
         bIsEqual = (vDate = vSortDate)
         If Not (bIsEqual) Then
            If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
                pbIsGreater = (vSortItem.sText >= vItem.sText)
            Else
                pbIsGreater = (vItem.sText >= vSortItem.sText)
            End If
         End If
      ElseIf bSortDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderAscending)
      ElseIf bDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderDescending)
      Else
         bIsEqual = True
      End If
    
    Case CCLSortDateHourAccuracy
      If IsDate(vSortItem.sText) Then
         vSortDate = DateSerial(Year(vSortItem.sText), Month(vSortItem.sText), Day(vSortItem.sText)) + TimeSerial(Hour(vSortItem.sText), 0, 0)
         bSortDate = True
      End If
      If IsDate(vItem.sText) Then
         vDate = DateSerial(Year(vItem.sText), Month(vItem.sText), Day(vItem.sText)) + TimeSerial(Hour(vItem.sText), 0, 0)
         bDate = True
      End If
      If (bSortDate) And (bDate) Then
         bIsEqual = (vDate = vSortDate)
         If Not (bIsEqual) Then
            If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
                pbIsGreater = (vSortItem.sText >= vItem.sText)
            Else
                pbIsGreater = (vItem.sText >= vSortItem.sText)
            End If
         End If
      ElseIf bSortDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderAscending)
      ElseIf bDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderDescending)
      Else
         bIsEqual = True
      End If
    
    Case CCLSortDateMinuteAccuracy
      If IsDate(vSortItem.sText) Then
         vSortDate = DateSerial(Year(vSortItem.sText), Month(vSortItem.sText), Day(vSortItem.sText)) + TimeSerial(Hour(vSortItem.sText), Minute(vSortItem.sText), 0)
         bSortDate = True
      End If
      If IsDate(vItem.sText) Then
         vDate = DateSerial(Year(vItem.sText), Month(vItem.sText), Day(vItem.sText)) + TimeSerial(Hour(vItem.sText), Minute(vItem.sText), 0)
         bDate = True
      End If
      If (bSortDate) And (bDate) Then
         bIsEqual = (vDate = vSortDate)
         If Not (bIsEqual) Then
            If (m_eSortOrder(iSortIndex) = CCLOrderAscending) Then
                pbIsGreater = (vSortItem.sText >= vItem.sText)
            Else
                pbIsGreater = (vItem.sText >= vSortItem.sText)
            End If
         End If
      ElseIf bSortDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderAscending)
      ElseIf bDate Then
         pbIsGreater = (m_eSortOrder(iSortIndex) = CCLOrderDescending)
      Else
         bIsEqual = True
      End If
       
    End Select
    
End Function
Private Function piGetSuitableShellSortInitialIncrement( _
        iSortSize As Long _
    ) As Long
' ==============================================================
' Part of the implementation of Shell Sort algorithm using
' + 1 * 3 increment strategy.  This function returns the
' largest increment based on +1*3 which is less than the
' sort size.
' ==============================================================
Dim iRet As Long
Dim iLastRet As Long
    iLastRet = 1
    iRet = 1
    Do While iRet < iSortSize
        iLastRet = iRet
        iRet = iRet * 3 + 1
    Loop
    piGetSuitableShellSortInitialIncrement = iLastRet
End Function

Private Sub Class_Initialize()
   debugmsg "cShellSortTGridCells:Initialize"
End Sub

Private Sub Class_Terminate()
   debugmsg "cShellSortTGridCells:Terminate"
End Sub