Here's the Library Code
Code: Select all
;/ Author : Andre / Balatro / Berikco
; ToolTipAdd
; Type : 0 = Balloon Tip / 1 Square Tip
; MaxWidth : Max Width of the ToolTip
; Icon : 0 (no Icon) / 1 (information icon) / 2 (warning icon) / 3 (error icon)
ProcedureDLL ToolTipAdd(Type,MaxWidth,WindowID, Gadget, Text$ , Title$, Icon,TextColor,BKColor,Font.s,FontSize)
;/ Initialise le Tableau au premier appel
Static Initialised
If Initialised=0
Global Dim PtrToolTip(500)
Initialised=1
EndIf
If Type=0 ;/ Ballon
Type=#WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON
Else ;/ Or Square
Type=#WS_POPUP | #TTS_NOPREFIX
EndIf
If TextColor=0 : TextColor=GetSysColor_(#COLOR_INFOTEXT) : EndIf
If BKColor=0 : BKColor=GetSysColor_(#COLOR_INFOBK) : EndIf
ToolTip=CreateWindowEx_(0,"ToolTips_Class32","",Type,0,0,0,0,WindowID(WindowID),0,GetModuleHandle_(0),0)
SendMessage_(ToolTip,#TTM_SETTIPTEXTCOLOR,TextColor,0)
SendMessage_(ToolTip,#TTM_SETTIPBKCOLOR,BKColor,0)
SendMessage_(ToolTip,#TTM_SETMAXTIPWIDTH,0,MaxWidth)
Balloon.TOOLINFO\cbSize=SizeOf(TOOLINFO)
Balloon\uFlags= #TTF_IDISHWND | #TTF_SUBCLASS
Balloon\hWnd=WindowID(WindowID)
Balloon\uId=GadgetID(Gadget)
Balloon\lpszText=@Text$
;/ Fonts
If Font>""
f1 = LoadFont(#PB_Any, Font, FontSize); : UseFont(1)
SendMessage_(ToolTip, #WM_SETFONT, FontID(f1), #True)
EndIf
SendMessage_(ToolTip, #TTM_ADDTOOL, 0, Balloon)
If Title$ > ""
SendMessage_(ToolTip, #TTM_SETTITLE, Icon, @Title$)
EndIf
PtrToolTip(Gadget)=ToolTip
EndProcedure
ProcedureDLL ToolTipRemove(Gadget.l)
ttRemove.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ttRemove\hWnd = WindowID(0)
ttRemove\uId = GadgetID(Gadget)
Shared PtrToolTip()
SendMessage_(PtrToolTip(Gadget), #TTM_DELTOOL, 0, ttRemove)
EndProcedure
ProcedureDLL ToolTipChange(Gadget.l, Text$)
ttChange.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ttChange\hWnd = WindowID(0)
ttChange\uId = GadgetID(Gadget)
ttChange\lpszText = @Text$
SendMessage_(PtrToolTip(Gadget), #TTM_UPDATETIPTEXT, 0, ttChange)
EndProcedure
ProcedureDLL ToolTipShow(Gadget.l,x,y)
ttChange.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ttChange\hWnd = WindowID(0)
ttChange\uId = GadgetID(Gadget)
SendMessage_(PtrToolTip(Gadget), #TTM_TRACKACTIVATE, 1, ttChange)
SetWindowPos_(PtrToolTip(Gadget), 0, x, y, -1, -1, #SWP_NOSIZE | #SWP_NOZORDER | #SWP_SHOWWINDOW | #SWP_NOACTIVATE)
EndProcedure
ProcedureDLL ToolTipHide(Gadget.l)
ttChange.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ttChange\hWnd = WindowID(0)
ttChange\uId = GadgetID(Gadget)
SendMessage_(PtrToolTip(Gadget), #TTM_TRACKACTIVATE, 0,ttChange)
EndProcedure
;/
;/ LIBRARY TEST
;/
Procedure BackGroundTask(a)
Repeat
ToolTipChange(0,FormatDate("%hh:%ii:%ss", Date()))
Delay(1000)
ForEver
EndProcedure
OpenWindow(0,0,0,270,160,"GadgetTooltip",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ButtonGadget(0,10,5,250,30,"Show/Hide ToolTip")
ButtonGadget(1,10,40,250,30,"Button 2")
ButtonGadget(2,10,75,250,30,"Button 3")
ButtonGadget(3,10,110,250,30,"Button 4")
ButtonGadget(4,0,0,0,0,"") ;/ Hidden Button
ToolTipAdd(0,200,0,0,"Tooltip n°1","ClockTip",0,RGB(255,255,0),RGB(255,0,0),"Comic sans ms",34)
ToolTipAdd(0,200,0,1,"This is a text","Tooltip n°2",3,0,0,"",0)
ToolTipAdd(0,200,0,2,"TOOLTIP 3"+#CRLF$+"MULTILINE"+#CR$+" INPUT","",0,RGB(0,0,255),RGB(255,255,255),"impact",25)
ToolTipAdd(1,200,0,3,"This is a text","ToolTip n°4",1,RGB(100, 128, 128),RGB(128, 255, 128),"",0)
ToolTipAdd(1,300,0,4,"This is a multiline"+#CR$+"Tooltip an i can write"+#CR$+"what i want !","",0,0,65535,"Arial",12)
CreateThread(@BackGroundTask(),0)
Repeat
temp=WaitWindowEvent()
If temp=#PB_Event_Gadget And EventGadget()=0 And EventType()=#PB_EventType_LeftClick
Temp2=Bool(Not Temp2)
If Temp2
ToolTipShow(4,512,384)
Else
ToolTipHide(4)
EndIf
EndIf
Until temp=#PB_Event_CloseWindow
