[Windows] Multiline-Tooltip with auto-wordwrap and/or #CRLF

[inSANE]

Hello there,

attached please find a little Proc to create multilined ToolTips (not Balloon-Tooltips) for Windows-OS (which is supported by PB natively on Linux and OSX):

Code: Select all

Procedure GadgetToolTipML(hwndParent, Text.s, Width = 0)
	
	If IsGadget(hwndParent) And Not IsWindow_(hwndParent)  ; Allow, to enter either the PB-#Gadget or a Window-/Gadget-ID
		hwndParent = GadgetID(hwndParent)
	EndIf
	
	Protected hwndTT = CreateWindowEx_(#WS_EX_TOPMOST, #TOOLTIPS_CLASS, #Null, #WS_POPUP | #TTS_NOPREFIX | #TTS_ALWAYSTIP, #CW_USEDEFAULT, #CW_USEDEFAULT, #CW_USEDEFAULT, #CW_USEDEFAULT, hwndParent , #Null, GetModuleHandle_(0), #Null)
	
	SetWindowPos_(hwndTT, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_NOACTIVATE)
	
	Protected ti.TOOLINFO
	
	ti\cbSize   = SizeOf(TOOLINFO);
	ti\uFlags   = #TTF_SUBCLASS;
	ti\hwnd     = hwndParent;
	ti\hinst    = #Null
	ti\lpszText = @Text
	GetClientRect_(hwndParent, @ti\rect);
	
	SendMessage_(hwndTT, #TTM_ADDTOOL, 0, @ti)
	
	If Width
		SendMessage_(hwndTT, #TTM_SETMAXTIPWIDTH, 0, Width)
	ElseIf FindString(Text, #CRLF$, 1)
		SendMessage_(hwndTT, #TTM_SETMAXTIPWIDTH, 0, 9999)
	EndIf
	
EndProcedure

Text.s = "The quick brown fox jumps over the lazy dog. Ein Neger mit Gazelle zagt im Regen nie."
CRText.s = "The quick brown fox jumps" + #CRLF$ + "over the lazy dog." + #CRLF$ + "Ein Neger" + #CRLF$ + "mit Gazelle zagt im Regen nie."

If OpenWindow(0,0,0,300,125,"MultiLine ToolTips", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	
	ButtonGadget(0,10,15,280,20,"Long single lined ToolTip")
	ButtonGadget(1,10,40,280,20,"Long auto-wordwrap ToolTip")
	ButtonGadget(2,10,65,280,20,"Short auto-wordwrap ToolTip")
	ButtonGadget(3,10,90,280,20,"ToolTip with #CRLF wordwrap")
	
	GadgetToolTipML(WindowID(0), "I'm a Window, and I'm proud to have my own TooltTip.   :-)",100)
	
	GadgetToolTipML(GadgetID(0), Text)     ; You can either use a WindowID() / GadgetID()
	GadgetToolTipML(1, Text, 300)          ; or the PB-#Gadget as first Parameter.
	GadgetToolTipML(2, Text, 100)
	GadgetToolTipML(3, CRText)
	
	Repeat
		Event = WaitWindowEvent()
	Until Event = #PB_Event_CloseWindow
EndIf

Tested with Win7-64Bit, PB-x86/x64

Maybe someone will have some use for it.

[rsts]

Nice useful first post. Thanks for sharing.

cheers

[inSANE]

Nice useful first post. Thanks for sharing.

Your welcome.

[Kwai chang caine]

Works well on XP PRO
Thanks inSANE for sharing

[Andre]

Thank you, could become very useful for me.

[Blue]

I noticed that if you try to update the tooltip with a another text, both texts appear one after the other.
If you want this NOT to happen, just add DestroyWindow_(hToolTip) at the beginning of the procedure and set hToolTip as a global variable :

Code: Select all

Global hToolTip
Procedure AddTooltip(windowID, Gadget, Tooltext$, maxW)
  ;--> Remove the #TTS_BALLOON flag in the next line if you want the rectangular Tooltip
  DestroyWindow_(hToolTip)
  hToolTip = CreateWindowEx_(0, "ToolTips_Class32", "", #TTS_NOPREFIX | #TTS_BALLOON, 0, 0, 0, 0, 0, 0, GetModuleHandle_(0), 0)
  SendMessage_(hToolTip, #TTM_SETTIPTEXTCOLOR, GetSysColor_(#COLOR_INFOTEXT), 0)
  SendMessage_(hToolTip, #TTM_SETTIPBKCOLOR, GetSysColor_(#COLOR_INFOBK), 0)
  tti.TOOLINFO\cbSize = SizeOf(TOOLINFO)
  tti\uFlags = #TTF_SUBCLASS | #TTF_IDISHWND
  ;--> Here's where the multiline comes into play by setting the maxWidth
  SendMessage_(hToolTip, #TTM_SETMAXTIPWIDTH, 0, maxW)
  tti\hWnd = GadgetID(Gadget)
  tti\uId = GadgetID(Gadget)
  tti\hinst = 0
  tti\lpszText = @Tooltext$
  
  SendMessage_(hToolTip, #TTM_ADDTOOL, 0, tti)
  
  SendMessage_(hToolTip, #TTM_SETDELAYTIME, #TTDT_AUTOPOP, 15000)
  SendMessage_(hToolTip, #TTM_UPDATE , 0, 0)
EndProcedure 

Nice compact code, amine_purebasic.
Very practical, because easy to follow !
Thank you.

But making hToolTip global means that if you have 4 buttons, as in the example provided by the original poster, only the last button will have a tooltip !

To add flexibility to your procedure, i added a default parameter at the end of your parameter list, to select balloon or square type as in :
Procedure AddTooltip(windowID, Gadget, Tooltext$, maxW,balloon=0)
In the body of the procedure, an IF..ELSE..ENDIF block allows selection of one type or the other.
That makes it just perfect.

[Thunder93]

I think inSANE, the original poster had giving it some thought. You could also do a Window, however I'm not seeing the point yet. Good idea to make it work regardless if it's PB-Gadget or GadgetID used and work with it.

amine_purebasic approach to having hToolTip global and being able to destroy every-time wasn't good as already pointed out by Blue.

Following is my approach, using combined ideas.

Regarding updating gadget ToolTip, many ways to go about things. However I whipped up little something to support such actions.

Code: Select all

Global NewMap hToolTips.l()

Procedure AddGadgetToolTip(GadgetID.l, ToolText$, MaxWidth.l = 0, Balloon.l = 1, WindowID.l = -1)
  Protected cWndFlags.l = #TTS_NOPREFIX | #TTS_BALLOON
  
  If WindowID = -1 And IsGadget(GadgetID) ; Allow, to enter either the PB-#Gadget or a Gadget-ID
    GadgetID = GadgetID(GadgetID)
    
    If hToolTips(Str(GadgetID)) <> 0 : DestroyWindow_(hToolTips(Str(GadgetID))) : EndIf
    
  ElseIf WindowID > -1 And IsWindow(WindowID)
    WindowID = WindowID(WindowID)
  EndIf
  
  ;--> Remove the #TTS_BALLOON flag if you want the rectangular Tooltip, according to Balloon variable.
  If Balloon = 0 : cWndFlags = #TTS_NOPREFIX : EndIf
    
  hToolTip = CreateWindowEx_(0, "ToolTips_Class32", "", cWndFlags, 0, 0, 0, 0, 0, 0, GetModuleHandle_(0), 0)
  
  hToolTips(Str(GadgetID)) = hToolTip
  
  SendMessage_(hToolTip, #TTM_SETTIPTEXTCOLOR, GetSysColor_(#COLOR_INFOTEXT), 0)
  SendMessage_(hToolTip, #TTM_SETTIPBKCOLOR, GetSysColor_(#COLOR_INFOBK), 0)
  tti.TOOLINFO\cbSize = SizeOf(TOOLINFO)
  tti\uFlags = #TTF_SUBCLASS | #TTF_IDISHWND
  ;--> Here's where the multiline comes into play by setting the maxWidth
  SendMessage_(hToolTip, #TTM_SETMAXTIPWIDTH, 0, MaxWidth)
  
  tti\hWnd = GadgetID
  tti\uId = GadgetID  
  tti\hinst = 0
  tti\lpszText = @Tooltext$
  
  If WindowID <> -1
    tti\hWnd = WindowID
    tti\uFlags = #TTF_SUBCLASS  
    GetClientRect_(WindowID, @tti\rect)
  EndIf  
   
  SendMessage_(hToolTip, #TTM_ADDTOOL, 0, tti)
  
  SendMessage_(hToolTip, #TTM_SETDELAYTIME, #TTDT_AUTOPOP, 15000)
  SendMessage_(hToolTip, #TTM_UPDATE , 0, 0)
EndProcedure

Text.s = "The quick brown fox jumps over the lazy dog. Ein Neger mit Gazelle zagt im Regen nie."
Text1.s = "Removed ToolTip Balloon style popup."
CRText.s = "The quick brown fox jumps" + #CRLF$ + "over the lazy dog." + #CRLF$ + "Ein Neger" + #CRLF$ + "mit Gazelle zagt im Regen nie."

If OpenWindow(0,0,0,300,145,"MultiLine ToolTips", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  ButtonGadget(0,10,15,280,20,"Long single lined ToolTip")
  ButtonGadget(1,10,40,280,20,"Long auto-wordwrap ToolTip")
  ButtonGadget(2,10,65,280,20,"Short auto-wordwrap ToolTip")
  ButtonGadget(3,10,90,280,20,"ToolTip with #CRLF wordwrap")
  ButtonGadget(4,10,115,280,20,"ToolTip w/Balloon style popup removed.")
  
  AddGadgetToolTip(-1, "I'm a Window, and I'm proud To have my own TooltTip.   :-)", 0, 1, 0)
  
  AddGadgetToolTip(GadgetID(0), Text)
  AddGadgetToolTip(1, Text, 300)
  AddGadgetToolTip(2, Text, 100)
  AddGadgetToolTip(3, CRText, 300)
  AddGadgetToolTip(4, Text1, 400, 0)
  ;AddGadgetToolTip(4, "Cooly", 400) ; Updating Gadget ToolTip text.
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf