Colored Balloon Tooltips with icons

utopiomania · Post by **utopiomania** » Sat Jan 21, 2006 3:11 pm

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

Post by **Dare2** » Sat Jan 21, 2006 3:13 pm

hehe! Neat!

josku_x · Post by **josku_x** » Sat Jan 21, 2006 3:17 pm

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.

utopiomania · Post by **utopiomania** » Sat Jan 21, 2006 10:31 pm

@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.

Straker · Post by **Straker** » Sat Jan 21, 2006 11:36 pm

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

utopiomania · Post by **utopiomania** » Sun Jan 22, 2006 12:54 am

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?

NoahPhense · Post by **NoahPhense** » Sun Jan 22, 2006 12:58 pm

Very nice ..

- np

Droopy · Post by **Droopy** » Sun Jan 22, 2006 1:31 pm

The Stalker version adds an element in the taskbar when a tooltip is showed

Sparkie · Post by **Sparkie** » Sun Jan 22, 2006 4:44 pm

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)

Droopy · Post by **Droopy** » Sun Jan 22, 2006 4:53 pm

Thanks

Straker · Post by **Straker** » Sun Jan 22, 2006 9:24 pm

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?

Shannara · Post by **Shannara** » Tue Apr 04, 2006 7:37 pm

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

SoulReaper · Post by **SoulReaper** » Wed Apr 05, 2006 12:42 am

Great Work !!!

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

oh I am running Pure Basic V4 Beta 9

Regards
Kevin

SoulReaper · Post by **SoulReaper** » Wed Apr 05, 2006 2:01 pm

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

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

Shannara · Post by **Shannara** » Wed Apr 05, 2006 6:40 pm

Thats weird, Im running XP Pro SP2, and it runs perfectly ?