PBWin ToolTips and ListView

[Jordi Vallès]

After some frustrations I have decided to investigate the behaviour of ToolTips on a ListView control. In this program, that I used in my tests I've outlined findings and conclusions.

The first conclusion is that MS, seems, has some "black holes" or "mysteries" in certain areas and is reluctant to inform about some themes. Perhaps afraid that users will know too.

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'  Different kinds of ToolTips on a ListView control.
'                                   Jordi Vallès     version 1a    29/04/2009
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Original source code cames from "ListView.bas" on ..\Samples\DDT\Listview
'  folder.
'
'  ListView.bas example for PowerBASIC for Windows
'  Copyright (c) 2009 PowerBASIC, Inc.
'  All Rights Reserved.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'  Some code added to source referenced to show and test three different kinds
'  of ToolTips that a ListView control can have.
'
'  The types are:
'  1) Traditional tooltips. Used with standard controls like buttons, labels,
'     checkboxes, etc.
'     Information found on PB forum in several sources.
'     Not valid for items, subitems and headers of a ListView control.
'     These tooltips can be balloon style.
'  2) Row tooltips. Can be obtained using the extended style %LVS_EX_INFOTIP
'     on initialization of a ListView control causing a %LVN_GETINFOTIP
'     notifications.
'     Valid only for subitem 0.
'     Not found information about balloon style for this tooltip type.
'     Good information found on PB forum supplied by Mark Newman.
'  3) Tooltips on each one part (or column) of first or header row is some
'     complicate, mainly due the poor information in MSDN about some details,
'     like that header row is a control child of listview control.
'     It's need to create a Hook to intercept mouse msg $WM_MOUSEMOVE when are
'     over header parts.
'     Independent ToolTip control is needed.
'     These tooltips can be balloon style.
'     Information and a good example has been found on "www.codeguru.com" web.
'
'  Play with this program and see and after check the code. As you like.
'
'  Notes:
'  -  Without the XP Manifest resource file the behaviour of header tooltip
'     is some different ???
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  - Compiled and tested with PowerBASIC for Windows 9.01 on a PC HP Pavilion
'    with Windows Vista Home Premium SP1.
'  - Untested on Windows XP.
'  - Code posted here is released to Public Domain. Use at your own risk.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SED_PBWIN

#Compiler PBWin 9
#Compile Exe "LVdemo.exe"
#Dim All

' Add the XP Manifest resrouce file, from \Samples\DDT\Listview folder
#Resource "ListView.pbr"                  'needed                   

#Include "Win32Api.inc"
#Include "Commctrl.inc"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%LVROWS      = 50                         'number of rows in the ListView
%LVCOLS      = 3                          'number of columns in the ListView

%ID_LABEL1   = 1001                       'id of the label 1 control
%ID_LABEL2   = 1002                       'id of the label 2 control
%ID_LISTVIEW = 1011                       'id of the ListView control
%ID_ONE      = 1021                       'buttons
%ID_TWO      = 1022                       'buttons
%ID_EXIT     = 1023                       'buttons
%ID_CBOX     = 1024                       'check box

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Global OldLVProc             As Dword     'Old Listview callback procedure pointer
Global hToolTip1, hToolTip2  As Dword     'Tooltips handlers
Global hLVgrid               As Dword     'Listview handler
Global hLVHeader             As Dword     'Listview header handler (child of main listview)
Global mPrevWndProc          As Dword     'Previous window address
Global mCurHdrItem           As Long

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function PBMain() As Long
   Local hDlg        As Dword
   Local i, j        As Long
   Local lStyle      As Dword

   Dialog New 0, "ListView Subitem Example",,, 314, 250, %WS_VISIBLE Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN Or _
         %WS_CAPTION Or %WS_SYSMENU Or %WS_THICKFRAME Or %WS_MINIMIZEBOX, %WS_EX_WINDOWEDGE, To hDlg

   Control Add Button,    hDlg, %ID_ONE,   "One",         165, 232, 44, 13
   Control Add Button,    hDlg, %ID_TWO,   "Two",         211, 232, 44, 13
   Control Add Button,    hDlg, %ID_EXIT,  "Exit",        256, 232, 44, 13
   Control Add Checkbox,  hDlg, %ID_CBOX,  "Checkbox",     10, 234, 50, 10

   Control Add Label, hDlg, %ID_LABEL1, _
         "Use the Mouse, Arrow keys, PgUp, PgDn, Home, and End keys to navigate the ListView", _
         1, 1, 313, 8, %SS_CENTER
   Control Set Color hDlg, %ID_LABEL1, %RGB_FIREBRICK, - 1

   Control Add Label, hDlg, %ID_LABEL2, _
         "( Check the three ToolTips types added )", _
         1, 10, 313, 8, %SS_CENTER
   Control Set Color hDlg, %ID_LABEL2, %RGB_FIREBRICK, - 1

   Control Add ListView, hDlg, %ID_LISTVIEW, "", 1, 22, 312, 202, _
         %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %LVS_REPORT Or %LVS_SHOWSELALWAYS Or %LVS_SINGLESEL

   ' Add some sample text to the ListView
   For i = 1 To %LVCOLS
      ListView Insert Column hDlg, %ID_LISTVIEW, i, "Column #" + Format$(i), 100, 0
   Next i

   For i = 1 To %LVROWS
      ListView Insert Item hDlg, %ID_LISTVIEW, i, 0, "Row #" + Format$(i, "000") + " Item #01"
      For j = 2 To %LVCOLS
         ListView Set Text hDlg, %ID_LISTVIEW, i, j, "Row #" + Format$(i, "000") + " Item #" + Format$(j, "00")
      Next j
   Next i

   '----- ToolTips support ----- for standard controls, buttons, etc. -----
   hToolTip1 = CreateWindowEx(ByVal 0, "tooltips_class32", "", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
              0, 0, 0, 0, ByVal hDlg, ByVal 0, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip1, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip1, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip1, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   SetToolTip1 hToolTip1, %ID_ONE,    "Information about this ONE button"
   SetToolTip1 hToolTip1, %ID_TWO,    "Explanation about TWO button"
   SetToolTip1 hToolTip1, %ID_EXIT,   "EXIT button" + $Cr + _
                                      "and more text"
   SetToolTip1 hToolTip1, %ID_CBOX,   "Another additional information, in this case with a very very very long text"

   '----- ToolTips support -----  special for ListView header -----
   hToolTip2 = CreateWindowEx(ByVal 0, "tooltips_class32", "j", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
                     0, 0, 0, 0, hLVheader, %NULL, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip2, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip2, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip2, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   '----- prepare a window hook -----
   Control Handle hDlg, %ID_LISTVIEW To hLVgrid        'get listview handler
   hLVheader = GetWindow(hLVgrid, %GW_CHILD)           'get header's handler
   ToolTip2Hook hLVheader                              'hook creation

   '----- set extended styles -----
   lStyle = SendMessage (hLVgrid, %LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   lStyle = lStyle Or %LVS_EX_GRIDLINES Or %LVS_EX_FULLROWSELECT Or %LVS_EX_INFOTIP
   SendMessage hLVgrid, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal lStyle

   Dialog Show Modal hDlg, Call DlgProc
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2Hook(ByVal hWnd As Dword)
   mPrevWndProc = SetWindowLong(hWnd, %GWL_WNDPROC, CodePtr(WindowProc))
   mCurHdrItem  = -1
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2UnHook(ByVal hWnd As Dword)
   If mPrevWndProc Then SetWindowLong hWnd, %GWL_WNDPROC, mPrevWndProc
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CallBack Function DlgProc
   Static zText As Asciiz * 256

   Select Case As Long Cb.Msg
      Case %WM_INITDIALOG
         'Subclass the listview control so we can receive %WM_LButtonDown and %WM_KeyDown messages
         OldLVProc = SetWindowLong(GetDlgItem(Cb.Hndl, %ID_LISTVIEW), %GWL_WNDPROC, ByVal CodePtr(LVProc))

      Case %WM_NOTIFY
         Local nmlv As NMLISTVIEW Ptr
         Local pTt As NMLVGETINFOTIP Ptr

         nmlv = Cb.Lparam
         If @nmlv.hdr.hWndFrom = hLVgrid Then               'Is the Notify from the ListView?
            Select Case @nmlv.hdr.code
               Case %LVN_GETINFOTIP                         'Tooltip is requesting text
                  pTt = Cb.Lparam
                  ListView_GetItemText hLVgrid, @pTt.iItem, 0, zText, SizeOf(zText)
                  zText = "Tip:  Row = " + Str$(@pTt.iItem) + ", Col = " + Str$(@pTt.iSubitem) + _
                          $Cr + "Text:  " + zText
                  @pTt.cchTextMax = SizeOf(zText)
                  @pTt.pszText = VarPtr(zText)
                  Function = 1
                  Exit Function
            End Select
         End If

      Case %WM_COMMAND
         Select Case Cb.Ctl
            Case %ID_EXIT, %IDCANCEL
               If Cb.CtlMsg = %BN_CLICKED Then
                  If MsgBox("Abort the process?", %MB_YESNO Or %MB_ICONQUESTION Or %MB_TASKMODAL, _
                            "Abort?") = %IDYES Then Dialog End Cb.Hndl, 0
               End If
            Case %ID_ONE      ' ...
            Case %ID_TWO      ' ...
            Case %ID_CBOX     ' ...
         End Select

      Case %WM_NCACTIVATE
         Static hWndSaveFocus As Dword
         If IsFalse Cb.WParam Then
            hWndSaveFocus = GetFocus()
         ElseIf hWndSaveFocus Then
            SetFocus(hWndSaveFocus)
            hWndSaveFocus = 0
         End If

      Case %WM_SYSCOMMAND
         If Cb.WParam = %SC_CLOSE Then
            If MsgBox("Are you sure you want to quit the application?", _
                      %MB_YESNO Or %MB_DEFBUTTON2 Or %MB_SYSTEMMODAL) = %IDNO Then
               Function = 1 : Exit Function
            End If
         End If

      Case %WM_DESTROY
         If OldLVProc Then SetWindowLong(GetDlgItem(Cb.Hndl, %ID_LISTVIEW), %GWL_WNDPROC, OldLVProc)
         ToolTip2UnHook hLVheader

   End Select
End Function

' ListView callback procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function LVProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Static Col As Long                                         ' Selected column
   Static Row As Long                                         ' Selected row
   Local c As Long                                            ' Number of rows per page
   Local LVHT As LVHITTESTINFO                                ' Contains information about a mouse clik on the ListView

   Select Case As Long wMsg

      Case %WM_LBUTTONDOWN
         lvht.pt.x = Lo(Word, lparam)                         ' X coordinate of mouse left button down
         lvht.pt.y = Hi(Word, lparam)                         ' Y coordinate of mouse left button down

         ' Find the listview item and subitem at these X, Y coordinates
         SendMessage(hwnd, %LVM_SUBITEMHITTEST, ByVal 0, ByVal VarPtr(LVHT))

         ' Did we find a listview item at these coordinates?
         If lVHT.iItem <> -1 Then
            ' Update the ListView with the new selection
            UpdateLVSelect(GetParent(hWnd), Row, Col, lVHT.iItem + 1, LVHT.iSubItem + 1)
         End If

         ' We handled this message, so we need to return a zero
         ' and not call the the original listview callback.
         Function = 0
         Exit Function

      Case %WM_KEYDOWN
         Select Case As Long wParam

            Case %VK_UP
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row - 1, Col)

            Case %VK_DOWN
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row + 1, Col)

            Case %VK_RIGHT
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row, Col + 1)

            Case %VK_LEFT
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row, Col - 1)

            Case %VK_PGUP
               ' Get the number of rows per page in the ListView
               c = SendMessage(hWnd, %LVM_GETCOUNTPERPAGE, 0, 0)
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row - c, Col)

            Case %VK_PGDN
               ' Get the number of rows per page in the ListView
               c = SendMessage(hWnd, %LVM_GETCOUNTPERPAGE, 0, 0)
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row + c, Col)

            Case %VK_HOME
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, 1, 1)

            Case %VK_END
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, %LVROWS, 1)

         End Select

         ' We handled this message, so we need to return a zero
         ' and not call the the original listview callback.
         Function = 0
         Exit Function

   End Select

   ' if we did not handle this message, pass the message on to the
   ' original callback for the listview control.
   Function = CallWindowProc(OldLVProc, hWnd, wMsg, wParam, lParam)
End Function

' Unselect the previous listview selection, select the new item and then ensure the new
' item is visible.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub UpdateLVSelect(ByVal hDlg As Long, ByRef Row As Long, ByRef Col As Long, ByVal NewRow As Long, ByVal NewCol As Long)

   ' Make sure the new row is within range
   If NewRow < 1 Then
      NewRow = 1
   ElseIf NewRow > %LVROWS Then
      NewRow = %LVROWS
   End If

   ' Make sure the new column is within range
   If NewCol < 1 Then
      NewCol = 1
   ElseIf NewCol > %LVCOLS Then
      NewCol = %LVCOLS
   End If

   ' If the previous and new selection are the same then do nothing
   If (Row = NewRow) And (Col = NewCol) Then Exit Sub

   ' Unselect the previous selection, required when seleting subitems
   ' even if the ListView contains the %LVS_SINGLESEL style
   ListView Unselect hDlg, %ID_LISTVIEW, Row, Col

   ' Update the Row and Column variables
   Row = NewRow
   Col = NewCol

   ' Select the new ListView item
   ListView Select hDlg, %ID_LISTVIEW, Row, Col

   ' Ensure the new ListView item is visible
   ListView Visible hDlg, %ID_LISTVIEW, Row
End Sub


