Solved

Need help with LVM_GETSUBITEMRECT

Posted on 2000-03-17
13
827 Views
Last Modified: 2008-02-26
Subclassing is new to me, so I need some help on how to use LVM_GETSUBITEMRECT to retrieve the rect of the subitem I click.
0
Comment
Question by:Olli083097
  • 6
  • 5
  • 2
13 Comments
 

Author Comment

by:Olli083097
ID: 2627524
Adjusted points from 50 to 200
0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2628585
0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2628708
0
 
LVL 27

Expert Comment

by:Ark
ID: 2630282
Hi
You need subclassing to INTERCEPT Windows messages, not to send them. In your case, you can use SendMessage API:
Private Type RECTL
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LVM_FIRST = &H1000
Private Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)
Private Const LVIR_BOUNDS = 0
Private Const LVIR_ICON = 1
Private Const LVIR_LABEL = 2
Private Const LVIR_SELECTBOUNDS = 3

Private Sub Command1_Click()
   Dim rct As Rect
   rct.Left = LVIR_BOUNDS
   SendMessage MyLV.hWnd, LVM_GETSUBITEMRECT, 3&, rct
End Sub
'In this sample you get rect of 4th item (items counts from 0, so 3rd item meens 4th). Before calling you specify, wich rect do you need - bounds, icon etc by setting rct.Left to appropriate constant.
If you need subclassing sample, take a look at this:
'---- bas module code --
  Option Explicit
  Public Const NM_CUSTOMDRAW = (-12&)
  Public Const WM_NOTIFY As Long = &H4E&
  Public Const CDDS_PREPAINT As Long = &H1&
  Public Const CDRF_NOTIFYITEMDRAW As Long = &H20&
  Public Const CDDS_ITEM As Long = &H10000
  Public Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
  Public Const CDRF_NEWFONT As Long = &H2&
 
  Public Type NMHDR
    hWndFrom As Long   ' Window handle of control sending message
    idFrom As Long        ' Identifier of control sending message
    code  As Long          ' Specifies the notification code
  End Type
  ' sub struct of the NMCUSTOMDRAW struct
  Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type
 
  ' generic customdraw struct
  Public Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDC As Long
    rc As RECT
    dwItemSpec As Long
    uItemState As Long
    lItemlParam As Long
  End Type
 
  ' listview specific customdraw struct
  Public Type NMLVCUSTOMDRAW
    nmcd As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    ' if IE >= 4.0 this member of the struct can be used
    'iSubItem As Integer
  End Type

  Public g_addProcOld As Long
  Public g_MaxItems As Long
   
  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
  Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
' This function receive windows messages to form, check them and do something if appropriate mesage come.
'In this sample we wait for WM_NOTIFY message wich notify that subitem in ListView will be paint.
'We intercept this message and paint this item ourself (in this sample - red on yellow)  
Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case iMsg
    Case WM_NOTIFY
      Dim udtNMHDR As NMHDR
      CopyMemory udtNMHDR, ByVal lParam, 12&
      With udtNMHDR
        If .code = NM_CUSTOMDRAW Then
          Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
          CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW)
          With udtNMLVCUSTOMDRAW.nmcd
            Select Case .dwDrawStage
              Case CDDS_PREPAINT
                WindowProc = CDRF_NOTIFYITEMDRAW
                Exit Function
              Case CDDS_ITEMPREPAINT
                  If .dwItemSpec = g_MaxItems Then
                    udtNMLVCUSTOMDRAW.clrText = vbRed
                    udtNMLVCUSTOMDRAW.clrTextBk = vbYellow
                    CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
                  End If
                  WindowProc = CDRF_NEWFONT
                  Exit Function
            End Select
          End With
        End If
      End With
  End Select
'In all other cases we pass messages to form
  WindowProc = CallWindowProc(g_addProcOld, hwnd, iMsg, wParam, lParam)
End Function

