Tooltip for rows in list view?

[camille]

Hello!

I've found this code somewhere on the forum (and I slightly modified it e.g. to get the row under the mouse cursor):

Code: Select all

DisableExplicit

#MyWindow = 0
#MyGadget = 1


Import ""
  PB_Object_GetThreadMemory(*mem)
  PB_Gadget_Globals.i
EndImport


Procedure.s SetToolTipText(gadgetID, text.s)
  Protected.i win_info
  Protected ti.TOOLINFO

  win_info = PB_Object_GetThreadMemory(PB_Gadget_Globals)

  ti\cbSize   = SizeOf(TOOLINFO)
  ti\hWnd     = GetParent_(GadgetID(gadgetID))
  ti\uId      = GadgetID(gadgetID)
  ti\lpszText = @text

  SendMessage_(PeekI(win_info + 24), #TTM_UPDATETIPTEXT, 0, @ti)

  ProcedureReturn text
EndProcedure


If OpenWindow(#MyWindow, 100, 100, 500, 400, "ListIcon Example", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

  ListIconGadget(#MyGadget, 10, 10, 480, 360, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection)
  AddGadgetColumn(#MyGadget, 1, "Address", 250)
  AddGadgetItem(#MyGadget, -1, "Harry Rannit"   + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
  AddGadgetItem(#MyGadget, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
  AddGadgetItem(#MyGadget, -1, "Docter Sewdit"  + #LF$ + "101 PureBasic Road, SameTown, CodeCity")
  AddGadgetItem(#MyGadget, -1, "Harry Fainted"  + #LF$ + "86 PureBasic Road, FuzzyTown, CodeCity")
  GadgetToolTip(#MyGadget, "This is my tip")


  Define pLVH.LVHITTESTINFO
  Define pt.POINT
  Define rc.RECT

  lastRow = -1
  Repeat
    eventID = WindowEvent()

    GetCursorPos_(pt)
    GetWindowRect_(GadgetID(#MyGadget), rc)
    If PtInRect_(rc, pt\x + (pt\y) << 32)
      ; Convert x and y from coordinate space to window-relative space
      MapWindowPoints_(0, GadgetID(#MyGadget), pt, 1)

      ; Get row index of current cursor position
      pLVH\pt\y = pt\y
      SendMessage_(GadgetID(#MyGadget), #LVM_SUBITEMHITTEST, 0, pLVH)
      cursorRow = pLVH\iItem
      ;Debug "Row under cursor: " + Str(cursorRow)

      If lastRow <> cursorRow
        If cursorRow <> -1 ; The last (empty) line has -1
          s$ = GetGadgetItemText(#MyGadget, cursorRow, 1)
        Else
          s$ = ""
        EndIf
        SetToolTipText(#MyGadget, s$)

        lastRow = cursorRow
      EndIf
    EndIf

  Until eventID = #PB_Event_CloseWindow
EndIf

It works fine so far but I'd like to ask: Is it possible to get rid of the
Import ""
...
EndImport

and rewrite the SetToolTipText() to not depend on using win_info and the PeekI() command(s)?

I know there are a few other implementation of showing a tooltip for each row in a list view on the forum
but I like this one because it does what I need with a minimum of code (compared to the other solutions)...

[IdeasVacuum]

Hi

That code is just a demo of course - the tooltip displays the text in the related List Icon cell. Is that what you actually want in the tooltip?

[camille]

Hi,

the tooltip displays the text in the related List Icon cell. Is that what you actually want in the tooltip?

Cell / row, yes. The code does it for a specific cell (column = 1) but ofc it's easy to use a different cell (column) or all if necessary.

Why? Is there an implementation with even less code?

[IdeasVacuum]

... it just seems an odd requirement - the cell content can already be seen in the cell, so......

[IdeasVacuum]

In this example I use a Balloon tool tip, which requires a few more lines than a regular one. However, the code does not need an import and it's fairly easy to understand. Note that the ListIcon is the same size as the Window - if your LI is smaller than the Window, add the offset to WindowMouseX and WindowMouseY

Code: Select all

Enumeration
#MyWin
#MyListIcon
#Font10B
EndEnumeration

EnableExplicit

LoadFont(#Font10B, "Arial Unicode MS Regular", 10, #PB_Font_HighQuality | #PB_Font_Bold)

Procedure MyToolTip(iWin.i, iGadget.i, sTip.s)
;#--------------------------------------------
;Adds a balloon tooltip to a Gadget (iGadget)

Protected iToolTipID.i
Protected ToolInfo.TOOLINFO
Protected iFrontColour.i = RGB(008, 008, 008)
Protected  iBackColour.i = RGB(246, 249, 165)

iToolTipID = CreateWindowEx_(0, "ToolTips_Class32","",#WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON, 0, 0, 0, 0, GadgetID(iGadget), 0, GetModuleHandle_(0),0)

                 SetGadgetData(iGadget, iToolTipID)

               SetWindowTheme_(iToolTipID, "", "")
                  SendMessage_(iToolTipID, #WM_SETFONT, FontID(#FONT10B), #True)
                  SendMessage_(iToolTipID, #TTM_SETTIPTEXTCOLOR, iFrontColour, 0) ;Set the tip text/outline colour
                  SendMessage_(iToolTipID, #TTM_SETTIPBKCOLOR, iBackColour, 0) ;Set the tip background colour

                    ToolInfo\cbSize = SizeOf(TOOLINFO)
                    ToolInfo\uFlags = #TTF_IDISHWND|#TTF_SUBCLASS ;#TTF_CENTERTIP ;TTF_RTLREADING
                      ToolInfo\hWnd = WindowID(iWin)
                       ToolInfo\uId = GadgetID(iGadget)
                  ToolInfo\lpszText = @sTip

                  SendMessage_(iToolTipID, #TTM_SETDELAYTIME, #TTDT_INITIAL, 10)
                  SendMessage_(iToolTipID, #TTM_SETDELAYTIME, #TTDT_AUTOPOP, 1000)
                  SendMessage_(iToolTipID, #TTM_SETMAXTIPWIDTH, 0, 250)   ;Set as a multiline tooltip with wordwrap
                  SendMessage_(iToolTipID, #TTM_ADDTOOL, 0, ToolInfo)     ;Register tooltip with the control
EndProcedure

Procedure MyToolTipUpdate(iWin.i, iGadget.i, sNewTip.s)
;#-----------------------------------------------------
;Changes the text of an existing balloon tooltip
Protected iToolTipID.i = GetGadgetData(iGadget)
Protected   ToolInfo.TOOLINFO

                    ToolInfo\cbSize = SizeOf(TOOLINFO)
                    ToolInfo\uFlags = #TTF_IDISHWND|#TTF_SUBCLASS ;#TTF_CENTERTIP ;TTF_RTLREADING
                      ToolInfo\hWnd = WindowID(iWin)
                       ToolInfo\uId = GadgetID(iGadget)
                  ToolInfo\lpszText = @sNewTip

                  SendMessage_(iToolTipID, #TTM_ADDTOOL, 0, ToolInfo)
EndProcedure


Procedure CellTooltip()
;#---------------------
Protected pInfo.LVHITTESTINFO
Protected sCellText.s

               pInfo\pt\x = WindowMouseX(#MyWin)
               pInfo\pt\y = WindowMouseY(#MyWin)

                SendMessage_(GadgetID(#MyListIcon), #LVM_SUBITEMHITTEST, 0, pInfo)
                sCellText = GetGadgetItemText(#MyListIcon, pInfo\iItem, pInfo\iSubItem)

               If Not (sCellText = "Name") OR (sCellText = "Address") : MyToolTipUpdate(#MyWin, #MyListIcon, sCellText) : EndIf
EndProcedure

If OpenWindow(#MyWin, 100, 100, 500, 400, "ListIcon Example", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

          ListIconGadget(#MyListIcon, 0, 0, 500, 400, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection)
         AddGadgetColumn(#MyListIcon, 1, "Address", 250)
           AddGadgetItem(#MyListIcon, -1, "Harry Rannit"   + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
           AddGadgetItem(#MyListIcon, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
           AddGadgetItem(#MyListIcon, -1, "Docter Sewdit"  + #LF$ + "101 PureBasic Road, SameTown, CodeCity")
           AddGadgetItem(#MyListIcon, -1, "Harry Fainted"  + #LF$ + "86 PureBasic Road, FuzzyTown, CodeCity")

               MyToolTip(#MyWin, #MyListIcon, "MyTip")
EndIf

Repeat

         CellTooltip()

Until WaitWindowEvent() = #PB_Event_CloseWindow

[/size]