الرئيسيةClass to sort MSFlexGrid
صفحة 1 من اصل 1 • شاطر
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
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
المساهمات : 249
النقاط : 464
التقيم : 25
الجنس :
| |
صفحة 1 من اصل 1
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى
» رش الدفان بالرياض
» شركة تنظيف خزانات الشارقة
» شركة مكافحة الفئران بالرياض
» افضل شركة كشف تسربات المياه بالباحة
» ساعدوني وفهموني help me
» كشف تسربات المياه في جدة
» خدمات كشف تسربات المياه بخصم 25% - اتصل الان
» كهربائي منازل بالرياض
» افضل شركة نقل عفش بالرياض نقل باكستاني 40% خصم | موقع الانوار