Class to sort MSFlexGrid

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

Class to sort MSFlexGrid

مُساهمة من طرف MATRIX في الخميس نوفمبر 15, 2012 11:17 pm

Hi everybody


Here is an object-0oiented class to sort MSFlexGrid. At design, time select which columns can be sorted, the default sort order, and optionally a second sort order. User double clicks on fixed column headers and the column is sorted. Double click again and the column is sorted by the second sort order. Native sort doesn't handle dates, but this does using a hidden column
الرمز:
Option Explicit

'  Sort MSFlexGrid by double clicking on fixed column header.
'Controller of and Collection of cFlexGridSortColumn
'  Some of the native sorts are bogus, e.g., Date. 
'Workaround is to create an additional column for any
'column that can't be sorted natively. Populate the
'hidden column by converting the unsortable type into
'something that can be sorted.  For example, convert
'date to Format( date, "YYYYMMDD")
'  No idea if it works on grids that do not have a fixed
'zero row.
'  Written 7/8/03 for VB6
'
' ========== BEGIN sample calling code ===========
'Private m_oColSortColumn As cColFlexGridSortColumn
'
'Private Sub Form_Unload(Cancel As Integer)
'    Set m_oColSortColumn = Nothing
'End Sub
'
'Private Sub Form_Load()
'
'    '' sort setup
'    Set m_oColSortColumn = New cColFlexGridSortColumn
'    With m_oColSortColumn
'        Set .Grid = Me.MSFlexGrid1
'
'        ' no need to add zero column if it is fixed, as class won't sort on it.
'        '.Add 0, False
'        .Add 1, True, flexSortNumericAscending, flexSortNumericDescending
'        .Add 2, False
'        .Add 3, True, flexSortGenericAscending, flexSortGenericDescending, 4
'    End With
'    '' end sort setup
'
'    With MSFlexGrid1
'        ' Sample grid population
'        .Cols = 5
'        .Rows = 10
'        .FixedCols = 1
'        .FixedRows = 1
'        ' last col is hidden for date sort
'        .ColWidth(4) = 0
'
'        .Row = 0
'        .TextMatrix(0, 1) = "Col1"
'        .TextMatrix(0, 2) = "Col2"
'        .TextMatrix(0, 3) = "Col3"
'
'        Dim ii As Long
'        For ii = 1 To 9
'          .TextMatrix(ii, 0) = ii
'    .TextMatrix(ii, 1) = CStr(CInt(Rnd * 10000))
'    .TextMatrix(ii, 2) = Chr(CInt(Asc(Rnd * 122) + 65))
'    .TextMatrix(ii, 3) = DateAdd("d", CInt(Rnd * 100), Date)
'    .TextMatrix(ii, 4) = Format(.TextMatrix(ii, 3), "YYYYMMDD")
'        Next
'        '' end sample grid population
'
'    End With
'
'End Sub
'
'Private Sub MSFlexGrid1_DblClick()
'    m_oColSortColumn.Sort
'End Sub
'
'Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'    m_oColSortColumn.MouseDown x, y
'End Sub
' =========  END sample calling code ============



' ============= begin cColFlexGridSortColumn.cls ============
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cColFlexGridSortColumn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private m_oGrid As MSFlexGrid
Private m_colItems As Collection
Private m_sKey As String
Private m_IsOnFixedPart As Boolean
Private m_IsZeroRow As Boolean
Private m_IsZeroCol As Boolean
 
Private Sub Class_Initialize()
    Set m_colItems = New Collection
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    Set m_colItems = Nothing
    Set m_oGrid = Nothing
    On Error GoTo 0
End Sub

Public Property Get Count() As Long
    Count = m_colItems.Count
End Property

Public Sub Add(ByVal p_lSortCol As Long _
        , ByVal p_bIsSortable As Boolean _
        , Optional ByVal p_lDefaultSort As SortSettings = flexSortNone _
        , Optional ByVal p_vAlternateSort As Variant = Null _
        , Optional ByVal p_vHiddenSortColumn As Variant = Null _
        , Optional ByVal p_vBefore As Variant _
        , Optional ByVal p_vAfter As Variant _
        )
       
    ' Use Sort Column as Key
     
    On Error GoTo Oops
   
    Dim oItem As cFlexGridSortColumn: Set oItem = New cFlexGridSortColumn
    With oItem
        .SortColumn = p_lSortCol
        .IsSortable = p_bIsSortable
        .DefaultSortOrder = p_lDefaultSort
        If IsNull(p_vAlternateSort) Then
            .AlternateSortOrder = p_lDefaultSort
        Else
            .AlternateSortOrder = CLng(p_vAlternateSort)
        End If
        .HiddenSortColumn = p_vHiddenSortColumn
    End With
   
    Dim IsPosition As Boolean: IsPosition = True
    If IsEmpty(p_vBefore) And IsEmpty(p_vAfter) Then
        IsPosition = False
    End If
   
    If IsPosition Then
        If IsEmpty(p_vBefore) Then
            m_colItems.Add oItem, CStr(p_lSortCol), p_vBefore
        Else
            m_colItems.Add oItem, CStr(p_lSortCol), , p_vAfter
        End If
    Else
        m_colItems.Add oItem, CStr(p_lSortCol)
    End If
     
    Exit Sub

Oops:
    Err.Raise Err.Number, _
            Err.Source & ">" & TypeName(Me) & "::Add()", _
            Err.Description & IIf(Right(Err.Description, 1) = ".", "", ".") & "  " _
            & "In " & TypeName(Me) & "::Add()" _
            & IIf(Erl = 0, "", ", at or after Line " & CStr(Erl) & ".")

End Sub


Public Function HasItem(p_vKey As Variant) As Boolean
    ' Return TRUE if item with specified key exists in collection
       
    Dim o As Variant
    On Error Resume Next
    Set o = Item(p_vKey)
    If Err.Number = 13 Then '' type mismatch
        Err.Clear
        o = Item(p_vKey)
    End If
    On Error GoTo 0
       
   
    Dim bReturn As Boolean
    Dim b As Boolean
    On Error Resume Next
    b = (o Is Nothing)
    If Err.Number = 0 Then
        ' Item is a valid object
        bReturn = True
    Else
        ' not an object, so check if there was an assigned value
        bReturn = IIf(IsEmpty(o), False, True)
    End If
    On Error GoTo 0

    HasItem = bReturn
End Function

Public Function Item(p_vKey As Variant) As Variant
    '    If you want to handle error for missing item entirely in calling
    ' object, first call .HasItem, then call this only if item is present.
    ' Handles both native data types and objects.  Don't know if assigning
    ' a variable or an object variable (which requires a SET), so trap for type
    ' mismatch error.
   
    On Error GoTo CheckForTypeMismatch
   
    ' Handle objects
    If VarType(p_vKey) = vbString Then
        Set Item = m_colItems.Item(CStr(p_vKey))
    Else
        Set Item = m_colItems(p_vKey)
    End If
   
    Exit Function
   
CheckForTypeMismatch:
    If Err.Number = 13 Then
        On Error GoTo Oops
        'Handle native
        If VarType(p_vKey) = vbString Then
            Item = m_colItems.Item(CStr(p_vKey))
        Else
            Item = m_colItems(p_vKey)
    End If
   
    Exit Function

    End If

Oops:
    Err.Raise Err.Number, _
            Err.Source & ">" & TypeName(Me) & "::Item()", _
            Err.Description & IIf(Right(Err.Description, 1) = ".", "", ".") & "  " _
            & "In " & TypeName(Me) & "::Item()" _
            & IIf(Erl = 0, "", ", at or after Line " & CStr(Erl) & ".")
           
End Function

Public Sub Remove(p_vKey As Variant)
    ' No error raised if item is not there.  If you want to know if item is there before
    ' attempting to delete it, call .HasItem first.
   
    On Error Resume Next
    m_colItems.Remove p_vKey
    On Error GoTo 0

End Sub

Public Property Get Items() As Collection
    Set Items = m_colItems
End Property

Public Sub Clear()
    Set m_colItems = New Collection
End Sub

