PureBasic

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