Tested PB v5.22 x86 - Windows 8.1 X64 - XP SP2 x86
Code: Select all
Global TTip,ti.TOOLINFO
#TTS_BUBBLE = $40
#TTF_TRACK = $20
#TTF_ABSOLUTE = $80
ti.TOOLINFO
ti\cbSize = SizeOf(ti)
ti\hInst = GetModuleHandle_(0)
TTip = CreateWindowEx_(#WS_EX_TOPMOST, "tooltips_class32", 0, #TTS_ALWAYSTIP| #TTS_NOPREFIX| #WS_POPUP| #TTS_BUBBLE,0,0,0,0, 0, 0, GetModuleHandle_(0), 0)
SetWindowTheme_(TTip, @null.w, @null.w)
;SendMessage_(TTip,#WM_SETFONT,FontID,0)
SendMessage_(TTip,#TTM_SETTIPTEXTCOLOR,$0202FD,0)
SendMessage_(TTip,#TTM_SETTIPBKCOLOR,$DCFFFF,0)
Procedure GadToolTip(Gadget,Tip$)
ti\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
ti\hwnd = GadgetID(Gadget)
ti\uId = GadgetID(Gadget)
ti\lpszText = @Tip$;"Gadget # 1 Tooltip"
SendMessage_(TTip, #TTM_ADDTOOL, 0, ti)
EndProcedure
Procedure TTip_Command(Gadget,x,y,dTime,Title$,Tip$,Icon)
ti\uFlags = #TTF_TRACK | #TTF_ABSOLUTE
ti\hwnd = GadgetID(Gadget)
ti\uId = GadgetID(Gadget)
ti\lpszText = @Tip$
SendMessage_(TTip,#TTM_SETTOOLINFO,0,ti)
SendMessage_(TTip, #TTM_SETTITLE, Icon, @Title$)
SendMessage_(TTip,#TTM_TRACKPOSITION,0,x+y<<16)
SendMessage_(TTip,#TTM_TRACKACTIVATE,1,ti)
SendMessage_(TTip,#TTM_TRACKPOSITION,0,x + 50 + y<<16)
Delay(dTime)
SendMessage_(TTip,#TTM_TRACKACTIVATE,0,ti)
ti\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
SendMessage_(TTip,#TTM_SETTOOLINFO,0,ti)
EndProcedure
If OpenWindow(0, 0, 0, 300, 300, "Tooltips by Command",#PB_Window_ScreenCentered| #PB_Window_SystemMenu)
ButtonGadget(0,10,10,80,20,"TEST # 0")
GadToolTip(0,"This is a test for"+#CRLF$ + "Multiline Balloon")
ButtonGadget(1,10,40,80,20,"TEST # 1")
GadToolTip(1,"Gadget # 1 Tooltip")
StringGadget(2,10,70,120,20,"This is a test")
GadToolTip(2,"Gadget # 2 Tooltip")
ButtonGadget(3,10,260,80,20,"TEST 0")
ButtonGadget(4,100,260,80,20,"TEST 1")
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #WM_MOUSEMOVE
GetCursorPos_ (@p.POINT)
ScreenToClient_ (WindowID(0), @p)
hGad = ChildWindowFromPoint_ (WindowID(0), p\y<< 32+p\x)
Select hGad
Case GadgetID(0)
SendMessage_(TTip, #TTM_SETTITLE, #TOOLTIP_WARNING_ICON, @"Hi")
Case GadgetID(1)
SendMessage_(TTip, #TTM_SETTITLE, #TOOLTIP_ERROR_ICON, @"Remember")
Case GadgetID(2)
SendMessage_(TTip, #TTM_SETTITLE, #TOOLTIP_INFO_ICON, @"Info")
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 3
x = GadgetX(0,#PB_Gadget_ScreenCoordinate)
y = GadgetY(0,#PB_Gadget_ScreenCoordinate)
TTip_Command(0,x,y,1000,"Hi","This is a test for"+#CRLF$+"Multiline Balloon",#TOOLTIP_WARNING_ICON)
Case 4
x = GadgetX(1,#PB_Gadget_ScreenCoordinate)
y = GadgetY(1,#PB_Gadget_ScreenCoordinate)
TTip_Command(1,x,y,1000,"Remember", "Gadget # 1 Tooltip",#TOOLTIP_INFO_ICON)
EndSelect
EndSelect
Until Quit = 1
End
EndIf
