PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Another one - why the tooltip icon is that large?

https://www.purebasic.fr/english/viewtopic.php?t=74165

Page 1 of 2

Another one - why the tooltip icon is that large?

Posted: Thu Dec 05, 2019 7:18 pm
by Michael Vogel
Can anyone shrink the icon to a smaller size?

Code: Select all

Global Dim ToolTipHandle(1)
Procedure.l GadgetToolTipText_(Win,ID,Title.s,Tip.s,IconType)

	Protected ToolInfo.TOOLINFO

	If Len(Tip)=0
		Tip="(nicht definiert)"
	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

	Debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
	Debug Str(Win)+" / "+Str(ID)+", "+Str(IconType)
	Debug Title+" / "+Tip
	Debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"

	SendMessage_(ToolTipHandle(ID),#TTM_SETTITLE, LoadIcon_(#Null,IconType),@Title)
	SendMessage_(ToolTipHandle(ID),#TTM_UPDATETIPTEXT,0,@ToolInfo)
	;SendMessage_(ToolTipHandle(ID),#TTM_UPDATE,0,@ToolInfo)

EndProcedure
Procedure.l GadgetToolTipInit_(Win,ID,Style,Center)

	; 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-Bug (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)

	;If FgColor
	;	SendMessage_(ToolTipID,#TTM_SETTIPTEXTCOLOR,FgColor,0);	Set the tip text color, also the tip outline color for balloon tooltips
	;EndIf
	;If BgColor
	;	SendMessage_(ToolTipID,#TTM_SETTIPBKCOLOR,BgColor,0);	Set the tip background color
	;EndIf

	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

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

	ProcedureReturn ToolTipID

EndProcedure

OpenWindow(0,0,0,400,400,"*")
ButtonGadget(1,50,50,200,100,"HA")

GadgetToolTipInit_(0,1,0,0)

GadgetToolTipText_(0,1,"Ooohh","What a large icon :(",#IDI_WARNING);
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

Re: Another one - why the tooltip icon is that large?

Posted: Thu Dec 05, 2019 10:14 pm
by BarryG
Michael Vogel wrote:Can anyone shrink the icon to a smaller size?
I used Inf0Byt3's icon resize code from here: viewtopic.php?f=12&t=52966

And resized it to 16x16 like below. Don't forget you can always use your own smaller icons as an alternative, too.

Code: Select all

Procedure.i ResizeIcon(hIcon.i, Width.l, Height.l, Depth.l=32)
  Protected IInfo.ICONINFO, ColorImg.i, MaskImg.i, DC.i, RethIcon.i, ICONINFO.ICONINFO
  If hIcon <> 0
    ;Get icon data
    If GetIconInfo_(hIcon, @IInfo)
      Select Depth
        Case 24
          ColorImg = CreateImage(#PB_Any, Width, Height, 24)
        Default
          ColorImg = CreateImage(#PB_Any, Width, Height, 32)
      EndSelect
      If IsImage(ColorImg) <> 0
        ;Draw color image
        DC = StartDrawing(ImageOutput(ColorImg))
        If DC <> 0
          DrawIconEx_(DC,0,0,hIcon,Width,Height,0,0,#DI_IMAGE)
          StopDrawing()
        EndIf
      EndIf
      MaskImg = CreateImage(#PB_Any, Width, Height) ;Depth is 24 by default
      If IsImage(MaskImg) <> 0
        ;Draw mask
        DC = StartDrawing(ImageOutput(MaskImg))
        If DC <> 0
          DrawIconEx_(DC,0,0,hIcon,Width,Height,0,0,#DI_MASK)
          StopDrawing()
        EndIf
      EndIf
      ;Create new icon
      ICONINFO\fIcon = 1
      ICONINFO\hbmMask = ImageID(MaskImg)
      ICONINFO\hbmColor = ImageID(ColorImg)
      RethIcon = CreateIconIndirect_(@ICONINFO)
      ;And free the resources
      If IsImage(ColorImg)
        FreeImage(ColorImg)
      EndIf
      If IsImage(MaskImg)
        FreeImage(MaskImg)
      EndIf
      DeleteObject_(IInfo\hbmColor)
      DeleteObject_(IInfo\hbmMask)
    EndIf
  EndIf
  ProcedureReturn RethIcon
EndProcedure

Global Dim ToolTipHandle(1)
Procedure.l GadgetToolTipText_(Win,ID,Title.s,Tip.s,IconType)

   Protected ToolInfo.TOOLINFO

   If Len(Tip)=0
      Tip="(nicht definiert)"
   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

   Debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
   Debug Str(Win)+" / "+Str(ID)+", "+Str(IconType)
   Debug Title+" / "+Tip
   Debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"

   icon=ResizeIcon(LoadIcon_(#Null,IconType),16,16,32)
   SendMessage_(ToolTipHandle(ID),#TTM_SETTITLE, icon,@Title)
   SendMessage_(ToolTipHandle(ID),#TTM_UPDATETIPTEXT,0,@ToolInfo)
   ;SendMessage_(ToolTipHandle(ID),#TTM_UPDATE,0,@ToolInfo)

EndProcedure
Procedure.l GadgetToolTipInit_(Win,ID,Style,Center)

   ; 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-Bug (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)

   ;If FgColor
   ;   SendMessage_(ToolTipID,#TTM_SETTIPTEXTCOLOR,FgColor,0);   Set the tip text color, also the tip outline color for balloon tooltips
   ;EndIf
   ;If BgColor
   ;   SendMessage_(ToolTipID,#TTM_SETTIPBKCOLOR,BgColor,0);   Set the tip background color
   ;EndIf

   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

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

   ProcedureReturn ToolTipID

EndProcedure

OpenWindow(0,0,0,400,400,"*")
ButtonGadget(1,50,50,200,100,"HA")

GadgetToolTipInit_(0,1,0,0)

GadgetToolTipText_(0,1,"Ooohh","What a large icon :(",#IDI_WARNING);
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

Re: Another one - why the tooltip icon is that large?

Posted: Thu Dec 05, 2019 10:25 pm
by RASHAD
Hi BarryG
That is too much code to shrink the Icon

Code: Select all

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

Re: Another one - why the tooltip icon is that large?

Posted: Thu Dec 05, 2019 11:53 pm
by Michael Vogel
Perfect - as usual.
Thanks.

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 2:08 am
by IdeasVacuum
Nice one Rashad! :mrgreen:

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 3:15 am
by IdeasVacuum
... by the way, I have never seen front and back colours working?

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 9:06 am
by BarryG
RASHAD wrote:That is too much code to shrink the Icon
Thanks for the single line, Rashad. I've been trying to adapt it for resizing non-icon images into a small icon, and can't. This fails:

Code: Select all

UsePNGImageDecoder()
big=LoadImage(0,"c:\picture.png")
small=CopyImage_(ImageID(0),#IMAGE_ICON,16,16,#LR_COPYDELETEORG)
Debug small ; Returns 0

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 9:23 am
by RASHAD
Hi BarryG
You can not do that Bitmap is totally different from Icon

Code: Select all

UsePNGImageDecoder()
LoadImage(0,"c:\picture.png")

small=CopyImage_(ImageID(0),#IMAGE_BITMAP,16,16,#LR_COPYDELETEORG)

iinf.ICONINFO
iinf\fIcon = 1
iinf\hbmMask = small
iinf\hbmColor = small

icoHnd = CreateIconIndirect_(iinf)

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 10:10 am
by BarryG
Thanks again, Rashad. It even supports transparent PNG images - cool!

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 3:51 pm
by fryquez
IdeasVacuum wrote:... by the way, I have never seen front and back colours working?
You need to disable theming for the tooltip window:

Code: Select all

SetWindowTheme_(ToolTipID, "", "")

Re: Another one - why the tooltip icon is that large?

Posted: Fri Dec 06, 2019 5:10 pm
by IdeasVacuum
Thanks fryquez, that's a great tip for tooltips :mrgreen:

Re: Another one - why the tooltip icon is that large?

Posted: Sat Dec 07, 2019 12:41 am
by IdeasVacuum
With this example code, we must have a ToolTipInit for every Tooltip.

Is there a specific reason why the two Procedures should not be one Procedure?

Re: Another one - why the tooltip icon is that large?

Posted: Sat Dec 07, 2019 1:22 am
by IdeasVacuum
.... I think the answer to my question is that the tip text buffer is unstable, but that seems to be fixed by ensuring the Tip Text is post-fixed with a newline (#CRLF$)

Re: Another one - why the tooltip icon is that large?

Posted: Sat Dec 07, 2019 1:42 am
by BarryG
IdeasVacuum wrote:Is there a specific reason why the two Procedures should not be one Procedure?
Do you mean for my example? The answer's easy: Michael wanted a smaller icon, so I just linked to some code that show hows to resize an icon. Then I just posted both procedures (the resize icon code, and Michael's original tooltip code) to show how it can be done. It's then up to the user to choose to merge them into one procedure if they wish.

But merging Rashad's single line into Michael's tooltip procedure would obviously be the superior solution.

Re: Another one - why the tooltip icon is that large?

Posted: Sat Dec 07, 2019 2:10 am
by IdeasVacuum
Hi BarryG - um no, I meant the original code posted by Michael. I have merged them into one Procedure and chopped-down to my requirements - balloon style, no icon, no title, no centre stem. I'm testing using the title for the tip text to get bold font.
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited