Results 1 to 6 of 6

Thread: know index over mouse movement...listview vba for excel

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Mar 2005
    Posts
    2,580

    know index over mouse movement...listview vba for excel

    Code:
    Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    
       
    
    End Sub
    how to know which number of index is over mouse move listview?

    note:
    i'm in vba for excel not vb 6.0

  2. #2
    Member pike's Avatar
    Join Date
    Jul 2008
    Location
    Alstonville, Australia
    Posts
    52

    Re: know index over mouse movement...listview vba for excel

    Hi luca90,
    do you mean in treeview?

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Mar 2005
    Posts
    2,580

    Re: know index over mouse movement...listview vba for excel

    Quote Originally Posted by pike View Post
    Hi luca90,
    do you mean in treeview?
    ListView1

  4. #4
    Member pike's Avatar
    Join Date
    Jul 2008
    Location
    Alstonville, Australia
    Posts
    52

    Re: know index over mouse movement...listview vba for excel

    Hi luca90
    can you adapt this API code for Treeview to listview? Listview has a hittest function
    Module code
    Code:
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
      ByVal hdc As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
      ByVal nIndex As Long) As Long
    
    Const HWND_DESKTOP As Long = 0
    Const LOGPIXELSX As Long = 88
    Const LOGPIXELSY As Long = 90
    
    '--------------------------------------------------
    Function TwipsPerPixelX() As Single
    '--------------------------------------------------
    'Returns the width of a pixel, in twips.
    '--------------------------------------------------
      Dim lngDC As Long
      lngDC = GetDC(HWND_DESKTOP)
      TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
      ReleaseDC HWND_DESKTOP, lngDC
    End Function
    
    '--------------------------------------------------
    Function TwipsPerPixelY() As Single
    '--------------------------------------------------
    'Returns the height of a pixel, in twips.
    '--------------------------------------------------
      Dim lngDC As Long
      lngDC = GetDC(HWND_DESKTOP)
      TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
      ReleaseDC HWND_DESKTOP, lngDC
    End Function
    userform code
    Code:
    Private Sub TreeView1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, _
    ByVal y As stdole.OLE_YPOS_PIXELS)
    
        Dim nodTemp As Node
        Dim strText As String
    
        If Button = 0 Then
            Set nodTemp = TreeView1.HitTest( _
    TwipsPerPixelX * x, TwipsPerPixelY * y)
            If Not nodTemp Is Nothing Then
                strText = nodTemp.Text
            Else
                strText = "Nothing"
            End If
            Me.Caption = "X=" & x & " Y=" & y & " " & strText
        End If
    End Sub
    idea is that once the mouse is over the listview you can loop until you find the value and index inwith a listview list.

  5. #5
    Member pike's Avatar
    Join Date
    Jul 2008
    Location
    Alstonville, Australia
    Posts
    52

    Re: know index over mouse movement...listview vba for excel

    or
    Code:
    Option Explicit
    
    Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
        Dim nodTemp As ListItem
        Dim strText As String
        If Button = 0 Then
            Set nodTemp = ListView1.HitTest(TwipsPerPixelX * x, TwipsPerPixelY * y)
            If Not nodTemp Is Nothing Then
                strText = " Index code Number " & nodTemp.Index & " Key " & nodTemp.Key & " Count " & nodTemp.ListSubItems.Count
            Else
                strText = " Index code Number Nil"
            End If
            Me.Caption = strText
        End If
    End Sub
    
    Private Sub UserForm_Initialize()
        With ListView1
            .View = lvwReport
            .CheckBoxes = True
            .Gridlines = True
            With .ColumnHeaders
                .Clear
                .Add , , "Item", 70
                .Add , , "Subitem-1", 70
                .Add , , "Subitem-2", 70
                .Add , , "Subitem-3", 70
                .Add , , "Subitem-4", 70
                .Add , , "Subitem-5", 70
    
            End With
    
            Dim li As ListItem
            Dim lo As ListItem
            Dim lx As ListItem
            Set li = .ListItems.Add(, "One-1", "One")
    
            li.ListSubItems.Add , , "Sub-item 1.1", , "Hello"
            li.ListSubItems.Add , , "Sub-item 1.2"
            li.ListSubItems.Add , , "Sub-item 1.3"
            li.ListSubItems.Add , , "Sub-item 1.4"
    
    
            Set lo = .ListItems.Add(, "Two-2", "Two")
            lo.ListSubItems.Add , , "Sub-item 2.1"
            lo.ListSubItems.Add , "l", "Sub-item 2.2"
    
            Set lx = .ListItems.Add(, "Three-3", "Three")
            lx.ListSubItems.Add , , "Sub-item 3.1"
            lx.ListSubItems.Add , , "Sub-item 3.2"
    
            .ColumnHeaders(1).Position = 1
        End With
    
    End Sub

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Mar 2005
    Posts
    2,580

    Re: know index over mouse movement...listview vba for excel

    Quote Originally Posted by pike View Post
    or
    Code:
    Option Explicit
    
    Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
        Dim nodTemp As ListItem
        Dim strText As String
        If Button = 0 Then
            Set nodTemp = ListView1.HitTest(TwipsPerPixelX * x, TwipsPerPixelY * y)
            If Not nodTemp Is Nothing Then
                strText = " Index code Number " & nodTemp.Index & " Key " & nodTemp.Key & " Count " & nodTemp.ListSubItems.Count
            Else
                strText = " Index code Number Nil"
            End If
            Me.Caption = strText
        End If
    End Sub
    
    Private Sub UserForm_Initialize()
        With ListView1
            .View = lvwReport
            .CheckBoxes = True
            .Gridlines = True
            With .ColumnHeaders
                .Clear
                .Add , , "Item", 70
                .Add , , "Subitem-1", 70
                .Add , , "Subitem-2", 70
                .Add , , "Subitem-3", 70
                .Add , , "Subitem-4", 70
                .Add , , "Subitem-5", 70
    
            End With
    
            Dim li As ListItem
            Dim lo As ListItem
            Dim lx As ListItem
            Set li = .ListItems.Add(, "One-1", "One")
    
            li.ListSubItems.Add , , "Sub-item 1.1", , "Hello"
            li.ListSubItems.Add , , "Sub-item 1.2"
            li.ListSubItems.Add , , "Sub-item 1.3"
            li.ListSubItems.Add , , "Sub-item 1.4"
    
    
            Set lo = .ListItems.Add(, "Two-2", "Two")
            lo.ListSubItems.Add , , "Sub-item 2.1"
            lo.ListSubItems.Add , "l", "Sub-item 2.2"
    
            Set lx = .ListItems.Add(, "Three-3", "Three")
            lx.ListSubItems.Add , , "Sub-item 3.1"
            lx.ListSubItems.Add , , "Sub-item 3.2"
    
            .ColumnHeaders(1).Position = 1
        End With
    
    End Sub
    great help! Pike...
    i cannot test now but....
    tks in other case.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width