Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

ToolTips and ListView

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin ToolTips and ListView

    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.

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    '  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.
    Attached Files

  • #2
    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.
    slowbob

    Comment


    • #3
      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.

      Code:
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      '  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
      Attached Files

      Comment


      • #4
        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.
        Attached Files
        slowbob

        Comment


        • #5
          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

          Comment


          • #6
            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.
            slowbob

            Comment


            • #7
              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.

              Code:
              '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
              '  Different kinds of ToolTips on a ListView control.      
              '  (found four 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
              Attached Files

              Comment


              • #8
                beautifully done!

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

                Comment


                • #9
                  It works much better (and does not interfere with my background highlighting) if the %WM_NOTIFY is done like so:
                  Code:
                        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
                  Andrea Mariani
                  AS/400 expert
                  Basic programmer @ Home

                  Comment

                  Working...
                  X