'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function WindowProc(ByVal hWnd As Dword, ByVal wMsg As Long, ByVal wParam As Dword, ByVal lParam As Long) As Long
   Local hti   As HD_HITTESTINFO
   Local zText As Asciiz * 256

   Select Case wMsg
      Case %WM_MOUSEMOVE
         GetCursorPos hti.pt                                   'get mouse coordinates on screen
         MapWindowPoints 0, hLVheader, hti.pt, 1                'map them to header
         SendMessage hLVheader, %HDM_HITTEST, 0, VarPtr(hti)    'see what column we are over
         If hti.iItem <> mCurHdrItem Then
            mCurHdrItem = hti.iItem
            DelToolTip2 hWnd
            If mCurHdrItem <> -1 Then                          '-1 is over listview itself.
               zText = GetToolTipText(hti.iItem)
               SetToolTip2 hWnd, zText
            End If
         End If
   End Select
   Function = CallWindowProc(mPrevWndProc, hWnd, wMsg, wParam, lParam)
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function GetToolTipText(ByVal Id As Long) As String
   Select Case As Long Id
      Case 0  :  Function = " This is the first column"
      Case 1  :  Function = " This is the second column" + $Cr + _
                            " that follows the first column"
      Case 2  :  Function = " This is the third column" + $Cr + _
                            " that follows the second column"  + $Cr + _
                            " and first column too"
   End Select
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip1(hWndTip As Dword, id As Long, Byval txt As String)  'for standard controls
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = GetParent(hWndTip)
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = GetDlgItem(hLocalWnd, id)
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip1, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip2(hWnd As Dword, Byval txt As String)        'for ListView headers
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = hWnd
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = hLocalWnd
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip2, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DelToolTip2(hWnd As Dword)                             'for ListView headers
   Local ti     As TOOLINFO

   ti.cbSize    = SizeOf(ti)
   ti.hWnd      = hWnd
   While SendMessage(hToolTip2, %TTM_ENUMTOOLS, 0, VarPtr(ti))
      SendMessage hToolTip2, %TTM_DELTOOL, 0, VarPtr(ti)
   Wend
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'eof

This code is also zipped and can be downloaded.

[Bob Clarke]

Thanks for a great post

Hello Jordi,
Thanks for a very well written post.
Exellent sample code, just right depth and complexity.
This should be included in PB samples.

My program is writen in PBWin 9.01 and PBForms 1.51.
As I already have one resource file I was unable to include the "ListView.pbr".
and havn't be able to get my resource to include the 'XP Manifest'.
However it seems to work fine anyway.

One question would be how to get PBForms to include an 'XP Manifest'?

Another question is how to get Listview ToolsTips on a second window?
The main window Buttons and Listview ToolTips work fine.
The second window Buttons work but not the Listview ToolTips.
(yes I have absolutely seperate variables handles etc.)

Have a great day.

[Jordi Vallès]

Hi Bob,
The answers are very simple.
1. Edit the resource file and include the "manifest" file, like samples provided by PB and compile it using the PBEdit or other IDE.
2. Simply duplicate all controls, handlers and routines related with Listview tooltips with different name, of course. Look the sample provided, is the same as before but with two listviews controls A and B. Some points can be optimized to avoid code duplications but as example is correct.

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'  Different kinds of ToolTips on a ListView control.
'                                      Jordi Vallès     version 1b    26/06/2009
'  (this version has two listviews with different header and row tooltips)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Original source code cames from "ListView.bas" on ..\Samples\DDT\Listview
'  folder.
'
'  ListView.bas example for PowerBASIC for Windows
'  Copyright (c) 2009 PowerBASIC, Inc.
'  All Rights Reserved.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'  Some code added to source referenced to show and test three different kinds
'  of ToolTips that a ListView control can have.
'
'  Types are:
'  1) Traditional tooltips. Used with standard controls like buttons, labels,
'     checkboxes, etc.
'     Information found on PB forum in several sources.
'     Not valid for items, subitems and headers of a ListView control.
'     These tooltips can be balloon style.
'  2) Row tooltips. Can be obtained using the extended style %LVS_EX_INFOTIP
'     on initialization of a ListView control causing a %LVN_GETINFOTIP
'     notifications.
'     Valid only for subitem 0.
'     Not found information about balloon style on this tooltip type.
'     Good information found on PB forum supplied by Mark Newman.
'  3) Tooltips on each one part (or column) of first or header row is some
'     complicate, mainly due the poor information in MSDN about some details,
'     like that header row is a control child of listview control.
'     It's need to create a Hook to intercept mouse msg $WM_MOUSEMOVE when are
'     over header parts.
'     Independent ToolTip control is needed.
'     These tooltips can be balloon style.
'     Information and a good example has been found on "www.codeguru.com" web.
'
'  Play with this program and see and after check the code. As you like.
'
'  Notes:
'  -  Without the XP Manifest resource file the behaviour of header tooltip
'     is some different ???
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  - Compiled and tested with PowerBASIC for Windows 9.01 on a PC HP Pavilion
'    with Windows Vista Home Premium SP1.
'  - Untested on Windows XP.
'  - Code posted here is released to Public Domain. Use at your own risk.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SED_PBWIN

#Compiler PBWin 9
#Compile Exe "LVdemo.exe"
#Dim All

' Add the XP Manifest resrouce file, from \Samples\DDT\Listview folder
#Resource "ListView.pbr"                  'needed

#Include "Win32Api.inc"
#Include "Commctrl.inc"

#Include "DDebug.inc"                     'only for debug

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%LVROWS       = 50                         'number of rows in the ListView
%LVCOLS       = 2                          'number of columns in the ListView

%ID_LABEL1    = 1001                       'id of the label 1 control
%ID_LABEL2    = 1002                       'id of the label 2 control
%ID_LISTVIEWA = 1011                       'id of the ListView control
%ID_LISTVIEWB = 1012                       'id of the ListView control
%ID_ONE       = 1021                       'buttons
%ID_TWO       = 1022                       'buttons
%ID_EXIT      = 1023                       'buttons
%ID_CBOX      = 1024                       'check box

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Global OldLVProc                    As Dword     'Old Listview callback procedure pointer
Global hToolTip1                    As Dword     'Tooltips handlers
Global hToolTip2A, hToolTip2B       As Dword     'Tooltips handlers
Global hLVgridA, hLVgridB           As Dword     'Listview handlers
Global hLVHeaderA, hLVHeaderB       As Dword     'Listview header handlers (child of main listviews)
Global mPrevWndProcA, mPrevWndProcB As Dword     'Previous window address
Global mCurHdrItemA, mCurHdrItemB   As Long

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function PBMain() As Long
   Local hDlg        As Dword
   Local i, j        As Long
   Local lStyle      As Dword

gDebugFlag = %TRUE

   Dialog New 0, "ListView Subitem Example",,, 414, 250, %WS_VISIBLE Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN Or _
         %WS_CAPTION Or %WS_SYSMENU Or %WS_THICKFRAME Or %WS_MINIMIZEBOX, %WS_EX_WINDOWEDGE, To hDlg

   Control Add Button,    hDlg, %ID_ONE,   "One",         165, 232, 44, 13
   Control Add Button,    hDlg, %ID_TWO,   "Two",         211, 232, 44, 13
   Control Add Button,    hDlg, %ID_EXIT,  "Exit",        256, 232, 44, 13
   Control Add Checkbox,  hDlg, %ID_CBOX,  "Checkbox",     10, 234, 50, 10

   Control Add Label, hDlg, %ID_LABEL1, _
         "Use the Mouse, Arrow keys, PgUp, PgDn, Home, and End keys to navigate the ListView", _
         1, 1, 313, 8, %SS_CENTER
   Control Set Color hDlg, %ID_LABEL1, %RGB_FIREBRICK, - 1

   Control Add Label, hDlg, %ID_LABEL2, _
         "( Check the three ToolTips types added )", _
         1, 10, 313, 8, %SS_CENTER
   Control Set Color hDlg, %ID_LABEL2, %RGB_FIREBRICK, - 1


   '~~~~~ Standard Tooltip support ~~~~~~~~ for standard controls, buttons, etc. ~~~~~~~~~~~~~~~
    hToolTip1 = CreateWindowEx(ByVal 0, "tooltips_class32", "", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
              0, 0, 0, 0, ByVal hDlg, ByVal 0, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip1, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip1, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip1, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   SetToolTip1 hToolTip1, %ID_ONE,    "Information about this ONE button"
   SetToolTip1 hToolTip1, %ID_TWO,    "Explanation about TWO button"
   SetToolTip1 hToolTip1, %ID_EXIT,   "EXIT button" + $Cr + _
                                      "and more text"
   SetToolTip1 hToolTip1, %ID_CBOX,   "Another additional information, in this case with a very very very long text"


   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ListView A ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   Control Add ListView, hDlg, %ID_LISTVIEWA, "", 5, 22, 200, 202, _
         %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %LVS_REPORT Or %LVS_SHOWSELALWAYS Or %LVS_SINGLESEL

   'Add some sample text to the ListView
   For i = 1 To %LVCOLS
      ListView Insert Column hDlg, %ID_LISTVIEWA, i, "Column #" + Format$(i) + " A", 100, 0
   Next i

   For i = 1 To %LVROWS
      ListView Insert Item hDlg, %ID_LISTVIEWA, i, 0, "Row #" + Format$(i, "000") + " Item #01"
      For j = 2 To %LVCOLS
         ListView Set Text hDlg, %ID_LISTVIEWA, i, j, "Row #" + Format$(i, "000") + " Item #" + Format$(j, "00")
      Next j
   Next i

   '----- ToolTips support -----  special for ListView A header -----
   hToolTip2a = CreateWindowEx(ByVal 0, "tooltips_class32", "j", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
                     0, 0, 0, 0, hLVheadera, %NULL, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip2A, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip2A, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip2A, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   '----- prepare a window hook -----
   Control Handle hDlg, %ID_LISTVIEWA To hLVgridA        'get listview handler
   hLVheaderA = GetWindow(hLVgridA, %GW_CHILD)           'get header's handler
   ToolTip2HookA hLVheaderA                              'hook creation

   '----- set extended styles -----
   lStyle = SendMessage (hLVgrida, %LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   lStyle = lStyle Or %LVS_EX_GRIDLINES Or %LVS_EX_FULLROWSELECT Or %LVS_EX_INFOTIP
   SendMessage hLVgrida, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal lStyle


   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ListView B ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   Control Add ListView, hDlg, %ID_LISTVIEWB, "", 210, 22, 200, 202, _
         %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %LVS_REPORT Or %LVS_SHOWSELALWAYS Or %LVS_SINGLESEL

   'Add some sample text to the ListView
   For i = 1 To %LVCOLS
      ListView Insert Column hDlg, %ID_LISTVIEWB, i, "Column #" + Format$(i) + " B", 100, 0
   Next i

   For i = 1 To %LVROWS
      ListView Insert Item hDlg, %ID_LISTVIEWB, i, 0, "Row #" + Format$(i, "000") + " Item #01"
      For j = 2 To %LVCOLS
         ListView Set Text hDlg, %ID_LISTVIEWB, i, j, "Row #" + Format$(i, "000") + " Item #" + Format$(j, "00")
      Next j
   Next i

   '----- ToolTips support -----  special for ListView B header -----
   hToolTip2b = CreateWindowEx(ByVal 0, "tooltips_class32", "j", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
                     0, 0, 0, 0, hLVheaderb, %NULL, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip2B, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip2B, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip2B, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   '----- prepare a window hook -----
   Control Handle hDlg, %ID_LISTVIEWB To hLVgridB        'get listview handler
   hLVheaderB = GetWindow(hLVgridB, %GW_CHILD)           'get header's handler
   ToolTip2HookB hLVheaderB                              'hook creation

   '----- set extended styles -----
   lStyle = SendMessage (hLVgridB, %LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   lStyle = lStyle Or %LVS_EX_GRIDLINES Or %LVS_EX_FULLROWSELECT Or %LVS_EX_INFOTIP
   SendMessage hLVgridB, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal lStyle


   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   Dialog Show Modal hDlg, Call DlgProc
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2HookA(ByVal hWnd As Dword)
   mPrevWndProcA = SetWindowLong(hWnd, %GWL_WNDPROC, CodePtr(WindowProcA))
   mCurHdrItemA  = -1
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2UnHookA(ByVal hWnd As Dword)
   If mPrevWndProcA Then SetWindowLong hWnd, %GWL_WNDPROC, mPrevWndProcA
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2HookB(ByVal hWnd As Dword)
   mPrevWndProcB = SetWindowLong(hWnd, %GWL_WNDPROC, CodePtr(WindowProcB))
   mCurHdrItemB  = -1
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2UnHookB(ByVal hWnd As Dword)
   If mPrevWndProcB Then SetWindowLong hWnd, %GWL_WNDPROC, mPrevWndProcB
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CallBack Function DlgProc
   Static zText As Asciiz * 256

   Select Case As Long Cb.Msg
      Case %WM_INITDIALOG
         'Subclass the listview control so we can receive %WM_LButtonDown and %WM_KeyDown messages
         OldLVProc = SetWindowLong(GetDlgItem(Cb.Hndl, %ID_LISTVIEWA), %GWL_WNDPROC, ByVal CodePtr(LVProc))

      Case %WM_NOTIFY
         Local nmlv As NMLISTVIEW Ptr
         Local pTt As NMLVGETINFOTIP Ptr

         nmlv = Cb.Lparam
         If @nmlv.hdr.hWndFrom = hLVgridA Then               'Is the Notify from the ListView?
            Select Case @nmlv.hdr.code
               Case %LVN_GETINFOTIP                         'Tooltip is requesting text
                  pTt = Cb.Lparam
                  ListView_GetItemText hLVgridA, @pTt.iItem, 0, zText, SizeOf(zText)
                  zText = "Tip:  Row = " + Str$(@pTt.iItem) + ", Col = " + Str$(@pTt.iSubitem) + _
                          $Cr + "Text:  " + zText + " AAAAA"
                  @pTt.cchTextMax = SizeOf(zText)
                  @pTt.pszText = VarPtr(zText)
                  Function = 1
                  Exit Function
            End Select
         ElseIf @nmlv.hdr.hWndFrom = hLVgridB Then               'Is the Notify from the ListView?
            Select Case @nmlv.hdr.code
               Case %LVN_GETINFOTIP                         'Tooltip is requesting text
                  pTt = Cb.Lparam
                  ListView_GetItemText hLVgridB, @pTt.iItem, 0, zText, SizeOf(zText)
                  zText = "Tip:  Row = " + Str$(@pTt.iItem) + ", Col = " + Str$(@pTt.iSubitem) + _
                          $Cr + "Text:  " + zText + " BBBBB"
                  @pTt.cchTextMax = SizeOf(zText)
                  @pTt.pszText = VarPtr(zText)
                  Function = 1
                  Exit Function
            End Select

         End If

      Case %WM_COMMAND
         Select Case Cb.Ctl
            Case %ID_EXIT, %IDCANCEL
               If Cb.CtlMsg = %BN_CLICKED Then
                  If MsgBox("Abort the process?", %MB_YESNO Or %MB_ICONQUESTION Or %MB_TASKMODAL, _
                            "Abort?") = %IDYES Then Dialog End Cb.Hndl, 0
               End If
            Case %ID_ONE      ' ...
            Case %ID_TWO      ' ...
            Case %ID_CBOX     ' ...
         End Select

      Case %WM_NCACTIVATE
         Static hWndSaveFocus As Dword
         If IsFalse Cb.WParam Then
            hWndSaveFocus = GetFocus()
         ElseIf hWndSaveFocus Then
            SetFocus(hWndSaveFocus)
            hWndSaveFocus = 0
         End If

      Case %WM_SYSCOMMAND
         If Cb.WParam = %SC_CLOSE Then
            If MsgBox("Are you sure you want to quit the application?", _
                      %MB_YESNO Or %MB_DEFBUTTON2 Or %MB_SYSTEMMODAL) = %IDNO Then
               Function = 1 : Exit Function
            End If
         End If

      Case %WM_DESTROY
         If OldLVProc Then SetWindowLong(GetDlgItem(Cb.Hndl, %ID_LISTVIEWA), %GWL_WNDPROC, OldLVProc)
         ToolTip2UnHookA hLVheaderA
         ToolTip2UnHookB hLVheaderB

   End Select
End Function

' ListView callback procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function LVProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Static Col As Long                                         ' Selected column
   Static Row As Long                                         ' Selected row
   Local c As Long                                            ' Number of rows per page
   Local LVHT As LVHITTESTINFO                                ' Contains information about a mouse clik on the ListView

   Select Case As Long wMsg

      Case %WM_LBUTTONDOWN
         lvht.pt.x = Lo(Word, lparam)                         ' X coordinate of mouse left button down
         lvht.pt.y = Hi(Word, lparam)                         ' Y coordinate of mouse left button down

         ' Find the listview item and subitem at these X, Y coordinates
         SendMessage(hwnd, %LVM_SUBITEMHITTEST, ByVal 0, ByVal VarPtr(LVHT))

         ' Did we find a listview item at these coordinates?
         If lVHT.iItem <> -1 Then
            ' Update the ListView with the new selection
            UpdateLVSelect(GetParent(hWnd), Row, Col, lVHT.iItem + 1, LVHT.iSubItem + 1)
         End If

         ' We handled this message, so we need to return a zero
         ' and not call the the original listview callback.
         Function = 0
         Exit Function

      Case %WM_KEYDOWN
         Select Case As Long wParam

            Case %VK_UP
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row - 1, Col)

            Case %VK_DOWN
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row + 1, Col)

            Case %VK_RIGHT
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row, Col + 1)

            Case %VK_LEFT
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row, Col - 1)

            Case %VK_PGUP
               ' Get the number of rows per page in the ListView
               c = SendMessage(hWnd, %LVM_GETCOUNTPERPAGE, 0, 0)
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row - c, Col)

            Case %VK_PGDN
               ' Get the number of rows per page in the ListView
               c = SendMessage(hWnd, %LVM_GETCOUNTPERPAGE, 0, 0)
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row + c, Col)

            Case %VK_HOME
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, 1, 1)

            Case %VK_END
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, %LVROWS, 1)

         End Select

         ' We handled this message, so we need to return a zero
         ' and not call the the original listview callback.
         Function = 0
         Exit Function

   End Select

   ' if we did not handle this message, pass the message on to the
   ' original callback for the listview control.
   Function = CallWindowProc(OldLVProc, hWnd, wMsg, wParam, lParam)
End Function

' Unselect the previous listview selection, select the new item and then ensure the new
' item is visible.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub UpdateLVSelect(ByVal hDlg As Long, ByRef Row As Long, ByRef Col As Long, ByVal NewRow As Long, ByVal NewCol As Long)

   ' Make sure the new row is within range
   If NewRow < 1 Then
      NewRow = 1
   ElseIf NewRow > %LVROWS Then
      NewRow = %LVROWS
   End If

   ' Make sure the new column is within range
   If NewCol < 1 Then
      NewCol = 1
   ElseIf NewCol > %LVCOLS Then
      NewCol = %LVCOLS
   End If

   ' If the previous and new selection are the same then do nothing
   If (Row = NewRow) And (Col = NewCol) Then Exit Sub

   ' Unselect the previous selection, required when seleting subitems
   ' even if the ListView contains the %LVS_SINGLESEL style
   ListView Unselect hDlg, %ID_LISTVIEWA, Row, Col

   ' Update the Row and Column variables
   Row = NewRow
   Col = NewCol

   ' Select the new ListView item
   ListView Select hDlg, %ID_LISTVIEWA, Row, Col

   ' Ensure the new ListView item is visible
   ListView Visible hDlg, %ID_LISTVIEWA, Row
End Sub


'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function WindowProcA(ByVal hWnd As Dword, ByVal wMsg As Long, ByVal wParam As Dword, ByVal lParam As Long) As Long
   Local hti   As HD_HITTESTINFO
   Local zText As Asciiz * 256

   Select Case wMsg
      Case %WM_MOUSEMOVE
         GetCursorPos hti.pt                                   'get mouse coordinates on screen
         MapWindowPoints 0, hLVheaderA, hti.pt, 1                'map them to header
         SendMessage hLVheaderA, %HDM_HITTEST, 0, VarPtr(hti)    'see what column we are over
         If hti.iItem <> mCurHdrItemA Then
            mCurHdrItemA = hti.iItem
            DelToolTip2A hWnd
            If mCurHdrItemA <> -1 Then                          '-1 is over listview itself.
               zText = GetToolTipTextA(hti.iItem)
               SetToolTip2A hWnd, zText
            End If
         End If
   End Select
   Function = CallWindowProc(mPrevWndProcA, hWnd, wMsg, wParam, lParam)
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function WindowProcB(ByVal hWnd As Dword, ByVal wMsg As Long, ByVal wParam As Dword, ByVal lParam As Long) As Long
   Local hti   As HD_HITTESTINFO
   Local zText As Asciiz * 256

   Select Case wMsg
      Case %WM_MOUSEMOVE
         GetCursorPos hti.pt                                   'get mouse coordinates on screen
         MapWindowPoints 0, hLVheaderB, hti.pt, 1                'map them to header
         SendMessage hLVheaderB, %HDM_HITTEST, 0, VarPtr(hti)    'see what column we are over
         If hti.iItem <> mCurHdrItemB Then
            mCurHdrItemB = hti.iItem
            DelToolTip2B hWnd
            If mCurHdrItemB <> -1 Then                          '-1 is over listview itself.
               zText = GetToolTipTextB(hti.iItem)
               SetToolTip2B hWnd, zText
            End If
         End If
   End Select
   Function = CallWindowProc(mPrevWndProcB, hWnd, wMsg, wParam, lParam)
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function GetToolTipTextA(ByVal Id As Long) As String
   Select Case As Long Id
      Case 0  :  Function = " This is the first column (A)"
      Case 1  :  Function = " This is the second column" + $Cr + _
                            " that follows the first column (A)"
   End Select
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function GetToolTipTextB(ByVal Id As Long) As String
   Select Case As Long Id
      Case 0  :  Function = " This is the first column (B)"
      Case 1  :  Function = " This is the second column" + $Cr + _
                            " that follows the first column (B)"
   End Select
End Function