Public Sub Replace(ByVal p_vItem As Variant _
            , Optional ByVal p_vKey As Variant)
    ' If item with Key exists, Remove it then add new item
    Me.Remove p_vKey
    Me.Add p_vItem, p_vKey
End Sub


Public Sub MouseDown(ByVal p_x As Single _
            , ByVal p_y As Single)

    With m_oGrid
        m_IsZeroRow = (.RowHeight(0) >= p_y)
       
        m_IsZeroCol = (p_x < .ColWidth(0))
    End With
   
End Sub

Public Sub Sort()
   
    With m_oGrid
        If m_IsZeroRow And Not m_IsZeroCol Then
            If Me.HasItem(m_oGrid.Col) Then
                Dim oSortCol As cFlexGridSortColumn
                Set oSortCol = Me.Item(m_oGrid.Col)
               
                If oSortCol.IsSortable Then
                    Dim lOldCol As Long: lOldCol = .Col
                   
                    .Col = oSortCol.SortColumn
                    .Sort = oSortCol.SortOrder
                    .Col = lOldCol
                Else
                    MsgBox "Column is not sortable", vbInformation
                End If
               
                Set oSortCol = Nothing
            End If  '' If Me.HasItem(m_oGrid.Col) Then
        End If '' If m_IsZeroCol And Not m_IsZeroRow Then
    End With

End Sub

Public Property Set Grid(RHS As MSFlexGrid)
    Set m_oGrid = RHS
End Property

' ============= END cColFlexGridSortColumn.cls ============



' ============= Begin cFlexGridSortColumn.cls ============

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cFlexGridSortColumn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_bIsSortable As Boolean
Private m_vHiddenCol As Variant
Private m_lCol As Long
Private m_lDefaultSort As SortSettings
Private m_lAltSort As SortSettings
Private m_lCurrentSort As SortSettings

Public Property Get IsSortable() As Boolean
    IsSortable = m_bIsSortable
End Property

Public Property Let IsSortable(ByVal RHS As Boolean)
    m_bIsSortable = RHS
End Property

Public Property Let HiddenSortColumn(ByVal RHS As Variant)
    m_vHiddenCol = RHS
End Property

Public Property Get SortColumn() As Long
    If IsNull(m_vHiddenCol) Then
        SortColumn = m_lCol
    Else
        SortColumn = CLng(m_vHiddenCol)
    End If
End Property

Public Property Let SortColumn(ByVal RHS As Long)
    m_lCol = RHS
End Property

Public Property Let DefaultSortOrder(ByVal RHS As SortSettings)
    m_lDefaultSort = RHS
End Property

Public Property Let AlternateSortOrder(ByVal RHS As SortSettings)
    m_lAltSort = RHS
End Property

Public Property Get SortOrder() As SortSettings
   
    Dim lReturn As SortSettings

    If Not m_bIsSortable Then
        lReturn = flexSortNone
    Else
        If m_lCurrentSort = flexSortNone Then
            lReturn = m_lDefaultSort
            m_lCurrentSort = m_lDefaultSort
        Else
            If m_lCurrentSort = m_lDefaultSort Then
                lReturn = m_lAltSort
                m_lCurrentSort = m_lAltSort
            Else
                lReturn = m_lDefaultSort
                m_lCurrentSort = m_lDefaultSort
            End If
        End If ''If m_lCurrentSort = flexSortNone Then
    End If  '' If Not m_bIsSortable Then
   
    SortOrder = lReturn

End Property



' ============= END cFlexGridSortColumn.cls ============



MATRIX
.
.

تاريخ التسجيل : 15/11/2012
المساهمات : 6
النقاط : 15
التقيم : 3
الدولة : مصر
الجنس : ذكر

الرجوع الى أعلى الصفحة اذهب الى الأسفل

رد: Class to sort MSFlexGrid

مُساهمة من طرف السنى في السبت نوفمبر 17, 2012 7:14 am

انا مش فاهم أى حاجة خالص .......هو فية اية ؟

السنى
.......
.......

تاريخ التسجيل : 18/02/2011
المساهمات : 186
النقاط : 346
التقيم : 18
الجنس : ذكر

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى