il est pas de moi, c'est Denis qui me l'a passé
Code : Tout sélectionner
Procedure.l ToolTipCallback(Window, Message, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_NOTIFY
*notify.NMHDR = lParam
Select *notify\code
Case #TTN_SHOW
ti.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ti\hWnd = Window
ti\uId = *notify\idfrom
SendMessage_(*notify\hwndFrom, #TTM_GETTOOLINFO, 0, ti)
GetWindowRect_(*notify\idfrom, area.RECT)
GetClientRect_(*notify\hwndFrom, size.RECT)
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @ScreenSize.RECT, 0)
GetWindowRect_(*notify\hwndFrom, ToolTipSize.RECT)
Select ti\hInst
Case 1 ; Nord
PosX = area\left
PosY = area\top - size\bottom - 2
Case 2 ; Est
PosX = area\right
PosY = area\top
Case 3 ; Sud
PosX = area\left
PosY = area\bottom
Case 4 ; Ouest
PosX = area\left - size\right - 2
PosY = area\top
EndSelect
If PosX + ToolTipSize\right - ToolTipSize\left > ScreenSize\right
PosX = ScreenSize\right - ToolTipSize\right + ToolTipSize\left - 5
EndIf
If PosX < ScreenSize\left
PosX = ScreenSize\left + 5
EndIf
If PosY + ToolTipSize\bottom - ToolTipSize\top > ScreenSize\bottom
PosY = ScreenSize\bottom - ToolTipSize\bottom + ToolTipSize\top - 5
EndIf
If PosY < ScreenSize\top
PosY = ScreenSize\top + 5
EndIf
SetWindowPos_(*notify\hwndFrom, #HWND_TOP, PosX, PosY, 0, 0, #SWP_NOSIZE | #SWP_NOACTIVATE)
result = 1
EndSelect
EndSelect
ProcedureReturn result
EndProcedure
Procedure ToolTip(Handle.l, Text$, HeaderText$, Side.l, BackColor.l, TextColor.l)
; handle : ID du gadget
; Text : texte de l'info bulle
; HeaderText : Titre de l'info bulle (en gras)
; si la fin du texte est égale à :
;- &1 : le titre comportera l'icone "Information"
;- &2 : le titre comportera l'icone "Danger"
;- &3 : le titre comportera l'icone "Interdiction"
; Side : coté du bouton sur lequel on veut placer l'info bulle
; BackColor : couleur du fond de l'info bulle. si color = 0, on utilise la couleur par défaut d'une info bulle
; TextColor : couleur du texte (0 est la couleur noire)
Global ToolTipCallback.l
; on initialise le callback
If ToolTipCallback = 0
SetWindowCallback(@ToolTipCallback())
ToolTipCallback = 1
EndIf
; Mise en place des constantes
#NORTH = 1 : #EAST = 2 : #SOUTH = 3 : #WEST = 4
#TTS_BALLOON = $40
#TTM_SETTITLE = #WM_USER + 32
#TTM_TRACKACTIVATE = #WM_USER + 17
#TTM_TRACKPOSITION = #WM_USER + 18
#TTF_IDISHWND = $1
#TTF_CENTERTIP = $2
#TTF_SUBCLASS = $10
#TTF_ABSOLUTE = $80
#TTF_TRANSPARENT = $100
If BackColor = 0 ; si la couleur est 0, on charge la couleur par défaut d'une info bulle
BackColor = GetSysColor_(#COLOR_INFOBK)
EndIf
TT = CreateWindowEx_(0, "tooltips_class32", "", 0, 0, 0, 0, 0, 0, 0, 0, 0)
sendMessage_(TT, 1044, TextColor, 0) ; Couleur du texte de l'info bulle
sendMessage_(TT, 1043, BackColor, 0) ; Couleur de fond de l'info bulle
sendMessage_(TT, 1048, 0, 300) ; Largeur maximum de l'info bulle
If HeaderText$ <> ""
If Left(Right(HeaderText$, 2), 1) = "&"
Icon = Val(Right(HeaderText$, 1))
HeaderText$ = Left(HeaderText$, Len(HeaderText$) - 2)
Else
Icon = 0
EndIf
SendMessage_(TT, #TTM_SETTITLE, Icon, HeaderText$) ; Ajoute en en-tête
EndIf
Button.TOOLINFO\cbSize = SizeOf(TOOLINFO)
Button\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS | #TTF_TRANSPARENT
Button\hWnd = WindowID() ; Handle to MainWindow ( for Callback )
Button\uId = Handle ; Handle to Gadget
Button\hInst = Side ; misused here for the side
Button\lpszText = @Text$
SendMessage_(TT, #TTM_ADDTOOL, 0, Button)
EndProcedure
;- Debut du programme ---------------------------------------------------
Procedure RefreshToolTip()
ToolTip(GadgetID(1), "Info bulle au nord du bouton" + Chr(10) + "Constante #NORTH=1", "Avec un titre", #NORTH, RGB(255, 255, 255), 0)
ToolTip(GadgetID(2), "Info bulle à l'est du bouton" + Chr(10) + "Constante #EAST=2", "Titre + Icônes 'Danger'&2", #EAST, RGB(150, 200, 0), RGB(255, 255, 255))
ToolTip(GadgetID(3), "Info bulle à l'ouest du bouton" + Chr(10) + "Constante #WEST=4", "Titre + Icônes 'Information'&1", #WEST, RGB(73, 177, 73), 0)
ToolTip(GadgetID(4), "Info bulle au sud du bouton" + Chr(10) + "Constante #SOUTH=3" + Chr(10) + "Avec la couleur par défaut : Color = 0", "", #SOUTH, 0, 0)
EndProcedure
If OpenWindow(0, 0, 0, 220, 220, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "ToolTip")
CreateGadgetList(WindowID())
ButtonGadget(1, 10, 10, 100, 100, "Bouton 1")
ButtonGadget(2, 110, 10, 100, 100, "Bouton 2")
ButtonGadget(3, 10, 110, 100, 100, "Bouton 3")
ButtonGadget(4, 110, 110, 100, 100, "Bouton 4")
;- Infos bulles
RefreshToolTip()
Repeat
Event = WaitWindowEvent()
If Event = #PB_EventGadget
RefreshToolTip() ; pour rafraichir les infos bulles après l'appui sur un gadget
Select EventGadgetID() ; boutons, zone de texte, ...
EndSelect
EndIf
Until Event = #PB_EventCloseWindow
EndIf