Solved

declaration dilemma

Posted on 2001-06-11
8
461 Views
Last Modified: 2007-12-19
hallo experts !

I get following dilemma:

1. i can't use adressof in my usercontrol if i declare CompareUserDefined in my usercontrol
2. if i declare CompareUserDefined in the module i can't call CompareItemsCall which is declared in my user control


UserControl:

Public Event CompareItems(ColIndex As Integer, ItemText1 As String, ItemText2 As String, SortOrder As MSComctlLib.ListSortOrderConstants, Result As enmCompareResult)

Public Function CompareItemsCall(ItemText1 As String, ItemText2 As String) As enmCompareResult
    Dim cmpResult As enmCompareResult
    RaiseEvent CompareItems(sCol, ItemText1, ItemText2, sOrder, cmpResult)
    CompareItemsCall = cmpResult
End Function

Private Sub lstBox_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    ...
    SendMessage lstBox.hwnd, LVM_SORTITEMS, lstBox.hwnd, ByVal FARPROC(AddressOf CompareUserDefined)
    ...
End Sub

Module:

Public Function CompareUserDefined(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
  CompareUserDefined = CompareItemsCall(ListView_GetItemText(hwnd, lParam1), ListView_GetItemText(hwnd, lParam2))
End Function

Public Function ListView_GetItemText(hwnd As Long, lParam As Long) As String

    Dim hIndex As Long
    Dim r As Long
 
    FoundObject.FLAGS = LVFI_PARAM
    FoundObject.lParam = lParam
    hIndex = SendMessage(hwnd, LVM_FINDITEM, -1, FoundObject)
       
    FoundItem.mask = LVIF_TEXT
    FoundItem.iSubItem = sCol
    FoundItem.pszText = Space$(32)
    FoundItem.cchTextMax = Len(FoundItem.pszText)
     
 
    r = SendMessage(hwnd, LVM_GETITEMTEXT, hIndex, FoundItem)
   
    If r > 0 Then
        ListView_GetItemText = Mid(FoundItem.pszText, 1, r)
    Else
        ListView_GetItemText = ""
    End If

End Function

please help !
0
Comment
Question by:VK
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
8 Comments
 
LVL 2

Expert Comment

by:agriggs
ID: 6177520
It looks like you are trying to create a user control which is a listview that has columns that are automatically sorted when the column header is clicked.  

The problems you are having are known issues with using API callbacks in any object-oriented language.  You can only use the AddressOf operator if the function you want to call is declared in a standard module.  And you cannot call an object member function from within a standard module unless you first have a reference to that particular object, because there could be many of them instantiated.

Now, my question, why are you not using the Sorted, Sortkey, and SortOrder properties of the listview to sort it?  One caveat of using these properties is have some method to turn them off while the control is being loaded with values, otherwise, it gets resorted every time an item is added, causing the amount of time to increase exponentially.  If you turn the sorted property off while it is being loaded, then turn it back on when you are through, it will only get sorted once.

I hope I have been of assistance to you.
0
 
LVL 6

Author Comment

by:VK
ID: 6177662
hello agriggs !

Thank you for answering. I thought nobody would try it.

I want to sort columns of a listview:

1. Alphanumeric: here i alread use Sorted, Sortkey, and SortOrder
2. by Date (with AdressOf,SendMessage)
3. numeric (with AdressOf,SendMessage)
4. user defined: here i want that the user of my control (a developer) has the ability of pasting his own copmparing method to sort that column in the event CompareItems.
0
 
LVL 6

Author Comment

by:VK
ID: 6177684
hello agriggs !

Thank you for answering. I thought nobody would try it.

I want to sort columns of a listview:

1. Alphanumeric: here i alread use Sorted, Sortkey, and SortOrder
2. by Date (with AdressOf,SendMessage)
3. numeric (with AdressOf,SendMessage)
4. user defined: here i want that the user of my control (a developer) has the ability of pasting his own copmparing method to sort that column in the event CompareItems.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 2

Accepted Solution

by:
agriggs earned 200 total points
ID: 6177820
Right, I see why you are doing it now.  I just wanted to make sure that you weren't reinventing the wheel.

I would suggest having a collection of instances of your usercontrol declared in your standard module along with your CompareUserDefined function.

Use the hwnd of the listview as the key to the collection.  Then, whenever you are about to sort the listview based upon the callback function call a method in the standard module to add a reference to the user control to the collection, keyed by hwnd.

Then, whenever the callback function is called, retrieve the reference to the correct user control from the collection, again using the hwnd of the control, and call the CompareItemsCall function using the reference to the object that you just got.
0
 
LVL 6

Author Comment

by:VK
ID: 6177980
I will test it tomorrow, if it works you get the points.
Ty very much !
0
 
LVL 6

Author Comment

by:VK
ID: 6180926
Hello agriggs ! You will get the points, but i got another problem doing what you suggested:

UserControl:

Public Type typColumns
    Index As Long
    SortState As enmColSortState
End Type
Public Type typMyControl
    Combo As MyControl
    Columns As Collection
    SortCol As Long
End Type

Private Sub UserControl_Initialize()
    Dim tmpMyControl As typMyControl
    Set tmpMyControl.Combo = Me
    Set tmpMyControl.Columns = New Collection
    tmpMyControl.SortCol = 1
    Call MyControls.Add(tmpMyControl, "lvw" & lstBox.hwnd)
End Sub

Private Sub lstBox_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    Dim SortType As enmColSortType
    SortType = lvwString
    MyControls("lvw" & CStr(lstBox.hwnd)).SortCol = ColumnHeader.Index
    ***************************************************************************************************************
    !!! the above Statement is not executed, no error occurs and MyControls("lvw" & CStr(lstBox.hwnd)).SortCol remains with the old value
    ***************************************************************************************************************
   
    If lstBox.ColumnHeaders.Count <> MyControls("lvw" & lstBox.hwnd).Columns.Count Then
        Dim clmn As typColumns
        Dim clmh As MSComctlLib.ColumnHeader
        For Each clmh In lstBox.ColumnHeaders
            clmn.Index = clmh.Index
            clmn.SortState = IIf(clmh.Index = ColumnHeader.Index, lvwAscending, lvwNotSorted)
            Call MyControls("lvw" & lstBox.hwnd).Columns.Add(clmn)
        Next
    Else
        Select Case MyControls("lvw" & lstBox.hwnd).Columns(ColumnHeader.Index).SortState
            Case lvwNotSorted '= 0
                MyControls("lvw" & lstBox.hwnd).Columns(ColumnHeader.Index).SortState = lvwAscending
            Case lvwAscending '= 1
                MyControls("lvw" & lstBox.hwnd).Columns(ColumnHeader.Index).SortState = lvwDescending
            Case lvwDescending '= -1
                MyControls("lvw" & lstBox.hwnd).Columns(ColumnHeader.Index).SortState = lvwAscending
        End Select
    End If
    RaiseEvent ColumnClick(ColumnHeader, SortType)
    Select Case SortType
        Case lvwNoSort
        Case lvwString
            lstBox.SortKey = ColumnHeader.Index - 1
            lstBox.SortOrder = Choose(MyControls("lvw" & lstBox.hwnd).Columns(ColumnHeader.Index).SortState + 2, lvwDescending, lvwNotSorted, lvwAscending)
            lstBox.Sorted = True
        Case lvwDate
               lstBox.Sorted = False
               SendMessage lstBox.hwnd, LVM_SORTITEMS, lstBox.hwnd, ByVal FARPROC(AddressOf CompareDates)
        Case lvwNumber
               lstBox.Sorted = False
               SendMessage lstBox.hwnd, LVM_SORTITEMS, lstBox.hwnd, ByVal FARPROC(AddressOf CompareValues)
        Case lvwUserDefined
               lstBox.Sorted = False
               SendMessage lstBox.hwnd, LVM_SORTITEMS, lstBox.hwnd, ByVal FARPROC(AddressOf CompareUserDefined)
    End Select
End Sub

Public Function CompareItemsCall(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As enmCompareResult
    Dim cmpResult As enmCompareResult
    RaiseEvent CompareItems(MyControls("lvw" & hwnd).SortCol, ListView_GetItemText(hwnd, lParam1), ListView_GetItemText(hwnd, lParam2), MyControls("lvw" & hwnd).Columns(MyControls("lvw" & hwnd).SortCol).SortState, cmpResult)
    CompareItemsCall = Choose(cmpResult + 2, lvwDescending, lvwNoSort, lvwAscending)
End Function

Module:

Public MyControls As New Collection

Public Function FARPROC(ByVal pfn As Long) As Long
  FARPROC = pfn
End Function

Public Function CompareUserDefined(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
  CompareUserDefined = MyControls("lvw" & hwnd).Combo.CompareItemsCall(ListView_GetItemText(hwnd, lParam1), ListView_GetItemText(hwnd, lParam2), hwnd)
End Function

Public Function ListView_GetItemText(hwnd As Long, lParam As Long) As String
    Dim hIndex As Long
    Dim r As Long
   
    objFind.FLAGS = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessage(hwnd, LVM_FINDITEM, -1, objFind)
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = MyControls("lvw" & hwnd).SortCol - 1
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)
    r = SendMessage(hwnd, LVM_GETITEMTEXT, hIndex, objItem)
    If r > 0 Then
        ListView_GetItemText = Mid(objItem.pszText, 1, r)
    Else
        ListView_GetItemText = ""
    End If
End Function

ClientForm:

Private Sub MyControl1_CompareItems(ColIndex As Integer, ItemText1 As String, ItemText2 As String, SortOrder As vbpMyControl.enmColSortState, Result As vbpMyControl.enmCompareResult)
    Select Case ColIndex
        Case 0
            If SortOrder = lvwAscending Then
                If Val(ItemText1) > Val(ItemText2) Then
                    Result = lvwGreater
                Else
                    Result = lvwLess
                End If
            Else
                If Val(ItemText1) < Val(ItemText2) Then
                    Result = lvwGreater
                Else
                    Result = lvwLess
                End If
            End If
    End Select
End Sub

Private Sub MyControl1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader, SortType As vbpMyControl.enmColSortType)
    Select Case ColumnHeader.Index
        Case 1
            SortType = lvwUserDefined
        Case 2
            SortType = lvwDate
        Case 3
            SortType = lvwString
        Case 4
            SortType = lvwNumber
    End Select
End Sub
0
 
LVL 6

Author Comment

by:VK
ID: 6180947
I will increase the Points to 300 if you can help me.
0
 
LVL 2

Expert Comment

by:agriggs
ID: 6182064
I don't think I can help you as yet.  However, one thing that may help is in your UserControl code, I don't think you have to retrieve the reference to the proper control out of the public collection, because your UserControl code *is* the correct reference.  You only need to retrieve the reference from the collection in the module, because the module code is not associated with an instance of the control.

I was also questioning why you do all those SendMessage commands.  It looks like you are doing that to retrieve the subitem text.  You can also get this text using the lstView.ListItems(Index).SubItems(Index) property.

Hopefully we can clear this problem up.
0

Featured Post

Want Experts Exchange at your fingertips?

With Experts Exchange’s latest app release, you can now experience our most recent features, updates, and the same community interface while on-the-go. Download our latest app release at the Android or Apple stores today!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month3 days, 13 hours left to enroll

630 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question