Another one - why the tooltip icon is that large?

[BarryG]

meant the original code posted by Michael

Oh, haha, I didn't even notice it was two procedures. I just copied and pasted it without really reading it.

[IdeasVacuum]

To make the tip text look a lot nicer, we can set the font!

Code: Select all

LoadFont(#Font10B, "Arial Unicode MS Regular", 10, #PB_Font_HighQuality | #PB_Font_Bold)
SendMessage_(iToolTipID, #WM_SETFONT, FontID(#FONT10B), #True)

[Michael Vogel]

I like this thread

Tried to summarize all functions into one code (still in two procedures, sorry) - just to have all parts to play around with:

Code: Select all

; Define

	EnableExplicit
	Global Dim ToolTipHandle(1)
	
	; Icon from DataSection (icon format):
	; DataSection // IconA: // IncludeBinary "Data\IconA.ico" // IconB: // IncludeBinary "Data\IconB.ico" // ... // EndDataSection
	; Enumeration #IconA // #IconB // ... // EndEnumeration
	; Global Dim IconTable(2) // IconTable(#IconA)=?IconA // ...

	; Custom made Icon from PNG image:
	;UsePNGImageDecoder()
	;LoadImage(0,"c:\picture.png")
	
; EndDefine

Procedure.l GadgetToolTipText_(Win,ID,Title.s,Tip.s,IconType)

	Protected ToolInfo.TOOLINFO

	; If Len(Tip)=0 : Tip="(no Information)" : EndIf

	; Windows 8: runde Ecken bei "einzeiligen" Tips, allerdings bleibt das Verhalten völlig undurchschaubar...
	;If FindString(Tip,#CRLF$)=#Null
	;   Tip=" "+#CRLF$+Tip
	;EndIf

	ToolInfo\cbSize=SizeOf(TOOLINFO)
	ToolInfo\hwnd=WindowID(Win)
	ToolInfo\uId=GadgetID(ID)
	ToolInfo\lpszText=@Tip

	; ~~~ Icon and Title text ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	; Default icon size:
	; SendMessage_(ToolTipHandle(ID),#TTM_SETTITLE, LoadIcon_(#Null,IconType),@Title)

	; Resize Icon:
	SendMessage_(ToolTipHandle(ID),#TTM_SETTITLE, CopyImage_(LoadIcon_(#Null,IconType),#IMAGE_ICON,16,16,#LR_COPYDELETEORG),@Title)

	; Icon from DataSection (needs code from define section above):
	; SendMessage_(ToolTipHandle(ID),#TTM_SETTITLE,CatchImage(#IconTooltip,IconTable(IconType)),@Title)

	; Custom made Icon from PNG image (needs code from define section above):
	; small=CopyImage_(ImageID(0),#IMAGE_BITMAP,16,16,#LR_COPYDELETEORG)
	; iinf.ICONINFO
	; iinf\fIcon = 1
	; iinf\hbmMask = small
	; iinf\hbmColor = small
	; icoHnd = CreateIconIndirect_(iinf)

	; ~~~ Update Tooltip ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	SendMessage_(ToolTipHandle(ID),#TTM_UPDATETIPTEXT,0,@ToolInfo)
	;SendMessage_(ToolTipHandle(ID),#TTM_UPDATE,0,@ToolInfo)

EndProcedure
Procedure.l GadgetToolTipInit_(Win,ID,Style,Center,Color=0,FontType=0)

	; Adds a tooltip to a Gadget (Id)
	; Style:      0= ordinary, 1= balloon
	; Center:   1= center the stem
	; Icon:      0= No icon, 1= Info, 2= Warn, 3= Error (#TOOLTIP_ constants)
	; Colors:   RGB() or GetSysColor_(#COLOR_ constants)

	; Wegen Windows-Bugs (Tooltip verschwindet nach Timeout auf ewig) nun global...
	Protected ToolTipID
	Protected ToolInfo.TOOLINFO

	ToolTipID=CreateWindowEx_(0,"Tooltips_Class32","",#TTS_NOPREFIX|#TTS_BALLOON*Style,0,0,0,0,0,0,0,0)

	; ~~~ Tooltip Colors ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	If Color
		SetWindowTheme_(ToolTipID,"","")
		SendMessage_(ToolTipID,#TTM_SETTIPBKCOLOR,Color,0);   Set the tip background color
		;If TextColor
		;   SendMessage_(ToolTipID,#TTM_SETTIPTEXTCOLOR,TextColor,0);   Set the tip text color, also the tip outline color for balloon tooltips
		;EndIf
	EndIf

	; ~~~ Initialize Tooltip ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	ToolInfo\cbSize=SizeOf(TOOLINFO)
	ToolInfo\uFlags=#TTF_IDISHWND|#TTF_SUBCLASS|(#TTF_CENTERTIP*Center)
	ToolInfo\hWnd=WindowID(Win)
	ToolInfo\uId=GadgetID(ID)
	ToolInfo\lpszText=@""

	SendMessage_(ToolTipID,#TTM_SETDELAYTIME,#TTDT_INITIAL,100)
	;SendMessage_(ToolTipID,#TTM_SETDELAYTIME,#TTDT_RESHOW,1000); ?????
	SendMessage_(ToolTipID,#TTM_SETDELAYTIME,#TTDT_AUTOPOP,30000)

	SendMessage_(ToolTipID,#TTM_ADDTOOL,0,ToolInfo);      Register tooltip with the control
	SendMessage_(ToolTipID,#TTM_SETMAXTIPWIDTH,0,250);   Set as a multiline tooltip with wordwrap
	SendMessage_(ToolTipID,#TTM_SETTITLE,0,@"");         Set the icon style and tip title (empty text = no tooltip)

	; ~~~ Title font ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	If FontType
		LoadFont(FontType,"Segoe UI",24,#PB_Font_HighQuality)
		SendMessage_(ToolTipID,#WM_SETFONT,FontID(FontType),#True)
	EndIf

	ToolTipHandle(ID)=ToolTipID
	;Debug "Init "+Str(ID)+" ("+Str(ToolTipID)+")"

	ProcedureReturn ToolTipID

EndProcedure

OpenWindow(0,0,0,400,320,"*",#PB_Window_ScreenCentered)
ButtonGadget(0,50,50,300,100,"A")
ButtonGadget(1,50,170,300,100,"B")
AddWindowTimer(0,0,1000)

GadgetToolTipInit_(0,0,0,0,#Yellow,1)
GadgetToolTipInit_(0,1,0,0,#Null,1)

Define text.s
Repeat
	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		End
	Case #PB_Event_Timer
		If 0
			text=FormatDate("%hh:%ii:%ss", Date())
		Else
			text=RSet("",Random(18)+1,">")
		EndIf
		GadgetToolTipText_(0,0,"Aaah",text,#IDI_WARNING);
		GadgetToolTipText_(0,1,"Oooh",text,#IDI_INFORMATION);
	EndSelect
ForEver

[IdeasVacuum]

Hit a problem!

A Tool Window over the Main Window - the Tool Window's balloon tips are displayed behind it

Does anyone know of a fix?

I have tried:

Code: Select all

SetWindowPos_(iToolTipID, #HWND_TOP, 0, 0, #Null, #Null, #SWP_NOSIZE | #SWP_NOACTIVATE)

Code: Select all

Procedure BlnToolTip(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", "", #TTS_NOPREFIX|#TTS_BALLOON, 0, 0, 0, 0, 0, 0, 0, 0)

               SetWindowTheme_(iToolTipID, "", "")
                  SendMessage_(iToolTipID, #WM_SETFONT, FontID(#FONT10B), #True)
                  SendMessage_(iToolTipID, #TTM_SETTIPTEXTCOLOR, iFrontColour, 0)  ;Set the tip text colour and balloon tip outline
                  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, 100)
                  SendMessage_(iToolTipID, #TTM_SETDELAYTIME, #TTDT_AUTOPOP, 30000)
                  SendMessage_(iToolTipID, #TTM_SETMAXTIPWIDTH, 0, 250)   ;Set as a multiline tooltip with wordwrap
                  SendMessage_(iToolTipID, #TTM_ADDTOOL, 0, ToolInfo)     ;Register tooltip with the control
                 SetWindowPos_(iToolTipID, #HWND_TOP, 0, 0, #Null, #Null, #SWP_NOSIZE | #SWP_NOACTIVATE)
EndProcedure

[RASHAD]

Hi IdeasVacuum
Try

Code: Select all

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

[IdeasVacuum]

Hi Rashad - that worked a treat

[IdeasVacuum]

Hit another issue If the User changes the program's language, my code uses the Procedure I posted to update the Tool Tip Balloon text. To my surprise, the original tip is not overwritten - instead, another Balloon is added.

I see where my error is - for each gadget, a new WindowEx is created. So I'm going to record the ID and try using a separate Procedure to change the text.

[IdeasVacuum]

... so, here we go:

Code: Select all

Procedure BlnToolTip(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 text colour & ballon 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, 100)
                  SendMessage_(iToolTipID, #TTM_SETDELAYTIME, #TTDT_AUTOPOP, 30000)
                  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 BlnToolTipUpdate(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

[/size]