'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip1(hWndTip As Dword, id As Long, Byval txt As String)  'for standard controls
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = GetParent(hWndTip)
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = GetDlgItem(hLocalWnd, id)
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip1, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip2A(hWnd As Dword, Byval txt As String)        'for ListView headers
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = hWnd
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = hLocalWnd
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip2A, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DelToolTip2A(hWnd As Dword)                             'for ListView headers
   Local ti     As TOOLINFO

   ti.cbSize    = SizeOf(ti)
   ti.hWnd      = hWnd
   While SendMessage(hToolTip2A, %TTM_ENUMTOOLS, 0, VarPtr(ti))
      SendMessage hToolTip2A, %TTM_DELTOOL, 0, VarPtr(ti)
   Wend
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip2B(hWnd As Dword, Byval txt As String)        'for ListView headers
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = hWnd
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = hLocalWnd
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip2B, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DelToolTip2B(hWnd As Dword)                             'for ListView headers
   Local ti     As TOOLINFO

   ti.cbSize    = SizeOf(ti)
   ti.hWnd      = hWnd
   While SendMessage(hToolTip2B, %TTM_ENUMTOOLS, 0, VarPtr(ti))
      SendMessage hToolTip2B, %TTM_DELTOOL, 0, VarPtr(ti)
   Wend
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'eof

Code is also zipped here

[Bob Clarke]

Two Windows

Hi Jordi,

I did a two window version of your sample just to show you
what I ment and it worked!
You were quite right there is a bug in my code somewhere.
I've got to find it...
Incidentaly were not getting a tip on column two of the list data
in any of the versions.

I'm going around with the guys in the forum on another thread
so I will get the xptheme into the pbr soon I hope.

Again thanks for your efforts.

[Jordi Vallès]

The LVN_GETINFOTIP notification is sent only for subitem 0.
I open a new thread to discuss why the %NM_HOVER notification is not received, at least on my tests. See http://www.powerbasic.com/support/pb...ad.php?t=40829

Jordi

[Bob Clarke]

Wow

That thread got way to deep very fast.
I now know its not my (your/our) code and no easy fix
can be done at this time.
I appreciate your getting me to were we are now.

[Jordi Vallès]

Finally I decided create and display tooltips for all items and subitems using %NM_CUSTOMDRAW notification.
On this sample you can see how four possible types or methods to use tooltips can be created.

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'  Different kinds of ToolTips on a ListView control.      
'  (found [COLOR=Red]four[/COLOR] types or methods to create and use till now)
'                                      Jordi Vallès     version 1d    28/06/2009
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Original source code cames from "ListView.bas" on ..\Samples\DDT\Listview
'  folder.
'
'  ListView.bas example for PowerBASIC for Windows
'  Copyright (c) 2009 PowerBASIC, Inc.
'  All Rights Reserved.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'  Some code added to source referenced to show and test four different kinds
'  of ToolTips that a ListView control can have.
'
'  Types are:
'  1) Traditional tooltips. Used with standard controls like buttons, labels,
'     checkboxes, etc.
'     Information found on PB forum in several sources.
'     Not valid for items, subitems and headers of a ListView control.
'     These tooltips can be balloon style.
'  2) Row tooltips. Can be obtained using the extended style %LVS_EX_INFOTIP
'     on initialization of a ListView control causing a %LVN_GETINFOTIP
'     notifications.
'     Valid only for subitem 0.
'     Not found information about balloon style on this tooltip type.
'     Good information found on PB forum supplied by Mark Newman.
'     In this sample this form is unused in benefit of next tooltip type
'  3) All items and subitems tooltips. Use standard tooltip just altering 
'     position and text via %NM_CUSTOMDRAW notification and changing a 
'     generic tooltip defined at beginning. See the code under %WM_NOTIFY.
'  4) Tooltips on each one part (or column) of first or header row is some
'     complicate, mainly due the poor information in MSDN about some details,
'     like that header row is a control child of listview control.
'     It's need to create a Hook to intercept mouse msg $WM_MOUSEMOVE when are
'     over header parts.
'     Independent ToolTip control is needed.
'     These tooltips can be balloon style.
'     Information and a good example has been found on "www.codeguru.com" web.
'
'  Play with this program and see and after check the code. As you like.
'
'  Notes:
'  -  Without the XP Manifest resource file the behaviour of header tooltip
'     is some different ???
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  - Compiled and tested with PowerBASIC for Windows 9.01 on a PC HP Pavilion
'    with Windows Vista Home Premium SP1.
'  - Untested on Windows XP.
'  - Code posted here is released to Public Domain. Use at your own risk.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SED_PBWIN

#Compiler PBWin 9
#Compile Exe "LVdemo4.exe"
#Dim All

' Add the XP Manifest resrouce file, from \Samples\DDT\Listview folder
#Resource "ListView.pbr"                  'needed

#Include "Win32Api.inc"
#Include "Commctrl.inc"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%LVROWS      = 50                         'number of rows in the ListView
%LVCOLS      = 3                          'number of columns in the ListView

%ID_LABEL1   = 1001                       'id of the label 1 control
%ID_LABEL2   = 1002                       'id of the label 2 control
%ID_LISTVIEW = 1011                       'id of the ListView control
%ID_ONE      = 1021                       'buttons
%ID_TWO      = 1022                       'buttons
%ID_EXIT     = 1023                       'buttons
%ID_CBOX     = 1024                       'check box

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Global OldLVProc             As Dword     'Old Listview callback procedure pointer
Global hToolTip1, hToolTip2  As Dword     'Tooltips handlers
Global hLVgrid               As Dword     'Listview handler
Global hLVHeader             As Dword     'Listview header handler (child of main listview)
Global mPrevWndProc          As Dword     'Previous window address
Global mCurHdrItem           As Long

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function PBMain() As Long
   Local hDlg        As Dword
   Local i, j        As Long
   Local lStyle      As Dword

   Dialog New 0, "ListView Tooltips Sample",,, 314, 250, %WS_VISIBLE Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN Or _
         %WS_CAPTION Or %WS_SYSMENU Or %WS_THICKFRAME Or %WS_MINIMIZEBOX, %WS_EX_WINDOWEDGE, To hDlg

   Control Add Button,    hDlg, %ID_ONE,   "One",         165, 232, 44, 13
   Control Add Button,    hDlg, %ID_TWO,   "Two",         211, 232, 44, 13
   Control Add Button,    hDlg, %ID_EXIT,  "Exit",        256, 232, 44, 13
   Control Add Checkbox,  hDlg, %ID_CBOX,  "Checkbox",     10, 234, 50, 10

   Control Add Label, hDlg, %ID_LABEL1, _
         "Use the Mouse, Arrow keys, PgUp, PgDn, Home, and End keys to navigate the ListView", _
         1, 1, 313, 8, %SS_CENTER
   Control Set Color hDlg, %ID_LABEL1, %RGB_FIREBRICK, - 1

   Control Add Label, hDlg, %ID_LABEL2, _
         "( Check the three ToolTips types added )", _
         1, 10, 313, 8, %SS_CENTER
   Control Set Color hDlg, %ID_LABEL2, %RGB_FIREBRICK, - 1

   Control Add ListView, hDlg, %ID_LISTVIEW, "", 1, 22, 312, 202, _
         %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %LVS_REPORT Or %LVS_SHOWSELALWAYS Or %LVS_SINGLESEL

   'Add some sample text to the ListView
   For i = 1 To %LVCOLS
      ListView Insert Column hDlg, %ID_LISTVIEW, i, "Column #" + Format$(i), 100, 0
   Next i

   For i = 1 To %LVROWS
      ListView Insert Item hDlg, %ID_LISTVIEW, i, 0, "Row #" + Format$(i, "000") + " Item #01"
      For j = 2 To %LVCOLS
         ListView Set Text hDlg, %ID_LISTVIEW, i, j, "Row #" + Format$(i, "000") + " Item #" + Format$(j, "00")
      Next j
   Next i

   '----- ToolTips support ----- for standard controls, buttons, etc. -----
   hToolTip1 = CreateWindowEx(ByVal 0, "tooltips_class32", "", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
              0, 0, 0, 0, ByVal hDlg, ByVal 0, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip1, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip1, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip1, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   SetToolTip1 hToolTip1, %ID_ONE,      "Information about this ONE button"
   SetToolTip1 hToolTip1, %ID_TWO,      "Explanation about TWO button"
   SetToolTip1 hToolTip1, %ID_EXIT,     "EXIT button" + $Cr + _
                                        "and more text"
   SetToolTip1 hToolTip1, %ID_CBOX,     "Another additional information, in this case with a very very very long text"
   SetToolTip1 hToolTip1, %ID_LISTVIEW, "Needed for display tooltips over grid cells"  '<========== used on %NM_CUSTOMDRAW notification 

   '----- ToolTips support -----  special for ListView header -----
   hToolTip2 = CreateWindowEx(ByVal 0, "tooltips_class32", "j", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, _
                     0, 0, 0, 0, hLVheader, %NULL, GetModuleHandle(ByVal %NULL), ByVal 0)
   Dialog Send hToolTip2, %TTM_SETMAXTIPWIDTH, 0, 250
   Dialog Send hToolTip2, %TTM_SETDELAYTIME, %TTDT_INITIAL, 500
   Dialog Send hToolTip2, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000

   '----- prepare a window hook -----
   Control Handle hDlg, %ID_LISTVIEW To hLVgrid        'get listview handler
   hLVheader = GetWindow(hLVgrid, %GW_CHILD)           'get header's handler
   ToolTip2Hook hLVheader                              'hook creation

   '----- set extended styles -----
   lStyle = SendMessage (hLVgrid, %LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   lStyle = lStyle Or %LVS_EX_GRIDLINES Or %LVS_EX_FULLROWSELECT Or %LVS_EX_INFOTIP 'Or %LVS_EX_LABELTIP
   SendMessage hLVgrid, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal lStyle

   Dialog Show Modal hDlg, Call DlgProc
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2Hook(ByVal hWnd As Dword)
   mPrevWndProc = SetWindowLong(hWnd, %GWL_WNDPROC, CodePtr(WindowProc))
   mCurHdrItem  = -1
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub ToolTip2UnHook(ByVal hWnd As Dword)
   If mPrevWndProc Then SetWindowLong hWnd, %GWL_WNDPROC, mPrevWndProc
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CallBack Function DlgProc
   Static zText As Asciiz * 256

   Select Case As Long Cb.Msg
      Case %WM_INITDIALOG
         'Subclass the listview control so we can receive %WM_LButtonDown and %WM_KeyDown messages
         OldLVProc = SetWindowLong(GetDlgItem(Cb.Hndl, %ID_LISTVIEW), %GWL_WNDPROC, ByVal CodePtr(LVProc))

      Case %WM_NOTIFY
         Local nmlv  As NMLISTVIEW Ptr
         'Local pTt   As NMLVGETINFOTIP Ptr      'not used in this sample
         Local lvhit As LVHITTESTINFO
         Local ti    As TOOLINFO
         
         nmlv = Cb.Lparam
         If @nmlv.hdr.idFrom = %ID_LISTVIEW Then     'Is the Notify from the ListView?
            Select Case As Long @nmlv.hdr.code
               
               Case %NM_CUSTOMDRAW 
                  GetCursorPos lvhit.pt
                  ScreenToClient hLVgrid, lvhit.pt
                  Control Send Cb.Hndl, %ID_LISTVIEW, %LVM_SUBITEMHITTEST, 0, VarPtr(lvhit)
                  If lvhit.iItem < 0 Then Function = 0 : Exit Function              'skip header
                  ListView Get Text Cb.Hndl, %ID_LISTVIEW, lvhit.iItem+1, lvhit.isubItem+1 To zText
                  zText = zText + $Cr + "plus some user text ..." 
                  ti.cbSize    = SizeOf(ti)
                  ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
                  ti.hWnd      = Cb.Hndl
                  ti.uId       = hLVgrid
                  ti.lpszText  = VarPtr(ztext)
                  SendMessage hToolTip1, %TTM_UPDATETIPTEXT, 0, VarPtr(ti)
                  Function = 1
                  Exit Function

               'Case %LVN_GETINFOTIP      'only valid for first column, not used here       
               '   pTt = Cb.Lparam
               '   ListView_GetItemText hLVgrid, @pTt.iItem, 0, zText, SizeOf(zText)
               '   zText = "Tip:  Row = " + Str$(@pTt.iItem) + ", Col = " + Str$(@pTt.iSubitem) + _
               '           $Cr + "Text:  " + zText
               '   @pTt.cchTextMax = SizeOf(zText)
               '   @pTt.pszText = VarPtr(zText)
               '   Function = 1
               '   Exit Function
                  
            End Select
         End If

      Case %WM_COMMAND
         Select Case Cb.Ctl
            Case %ID_EXIT, %IDCANCEL
               If Cb.CtlMsg = %BN_CLICKED Then
                  If MsgBox("Abort the process?", %MB_YESNO Or %MB_ICONQUESTION Or %MB_TASKMODAL, _
                            "Abort?") = %IDYES Then Dialog End Cb.Hndl, 0
               End If
            Case %ID_ONE      ' ...
            Case %ID_TWO      ' ...
            Case %ID_CBOX     ' ...
         End Select

      Case %WM_NCACTIVATE
         Static hWndSaveFocus As Dword
         If IsFalse Cb.WParam Then
            hWndSaveFocus = GetFocus()
         ElseIf hWndSaveFocus Then
            SetFocus(hWndSaveFocus)
            hWndSaveFocus = 0
         End If

      Case %WM_SYSCOMMAND
         If Cb.WParam = %SC_CLOSE Then
            If MsgBox("Are you sure you want to quit the application?", _
                      %MB_YESNO Or %MB_DEFBUTTON2 Or %MB_SYSTEMMODAL) = %IDNO Then
               Function = 1 : Exit Function
            End If
         End If

      Case %WM_DESTROY
         If OldLVProc Then SetWindowLong(GetDlgItem(Cb.Hndl, %ID_LISTVIEW), %GWL_WNDPROC, OldLVProc)
         ToolTip2UnHook hLVheader

   End Select
End Function

' ListView callback procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function LVProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Static Col As Long                                         ' Selected column
   Static Row As Long                                         ' Selected row
   Local c As Long                                            ' Number of rows per page
   Local LVHT As LVHITTESTINFO                                ' Contains information about a mouse clik on the ListView

   Select Case As Long wMsg

      Case %WM_LBUTTONDOWN
         lvht.pt.x = Lo(Word, lparam)                         ' X coordinate of mouse left button down
         lvht.pt.y = Hi(Word, lparam)                         ' Y coordinate of mouse left button down

         ' Find the listview item and subitem at these X, Y coordinates
         SendMessage(hwnd, %LVM_SUBITEMHITTEST, ByVal 0, ByVal VarPtr(LVHT))

         ' Did we find a listview item at these coordinates?
         If lVHT.iItem <> -1 Then
            ' Update the ListView with the new selection
            UpdateLVSelect(GetParent(hWnd), Row, Col, lVHT.iItem + 1, LVHT.iSubItem + 1)
         End If

         ' We handled this message, so we need to return a zero
         ' and not call the the original listview callback.
         Function = 0
         Exit Function

      Case %WM_KEYDOWN
         Select Case As Long wParam

            Case %VK_UP
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row - 1, Col)

            Case %VK_DOWN
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row + 1, Col)

            Case %VK_RIGHT
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row, Col + 1)

            Case %VK_LEFT
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row, Col - 1)

            Case %VK_PGUP
               ' Get the number of rows per page in the ListView
               c = SendMessage(hWnd, %LVM_GETCOUNTPERPAGE, 0, 0)
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row - c, Col)

            Case %VK_PGDN
               ' Get the number of rows per page in the ListView
               c = SendMessage(hWnd, %LVM_GETCOUNTPERPAGE, 0, 0)
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, Row + c, Col)

            Case %VK_HOME
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, 1, 1)

            Case %VK_END
               ' Update the ListView with the new selection
               UpdateLVSelect(GetParent(hWnd), Row, Col, %LVROWS, 1)

         End Select

         ' We handled this message, so we need to return a zero
         ' and not call the the original listview callback.
         Function = 0
         Exit Function

   End Select

   ' if we did not handle this message, pass the message on to the
   ' original callback for the listview control.
   Function = CallWindowProc(OldLVProc, hWnd, wMsg, wParam, lParam)
End Function

' Unselect the previous listview selection, select the new item and then ensure the new
' item is visible.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub UpdateLVSelect(ByVal hDlg As Long, ByRef Row As Long, ByRef Col As Long, ByVal NewRow As Long, ByVal NewCol As Long)

   ' Make sure the new row is within range
   If NewRow < 1 Then
      NewRow = 1
   ElseIf NewRow > %LVROWS Then
      NewRow = %LVROWS
   End If

   ' Make sure the new column is within range
   If NewCol < 1 Then
      NewCol = 1
   ElseIf NewCol > %LVCOLS Then
      NewCol = %LVCOLS
   End If

   ' If the previous and new selection are the same then do nothing
   If (Row = NewRow) And (Col = NewCol) Then Exit Sub

   ' Unselect the previous selection, required when seleting subitems
   ' even if the ListView contains the %LVS_SINGLESEL style
   ListView Unselect hDlg, %ID_LISTVIEW, Row, Col

   ' Update the Row and Column variables
   Row = NewRow
   Col = NewCol

   ' Select the new ListView item
   ListView Select hDlg, %ID_LISTVIEW, Row, Col

   ' Ensure the new ListView item is visible
   ListView Visible hDlg, %ID_LISTVIEW, Row
End Sub


'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function WindowProc(ByVal hWnd As Dword, ByVal wMsg As Long, ByVal wParam As Dword, ByVal lParam As Long) As Long
   Local hti   As HD_HITTESTINFO
   Local zText As Asciiz * 256

   Select Case wMsg
      Case %WM_MOUSEMOVE
         GetCursorPos hti.pt                                   'get mouse coordinates on screen
         MapWindowPoints 0, hLVheader, hti.pt, 1                'map them to header
         SendMessage hLVheader, %HDM_HITTEST, 0, VarPtr(hti)    'see what column we are over
         If hti.iItem <> mCurHdrItem Then
            mCurHdrItem = hti.iItem
            DelToolTip2 hWnd
            If mCurHdrItem <> -1 Then                          '-1 is over listview itself.
               zText = GetToolTipText(hti.iItem)
               SetToolTip2 hWnd, zText
            End If
         End If
   End Select
   Function = CallWindowProc(mPrevWndProc, hWnd, wMsg, wParam, lParam)
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function GetToolTipText(ByVal Id As Long) As String
   Select Case As Long Id
      Case 0  :  Function = " This is the first column"
      Case 1  :  Function = " This is the second column" + $Cr + _
                            " that follows the first column"
      Case 2  :  Function = " This is the third column" + $Cr + _
                            " that follows the second column"  + $Cr + _
                            " and first column too"
   End Select
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip1(hWndTip As Dword, id As Long, Byval txt As String)  'for standard controls
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = GetParent(hWndTip)
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = GetDlgItem(hLocalWnd, id)
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip1, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub SetToolTip2(hWnd As Dword, Byval txt As String)        'for ListView headers
   Local hLocalWnd    As Dword
   Local zToolTipText As Asciiz * 256
   Local ti           As TOOLINFO

   zToolTipText = txt
   hLocalWnd    = hWnd
   ti.cbSize    = SizeOf(ti)
   ti.uFlags    = %TTF_SUBCLASS Or %TTF_IDISHWND
   ti.hWnd      = hLocalWnd
   ti.uId       = hLocalWnd
   ti.lpszText  = VarPtr(zToolTipText)
   SendMessage hToolTip2, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DelToolTip2(hWnd As Dword)                             'for ListView headers
   Local ti     As TOOLINFO

   ti.cbSize    = SizeOf(ti)
   ti.hWnd      = hWnd
   While SendMessage(hToolTip2, %TTM_ENUMTOOLS, 0, VarPtr(ti))
      SendMessage hToolTip2, %TTM_DELTOOL, 0, VarPtr(ti)
   Wend
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'eof

Code is also zipped here

[Bob Clarke]

beautifully done!

Nothing exites PB users as much as saying "it can't be done"

[Andrea Mariani]

It works much better (and does not interfere with my background highlighting) if the %WM_NOTIFY is done like so:

      CASE %WM_NOTIFY
         LOCAL lvhit AS LVHITTESTINFO
         LOCAL ti    AS TOOLINFO

             SELECT CASE CB.NMID

                CASE %ID_LISTVIEW

                    SELECT CASE CB.NMCODE
                        CASE %lvn_hottrack
                              GetCursorPos lvhit.pt
                              ScreenToClient hLVgrid, lvhit.pt
                              CONTROL SEND CB.HNDL, %ID_LISTVIEW, %LVM_SUBITEMHITTEST, 0, VARPTR(lvhit)
                              IF lvhit.iItem < 0 THEN FUNCTION = 0 : EXIT FUNCTION              'skip header
                              LISTVIEW GET TEXT CB.HNDL, %ID_LISTVIEW, lvhit.iItem+1, lvhit.isubItem+1 TO zText
                              zText = zText + $CR + "plus some user text ..."
                              ti.cbSize    = SIZEOF(ti)
                              ti.uFlags    = %TTF_SUBCLASS OR %TTF_IDISHWND
                              ti.hWnd      = CB.HNDL
                              ti.uId       = hLVgrid
                              ti.lpszText  = VARPTR(ztext)
                              SendMessage hToolTip1, %TTM_UPDATETIPTEXT, 0, VARPTR(ti)
                              FUNCTION = 1

                    END SELECT

             END SELECT