'------ Form code----
'Place ListView control (lvCustomDraw) with view property = lvwReport (3)
Option Explicit
Private Const GWL_WNDPROC As Long = (-4&)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Sub Form_Load()
  lvCustomDraw.FullRowSelect = True
  With lvCustomDraw
    .ColumnHeaders.Add , , "Item Column"
    .ColumnHeaders.Add , , "Subitem 1"
    .ColumnHeaders.Add , , "Subitem 2"
    Dim i&
    For i = 1 To 30
      With .ListItems.Add(, , "Item " & CStr(i))
        .SubItems(1) = "Subitem 1"
        .SubItems(2) = "Subitem 2"
      End With
    Next
  End With
  g_MaxItems = lvCustomDraw.ListItems.Count - 1
'Subclass form to intercept messages
  g_addProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
' Unsubclass form
  Call SetWindowLong(hwnd, GWL_WNDPROC, g_addProcOld)
End Sub

Cheers
0
 

Author Comment

by:Olli083097
ID: 2635116
Ark: I know that "You need subclassing to INTERCEPT Windows messages..." But I'm using subclassing to intercept the item and subitem, that the user clicks. And I need to use the item-value and the subitem-value in the SendMessage API. But I have a problem with this, because it crashes! This is my proc:

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case iMsg
    Case WM_NOTIFY
        Dim udtNMHDR As NMHDR

        CopyMemory udtNMHDR, ByVal lParam, 12&

        With udtNMHDR
            If .code = NM_CLICK Then
                Dim udtNMLISTVIEW As NMLISTVIEW

                CopyMemory udtNMLISTVIEW, ByVal lParam, Len(udtNMLISTVIEW)

                With udtNMLISTVIEW
                    Dim rct As RECT

                    rct.Top = .iSubItem
                    rct.Left = LVIR_BOUNDS

'                    SendMessageLong ListView1.hwnd, LVM_GETSUBITEMRECT, .iItem, rct
'                    SendMessage ListView1.hwnd, LVM_GETSUBITEMRECT, 3&, rct

                    Text1.Top = rct.Top * Screen.TwipsPerPixelY
                    Text1.Left = ListView1.ColumnHeaders(1).Width
                    Text1.Height = (rct.Bottom - rct.Top) * Screen.TwipsPerPixelY
                    Text1.Width = ListView1.ColumnHeaders(2).Width
                    Text1 = 3

                End With
            End If
        End With
    End Select
End Function


I have tried with both SendMessageLong and SendMessage, both hangs the system.

What am I doing wrong?
0
 
LVL 27

Expert Comment

by:Ark
ID: 2635144
Hi
Your subclassing function MUST be at bas module. So, your bas module don't know, what is ListView1 and Text1. In your message you use UDT (Rect) so you need sendmessage function (not sendmessagelong. Try
SendMessage hwnd, LVM_GETSUBITEMRECT, 3&, rct. BTW, what do you want to do with ListView?
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:Olli083097
ID: 2635166
I have a problem with placeing it in a module, because I use SSumTmr.dll (are you familiar with this?).

I want to place a textbox over the subitem I click on...Do you have an example?
0
 
LVL 27

Expert Comment

by:Ark
ID: 2635238
Hi
Again - you need no subclassing for this. Subclassing is powerfull, but very dangerous thing, so if you can do smth without subclassing - do it.
here is your code

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LVM_FIRST = &H1000
Private Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)
Private Const LVIR_BOUNDS = 0
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub Form_Load()
   With ListView1
    .FullRowSelect = True
    .ColumnHeaders.Add , , "Item Column"
    .ColumnHeaders.Add , , "Subitem 1"
    .ColumnHeaders.Add , , "Subitem 2"
    Dim i&
    For i = 1 To 30
      With .ListItems.Add(, , "Item " & CStr(i))
        .SubItems(1) = "Subitem 1"
        .SubItems(2) = "Subitem 2"
      End With
    Next
  End With
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
   Dim rct As RECT
   rct.Left = LVIR_BOUNDS
   SendMessage ListView1.hwnd, LVM_GETSUBITEMRECT, 3&, rct
   rct.Left = LVIR_BOUNDS
   SendMessage ListView1.hwnd, LVM_GETSUBITEMRECT, 3&, rct
   Text1.Top = rct.Top * Screen.TwipsPerPixelY
   Text1.Left = ListView1.ColumnHeaders(1).Width
   Text1.Height = (rct.Bottom - rct.Top) * Screen.TwipsPerPixelY
   Text1.Width = ListView1.ColumnHeaders(2).Width
   Text1 = 3
End Sub
Cheers
0
 
LVL 27

Expert Comment

by:Ark
ID: 2635251
Hi
And without API:
Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
   Text1.Top = Item.Top + ListView1.Top
   Text1.Left = Item.Left + ListView1.Left
   Text1.Height = Item.Height
   Text1.Width = Item.Width
   Text1 = 3
End Sub
0
 

Author Comment

by:Olli083097
ID: 2635302
I'm sorry; I don't think I have made my actual problem entirely clear to you. I want to place and resize a textbox over the SUBITEM not the entire item that I click on. Therefore I have to retrieve the subitem that the user clicks. And as far as I know I have to use sublassing to retrieve the SUBITEM that is clicked...

Example: (you might have to paste this into your notepad to get the picture...)

+---------+---------+---------+
| Header1 | Header2 | Header3 |
+---------+---------+---------+
| Item1   | SubItem1| SubItem2|
+---------+---------+---------+
| Item2   | SubItem1| SubItem2|
+---------+---------+---------+
| Item3   | SubItem1| SubItem2|
+---------+---------+---------+


+=================+
| TextBox1        |
+=================+

If I click the Subitem1 on the Item2 row. Then I want the TextBox1 to be placed over the SubItem1 on the Item2 row. Like this:

+---------+---------+---------+
| Header1 | Header2 | Header3 |
+---------+---------+---------+
| Item1   | SubItem1| SubItem2|
+---------+=========+---------+
| Item2   | TextBox1| SubItem2|
+---------+=========+---------+
| Item3   | SubItem1| SubItem2|
+---------+---------+---------+

Do you get the idea?

If you can help me with this, then you really deserves a grade A... <smile>
0
 
LVL 27

Accepted Solution

by:
Ark earned 200 total points
ID: 2635337
Hi
You need this?:
Dim curSubItem As Integer
Private Sub Form_Load()
   With ListView1
    .FullRowSelect = True
    .ColumnHeaders.Add , , "Item Column"
    .ColumnHeaders.Add , , "Subitem 1"
    .ColumnHeaders.Add , , "Subitem 2"
    Dim i&
    For i = 1 To 30
      With .ListItems.Add(, , "Item " & CStr(i))
        .SubItems(1) = "Subitem 1"
        .SubItems(2) = "Subitem 2"
      End With
    Next
  End With
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
   Text1.Top = Item.Top + ListView1.Top 'You can ajust TextBox Size by +/- 30-60 twips to Top, Height Left and Width properties. But remember, that TextBox Height can not be less then font height in this textbox
   Text1.Left = ListView1.ColumnHeaders(curSubItem).Left + ListView1.Left
   Text1.Height = Item.Height
   Text1.Width = ListView1.ColumnHeaders(curSubItem).Width
   Text1 = 3
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  For i = 1 To ListView1.ColumnHeaders.Count
    If x < ListView1.ColumnHeaders(i).Left + ListView1.ColumnHeaders(i).Width Then
       curSubItem = i
       Exit For
    End If
  Next i
End Sub

Cheers
0
 

Author Comment

by:Olli083097
ID: 2635370
Hehehehehehe! I recently found out about subclassing, so I have had my mind completely locked on it. So I didn't see the obvious solution to my problem... But a promise is a promise, here is your grade A!
0
 
LVL 27

Expert Comment

by:Ark
ID: 2635391
Hi
Thanks for points, glad to help you. Next time use subclassing only if NOTHING else can help
Cheers
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

705 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now