PureBasic Forums - English

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

Colored Balloon Tooltips with icons

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

Page 1 of 2

Colored Balloon Tooltips with icons

Posted: Sat Jan 21, 2006 3:11 pm
by utopiomania
Code updated for 5.20+

This is a procedure to add 'cartoon style' colored balloon (or ordinary) tooltips to gadgets. You can also specify an icon for it, and a title if you like.

Hope it can be of use to someone else too. :) I have a question though. When XP skin support is selected in compiler options, the tooltips doesn't
reappear if you allow them to timeout. Does anyone know how to prevent this ?

Code: Select all

;-Gadget Id's
;
Enumeration
  #Win
  #Btn1
  #Btn2
  #Btn3
  #Btn4
EndEnumeration

;-Declares
;
Declare ToolTip(Win, Id, Style, Center, Icon, FgColor, BgColor, Title.s, Tip.s)
Declare OpenMainWindow()

;-StartRun
;
OpenMainWindow()

;-Events
;
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

;-EndRun
;
End

;-Procedures
;
Procedure ToolTip(Win, Id, Style, Center, Icon , FgColor, BgColor, Title.s, Tip.s)
  ;Adds a tooltip to Id.  Style: 0 = ordinary, 1 = balloon. Center: 1 = center the stem
  ;Icon: 0 = No icon, 1 = Info, 2 = Warn, 3 = Error, (See #TOOLTIP_ constants)
  TT = CreateWindowEx_(0, "Tooltips_Class32", "", #TTS_BALLOON * Style, 0, 0, 0, 0, 0, 0, 0, 0)
  ;Color. RGB() or GetSysColor_(See #COLOR_ constants)
  If FgColor
    ;Set the tip text color, also the tip outline color for balloon tooltips
    SendMessage_(TT, #TTM_SETTIPTEXTCOLOR, FgColor, 0)
  EndIf
  If BgColor
    ;Set the tip background color
    SendMessage_(TT, #TTM_SETTIPBKCOLOR, BgColor, 0)
  EndIf
  TI.TOOLINFO\cbSize = SizeOf(TOOLINFO)
  TI\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS |  (#TTF_CENTERTIP * Center)
  TI\hWnd = WindowID(Win)
  TI\uId = GadgetID(Id)
  TI\lpszText = @Tip
  ;Register tooltip with the control
  SendMessage_(TT, #TTM_ADDTOOL, 0, TI)
  ;Set as a multiline tooltip with wordwrap
  SendMessage_(TT, #TTM_SETMAXTIPWIDTH, 0, 150)
  ;Set the icon style and tip title
  SendMessage_(TT, #TTM_SETTITLE, Icon, Title) 
EndProcedure

Procedure OpenMainWindow()
  If OpenWindow(0, 0, 0, 300, 300, "Tooltip Styles", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
    
    ButtonGadget(#Btn1, 110, 40, 80, 20, "Button1")
    ToolTip(#Win, #Btn1, 0, 0, 1, 0, 0, "", "This is a boring old Tooltip")
    
    ButtonGadget(#Btn2, 110,100, 80, 20, "Button2")
    ToolTip(#Win, #Btn2, 0, 1, 1, 0, RGB(226, 255, 255), "Title", "Not that boring old Tooltip")
    
    ButtonGadget(#Btn3, 110, 160, 80, 20, "Button3")
    ToolTip(#Win, #Btn3, 1, 0, 0, 0, RGB(226, 255, 255), "", "This is a multi line Tooltip This is a multi line Tooltip")
    
    ButtonGadget(#Btn4, 110, 220, 80, 20, "Button4")
    ToolTip(#Win, #Btn4, 1, 1, 1, RGB(57, 120, 63), RGB(226, 255, 255), "This is:", "A centered Tooltip")
  Else
    End
  EndIf
EndProcedure

Posted: Sat Jan 21, 2006 3:13 pm
by Dare2
hehe! Neat! :)

Posted: Sat Jan 21, 2006 3:17 pm
by josku_x
I think this is a bug.

When you go all buttons over with the mouse you'll get a tooltip with a different style. But when you go all the buttons again over with the mouse, only the tooltip of Button 3 shows up.

Posted: Sat Jan 21, 2006 10:31 pm
by utopiomania
@Josku_x, that's because the button3 tooltip didn't timeout by itself. If you don't let them timeout,
the tips reappear when you move around. It might be a default behaviour with XP skins enabled.

Posted: Sat Jan 21, 2006 11:36 pm
by Straker
Nice. Thanks for sharing. I took the liberty of updating your code to include window opacity/alpha for the balloon tips - code below. This requires an additional argument to your function which I added at the end, pOpacity ( from 0 - 100 ). For some reason it only works on balloon tips not the rectangle ones.

Code: Select all

;-Gadget Id's
;
Enumeration
  #Win
  #Btn1
  #Btn2
  #Btn3
  #Btn4
EndEnumeration

;-Declares
;
Declare ToolTip(Win, Id, style, Center, Icon, FgColor, BgColor, title.s, Tip.s, pOpacity.l)
Declare OpenMainWindow()

;-StartRun
;
OpenMainWindow()

;-Events
;
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

;-EndRun
;
End

;-Procedures
;
Procedure SetWindowAlpha(hwnd.l, Opacity.l)
  If #VER_PLATFORM_WIN32_NT 
    SetWindowLong_(hwnd, #GWL_EXSTYLE, $00080000)
    If OpenLibrary(1, "user32.dll")
      CallFunction(1, "SetLayeredWindowAttributes", hwnd, 0, Opacity, 2)
      CloseLibrary(1)
    EndIf
  EndIf
EndProcedure

Procedure ToolTip(Win, Id, style, Center, Icon , FgColor, BgColor, title.s, Tip.s, pOpacity.l)
  ;Adds a tooltip to Id.  Style: 0 = ordinary, 1 = balloon. Center: 1 = center the stem
  ;Icon: 0 = No icon, 1 = Info, 2 = Warn, 3 = Error, (See #TOOLTIP_ constants)
  TT = CreateWindowEx_(0, "Tooltips_Class32", "", #TTS_BALLOON * style, 0, 0, 0, 0, 0, 0, 0, 0)
  ;Color. RGB() or GetSysColor_(See #COLOR_ constants)
  If FgColor
    ;Set the tip text color, also the tip outline color for balloon tooltips
    SendMessage_(TT, #TTM_SETTIPTEXTCOLOR, FgColor, 0)
  EndIf
  If BgColor
    ;Set the tip background color
    SendMessage_(TT, #TTM_SETTIPBKCOLOR, BgColor, 0)
  EndIf
  TI.ToolInfo\cbSize = SizeOf(ToolInfo)
  TI\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS |  (#TTF_CENTERTIP * Center)
  TI\hwnd = WindowID(Win)
  TI\uId = GadgetID(Id)
  TI\lpszText = @Tip
  
  ;Set Opacity if any...
  If pOpacity < 0
    pOpacity = 100
  ElseIf pOpacity > 100
    pOpacity = 100
  EndIf
  
  If pOpacity < 100 
    pOpacity = Int ( pOpacity * 255 / 100 )
    SetWindowAlpha ( TT, pOpacity )
  EndIf  
  
  ;Register tooltip with the control
  SendMessage_(TT, #TTM_ADDTOOL, 0, TI)
  ;Set as a multiline tooltip with wordwrap
  SendMessage_(TT, #TTM_SETMAXTIPWIDTH, 0, 150)
  ;Set the icon style and tip title
  SendMessage_(TT, #TTM_SETTITLE, Icon, title)
EndProcedure

Procedure OpenMainWindow()
  If OpenWindow(0, 0, 0, 300, 300, #PB_Window_ScreenCentered|#PB_Window_SystemMenu, "Tooltip Styles")
    If CreateGadgetList(WindowID())
      
      ; Set opacity here...
      lOpacity.l = 65
      
      ButtonGadget(#Btn1, 110, 40, 80, 20, "Button1")
      ToolTip(#Win, #Btn1, 0, 0, 1, 0, 0, "", "This is a boring old Tooltip", lOpacity.l)
      
      ButtonGadget(#Btn2, 110,100, 80, 20, "Button2")
      ToolTip(#Win, #Btn2, 0, 1, 1, 0, RGB(226, 255, 255), "Title", "Not that boring old Tooltip", lOpacity.l)
      
      ButtonGadget(#Btn3, 110, 160, 80, 20, "Button3")
      ToolTip(#Win, #Btn3, 1, 0, 0, 0, RGB(226, 255, 255), "", "This is a multi line Tooltip This is a multi line Tooltip", lOpacity.l)
      
      ButtonGadget(#Btn4, 110, 220, 80, 20, "Button4")
      ToolTip(#Win, #Btn4, 1, 1, 1, RGB(57, 120, 63), RGB(226, 255, 255), "This is:", "A centered Tooltip", lOpacity.l)
    EndIf
  Else
    End
  EndIf
EndProcedure

Posted: Sun Jan 22, 2006 12:54 am
by utopiomania
Thanks for sharing to you too, Straker :) Your tip is good, but it doesn't work here if XP skins is enabled in compiler options?

Posted: Sun Jan 22, 2006 12:58 pm
by NoahPhense
Very nice ..

- np

Posted: Sun Jan 22, 2006 1:31 pm
by Droopy
The Stalker version adds an element in the taskbar when a tooltip is showed :shock:

Posted: Sun Jan 22, 2006 4:44 pm
by Sparkie
Droopy wrote:The Stalker version adds an element in the taskbar when a tooltip is showed
Line 33 is removing the default #WS_EX_TOOLWINDOW flag that is put there by the system when you CreateWindowEx() for a tooltips_class32.

Change line 33 to this...

Code: Select all

SetWindowLong_(hwnd, #GWL_EXSTYLE, GetWindowLong_(hwnd, #GWL_EXSTYLE) | $00080000)
or

Code: Select all

SetWindowLong_(hwnd, #GWL_EXSTYLE, #WS_EX_TOOLWINDOW | $00080000)

Posted: Sun Jan 22, 2006 4:53 pm
by Droopy
Thanks

Posted: Sun Jan 22, 2006 9:24 pm
by Straker
Thanks Sparkie for the added info. I didn't catch that.
utopiomania wrote:Thanks for sharing to you too, Straker :) Your tip is good, but it doesn't work here if XP skins is enabled in compiler options?
I use Windows 2000 so I don't always test against Windows XP, but I believe that XP Skin/themes override colors and behaviors even if explicitly coded. This problem showed up with my office-style menu code, so I don't know if it can be solved.

Perhaps a Win XP guru can shed some light for us on how and when skins/themes will override coded preferences?

Posted: Tue Apr 04, 2006 7:37 pm
by Shannara
Updated it to PB4 ... pb4's OpenWindow is different then the 3.x series. Added #PB_ANY support. Special thanks to utopiomania and Sparkie

Code: Select all

;-Gadget Id's
;
Global Win.l
Global Btn1.l
Global Btn2.l
Global Btn3.l
Global Btn4.l

;-Declares
;
Declare ToolTip(Win, Id, style, Center, Icon, FgColor, BgColor, title.s, Tip.s, pOpacity.l)
Declare OpenMainWindow()

;-StartRun
;
OpenMainWindow()

;-Events
;
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

;-EndRun
;
End

;-Procedures
;
Procedure SetWindowAlpha(hwnd.l, Opacity.l)
  If #VER_PLATFORM_WIN32_NT
    SetWindowLong_(hwnd, #GWL_EXSTYLE, GetWindowLong_(hwnd, #GWL_EXSTYLE) | $00080000)
    If OpenLibrary(1, "user32.dll")
      CallFunction(1, "SetLayeredWindowAttributes", hwnd, 0, Opacity, 2)
      CloseLibrary(1)
    EndIf
  EndIf
EndProcedure

Procedure ToolTip(WinID, Id, style, Center, Icon , FgColor, BgColor, title.s, Tip.s, pOpacity.l)
  ;Adds a tooltip to Id.  Style: 0 = ordinary, 1 = balloon. Center: 1 = center the stem
  ;Icon: 0 = No icon, 1 = Info, 2 = Warn, 3 = Error, (See #TOOLTIP_ constants)
  TT = CreateWindowEx_(0, "Tooltips_Class32", "", #TTS_BALLOON * style, 0, 0, 0, 0, 0, 0, 0, 0)
  ;Color. RGB() or GetSysColor_(See #COLOR_ constants)
  If FgColor
    ;Set the tip text color, also the tip outline color for balloon tooltips
    SendMessage_(TT, #TTM_SETTIPTEXTCOLOR, FgColor, 0)
  EndIf
  If BgColor
    ;Set the tip background color
    SendMessage_(TT, #TTM_SETTIPBKCOLOR, BgColor, 0)
  EndIf
  TI.ToolInfo\cbSize = SizeOf(ToolInfo)
  TI\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS |  (#TTF_CENTERTIP * Center)
  TI\hwnd = WindowID(WinID)
  TI\uId = GadgetID(Id)
  TI\lpszText = @Tip
  
  ;Set Opacity if any...
  If pOpacity < 0
    pOpacity = 100
  ElseIf pOpacity > 100
    pOpacity = 100
  EndIf
  
  If pOpacity < 100
    pOpacity = Int ( pOpacity * 255 / 100 )
    SetWindowAlpha ( TT, pOpacity )
  EndIf 
  
  ;Register tooltip with the control
  SendMessage_(TT, #TTM_ADDTOOL, 0, TI)
  ;Set as a multiline tooltip with wordwrap
  SendMessage_(TT, #TTM_SETMAXTIPWIDTH, 0, 150)
  ;Set the icon style and tip title
  SendMessage_(TT, #TTM_SETTITLE, Icon, title)
EndProcedure

Procedure OpenMainWindow()
  Win = OpenWindow(#PB_Any, 0, 0, 300, 300, "Tooltip Styles", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  If Win
    If CreateGadgetList(WindowID(Win))
      
      ; Set opacity here...
      lOpacity.l = 65
      
      Btn1 = ButtonGadget(#PB_Any, 110, 40, 80, 20, "Button1")
      ToolTip(Win, Btn1, 0, 0, 1, 0, 0, "", "This is a boring old Tooltip", lOpacity.l)
      
      Btn2 = ButtonGadget(#PB_Any, 110,100, 80, 20, "Button2")
      ToolTip(Win, Btn2, 0, 1, 1, 0, RGB(226, 255, 255), "Title", "Not that boring old Tooltip", lOpacity.l)
      
      Btn3 = ButtonGadget(#PB_Any, 110, 160, 80, 20, "Button3")
      ToolTip(Win, Btn3, 1, 0, 0, 0, RGB(226, 255, 255), "", "This is a multi line Tooltip This is a multi line Tooltip", lOpacity.l)
      
      Btn4 = ButtonGadget(#PB_Any, 110, 220, 80, 20, "Button4")
      ToolTip(Win, Btn4, 1, 1, 1, RGB(57, 120, 63), RGB(226, 255, 255), "This is:", "A centered Tooltip", lOpacity.l)
    EndIf
  Else
    End
  EndIf
EndProcedure

Posted: Wed Apr 05, 2006 12:42 am
by SoulReaper
Great Work !!!

I have tested it on windows 2000 pro with StarDocks window blinds & object bar works fine with no problems at all :) :wink:

oh I am running Pure Basic V4 Beta 9

Regards
Kevin :wink:

Posted: Wed Apr 05, 2006 2:01 pm
by SoulReaper
Hi again while looking at the Tool tips me & a friend noticed a problem with the code

Code: Select all

Procedure SetWindowAlpha(hwnd.l, Opacity.l) 
;--> If #VER_PLATFORM_WIN32_NT 

    SetWindowLong_(hwnd, #GWL_EXSTYLE, GetWindowLong_(hwnd, #GWL_EXSTYLE) | $00080000) 
    If OpenLibrary(1, "user32.dll") 
      CallFunction(1, "SetLayeredWindowAttributes", hwnd, 0, Opacity, 2) 
      CloseLibrary(1) 
    EndIf 

;  EndIf 

EndProcedure
with the above two lines commented out from Shannara version it works fine with windows 2000 and windows xp.

but with the lines in place it wont work on xp correct.

I had some time so I adjusted it slighty just learning :wink:
now it detects the OS version so it works with 2000 & xp
see what u think :)

Code: Select all


;OSversion
;
Global Osv.l

;-Gadget Id's 
; 
Global Win.l 
Global Btn1.l 
Global Btn2.l 
Global Btn3.l 
Global Btn4.l 

;-Declares 
; 
Declare ToolTip(Win, Id, style, Center, Icon, FgColor, BgColor, title.s, Tip.s, pOpacity.l) 
Declare OpenMainWindow() 

;-StartRun 
;

Osv.l = OSVersion() 
OpenMainWindow() 

;-Events 
; 
Repeat 
Until WaitWindowEvent() = #PB_Event_CloseWindow 

;-EndRun 
; 
End 

;-Procedures 
; 
Procedure SetWindowAlpha(hwnd.l, Opacity.l) 
  If Osv.l=#PB_OS_Windows_2000 Or Osv.l=#PB_OS_Windows_XP
    SetWindowLong_(hwnd, #GWL_EXSTYLE, GetWindowLong_(hwnd, #GWL_EXSTYLE) | $00080000) 
    If OpenLibrary(1, "user32.dll") 
      CallFunction(1, "SetLayeredWindowAttributes", hwnd, 0, Opacity, 2) 
      CloseLibrary(1) 
    EndIf 
  EndIf 
EndProcedure 

Procedure ToolTip(WinID, Id, style, Center, Icon , FgColor, BgColor, title.s, Tip.s, pOpacity.l) 
  ;Adds a tooltip to Id.  Style: 0 = ordinary, 1 = balloon. Center: 1 = center the stem 
  ;Icon: 0 = No icon, 1 = Info, 2 = Warn, 3 = Error, (See #TOOLTIP_ constants) 
  TT = CreateWindowEx_(0, "Tooltips_Class32", "", #TTS_BALLOON * style, 0, 0, 0, 0, 0, 0, 0, 0) 
  ;Color. RGB() or GetSysColor_(See #COLOR_ constants) 
  If FgColor 
    ;Set the tip text color, also the tip outline color for balloon tooltips 
    SendMessage_(TT, #TTM_SETTIPTEXTCOLOR, FgColor, 0) 
  EndIf 
  If BgColor 
    ;Set the tip background color 
    SendMessage_(TT, #TTM_SETTIPBKCOLOR, BgColor, 0) 
  EndIf 
  TI.ToolInfo\cbSize = SizeOf(ToolInfo) 
  TI\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS |  (#TTF_CENTERTIP * Center) 
  TI\hwnd = WindowID(WinID) 
  TI\uId = GadgetID(Id) 
  TI\lpszText = @Tip 
  
  ;Set Opacity if any... 
  If pOpacity < 0 
    pOpacity = 100 
  ElseIf pOpacity > 100 
    pOpacity = 100 
  EndIf 
  
  If pOpacity < 100 
    pOpacity = Int ( pOpacity * 255 / 100 ) 
    SetWindowAlpha ( TT, pOpacity ) 
  EndIf 
  
  ;Register tooltip with the control 
  SendMessage_(TT, #TTM_ADDTOOL, 0, TI) 
  ;Set as a multiline tooltip with wordwrap 
  SendMessage_(TT, #TTM_SETMAXTIPWIDTH, 0, 150) 
  ;Set the icon style and tip title 
  SendMessage_(TT, #TTM_SETTITLE, Icon, title) 
EndProcedure 

Procedure OpenMainWindow() 
  Win = OpenWindow(#PB_Any, 0, 0, 300, 300, "Tooltip Styles", #PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  If Win 
    If CreateGadgetList(WindowID(Win)) 
      
      ; Set opacity here... 
      lOpacity.l = 65 
      
      Btn1 = ButtonGadget(#PB_Any, 110, 40, 80, 20, "Button1") 
      ToolTip(Win, Btn1, 0, 0, 1, 0, 0, "", "This is a boring old Tooltip", lOpacity.l) 
      
      Btn2 = ButtonGadget(#PB_Any, 110,100, 80, 20, "Button2") 
      ToolTip(Win, Btn2, 0, 1, 1, 0, RGB(226, 255, 255), "Title", "Not that boring old Tooltip", lOpacity.l) 
      
      Btn3 = ButtonGadget(#PB_Any, 110, 160, 80, 20, "Button3") 
      ToolTip(Win, Btn3, 1, 0, 0, 0, RGB(226, 255, 255), "", "This is a multi line Tooltip This is a multi line Tooltip", lOpacity.l) 
      
      Btn4 = ButtonGadget(#PB_Any, 110, 220, 80, 20, "Button4") 
      ToolTip(Win, Btn4, 1, 1, 1, RGB(57, 120, 63), RGB(226, 255, 255), "This is:", "A centered Tooltip", lOpacity.l) 
    EndIf 
  Else 
    End 
  EndIf 
EndProcedure
Regards
Kevin :wink:

Posted: Wed Apr 05, 2006 6:40 pm
by Shannara
Thats weird, Im running XP Pro SP2, and it runs perfectly ?
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited