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 2 of 2

Posted: Wed Apr 05, 2006 6:47 pm
by SoulReaper
I had to detect with osversion() for it to work correct - I wonder if there is a bug... guess I am stumped on this one...

well I am running PB v4 beta 9 maybe its that :?

Regards
Kevin :wink:

Posted: Fri Apr 07, 2006 1:01 am
by Rescator
Seems to get the dreaded "invalid memory access" highlighting line 43 when I try to run/compile the last two sources shown here. hmm.
And with the debugger off the program crashes.
PB4 B9 btw, with the /beta/ file updates.

Posted: Fri Apr 07, 2006 1:46 am
by Shannara
Oooo.. I wasnt aware of beta updates :) Mine is just the download with no updates applied (PB4 Beta 9), This is with Windows XP Pro SP2, with all updates applied (to windows xp;)), and with themes turned off .. so it basically looks like Windows 2000 for the most part.

Problem tooltips with this code for StringGadgets

Posted: Tue Jun 14, 2016 9:09 am
by Al_the_dutch
Hi All,

After 10 years this post still has value...

But I'm facing a problem and need some help to solve it.

Code: Select all

; Problem: Tooltips for the StringGadget do not disappear if you go from bottom to top.
; No problem going down. No problem using ButtonGadgets as in the original Code.
; http://www.purebasic.fr/english/viewtopic.php?t=18805

; Using Win 10 x64 PureBasic 5.42LTS x86.

;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) 
  
  ;Lets users give some more time to read the tooltip
  SendMessage_(TT,#TTM_SETDELAYTIME,#TTDT_INITIAL,0)
  SendMessage_(TT,#TTM_SETDELAYTIME,#TTDT_AUTOPOP,30000)  ;30000 is the highest value   
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 = 100
      
      Btn1 = StringGadget(#PB_Any, 110, 40, 80, 20, "String1") 
      ToolTip(Win, Btn1, 0, 0, 1, 0, 0, "", "This is a boring old Tooltip", lOpacity.l) 
      
      Btn2 = StringGadget(#PB_Any, 110,100, 80, 20, "String2") 
      ToolTip(Win, Btn2, 0, 1, 1, 0, RGB(226, 255, 255), "Title", "Not that boring old Tooltip", lOpacity.l) 
      
      Btn3 = StringGadget(#PB_Any, 110, 160, 80, 20, "String3") 
      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 = StringGadget(#PB_Any, 110, 220, 80, 20, "String4") 
      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

Re: Colored Balloon Tooltips with icons

Posted: Wed Jun 15, 2016 12:53 pm
by mestnyi
So like it dares not it?

Code: Select all

; Problem: Tooltips for the StringGadget do not disappear if you go from bottom to top.
; No problem going down. No problem using ButtonGadgets as in the original Code.
; http://www.purebasic.fr/english/viewtopic.php?t=18805

; Using Win 10 x64 PureBasic 5.42LTS x86.

;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 IsMouseOverClient( hWnd )
  Protected Pt.Point
  Protected client.RECT 
  GetCursorPos_(Pt)    
  ScreenToClient_(hWnd, Pt) 
  GetClientRect_(hWnd, @client)
  If PtInRect_(@client,Pt\x | (Pt\y<<32))
    ProcedureReturn #True
  EndIf
EndProcedure
Procedure IsMouseOver(hwnd) ; Эта процедура определяет находится ли курсор мышки над заданым окном или гаджетом
  Protected Pt.Point
  Protected client.RECT 
  GetWindowRect_(hwnd,client.RECT) 
  GetCursorPos_(pt.Point) 
  Protected Result.l = PtInRect_(@client, pt\x | (pt\y<<32) )
  ProcedureReturn Result 
EndProcedure


Procedure IDProc(hWnd, uMsg, wParam, lParam)
  Protected sysProc = GetProp_( hWnd, "IDProc_CallBack") 
  
  If uMsg = #WM_MOUSEMOVE Or uMsg = #WM_MOUSELEAVE
    If IsMouseOverClient(hWnd) = 1
      ShowWindow_(GetProp_( hWnd, "IDProc_ID"),#SW_SHOWNOACTIVATE)
    Else
      ShowWindow_(GetProp_( hWnd, "IDProc_ID"),#SW_HIDE)
    EndIf
    
  EndIf
  
  ProcedureReturn CallWindowProc_(sysProc, hWnd, uMsg, wParam, lParam)
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) 
  
  ;Lets users give some more time to read the tooltip
  SendMessage_(TT,#TTM_SETDELAYTIME,#TTDT_INITIAL,0)
  SendMessage_(TT,#TTM_SETDELAYTIME,#TTDT_AUTOPOP,30000)  ;30000 is the highest value   
  
  
  SetProp_( GadgetID(ID), "IDProc_ID", TT)
  SetProp_( GadgetID(ID), "IDProc_CallBack", SetWindowLong_(GadgetID(ID), #GWL_WNDPROC, @IDProc()))
EndProcedure 

Procedure OpenMainWindow() 
  Win = OpenWindow(#PB_Any, 0, 0, 300, 300, "Tooltip Styles", #PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  If Win 
    
    
    ; Set opacity here... 
    lOpacity.l = 100
    
    Btn1 = StringGadget(#PB_Any, 110, 40, 80, 20, "String1") 
    ToolTip(Win, Btn1, 0, 0, 1, 0, 0, "", "This is a boring old Tooltip", lOpacity.l) 
    
    Btn2 = StringGadget(#PB_Any, 110,100, 80, 20, "String2") 
    ToolTip(Win, Btn2, 0, 1, 1, 0, RGB(226, 255, 255), "Title", "Not that boring old Tooltip", lOpacity.l) 
    
    Btn3 = StringGadget(#PB_Any, 110, 160, 80, 20, "String3") 
    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 = StringGadget(#PB_Any, 110, 220, 80, 20, "String4") 
    ToolTip(Win, Btn4, 1, 1, 1, RGB(57, 120, 63), RGB(226, 255, 255), "This is:", "A centered Tooltip", lOpacity.l) 
    
  Else 
    End 
  EndIf 
EndProcedure
Although this could be solved with the following lines but it's stupid api. :evil:

Code: Select all

If uMsg = #WM_MOUSELEAVE
    DestroyWindow_( GetProp_( hWnd, "IDProc_ID") )
  EndIf

Re: Colored Balloon Tooltips with icons

Posted: Thu Jun 16, 2016 8:39 am
by Al_the_dutch
Great! Thank you so much. :D
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited