Hyperlien à deux couleurs paramétrables

[fweil]

Code : Tout sélectionner

;
; Hyperlien avec attributs de couleur
;
; F.Weil 20040531
;
; En l'état actuel de PureBasic, il n'est pas possible de passer deux couleurs différentes en argument pour changer l'aspect du lien selon l'état
;
; Ce code permet de gérer un texte comme un hyperlien avec un attribut de couleur paramétrable.
;
; La gestion se fait dans le callback et n'est pas générique en l'état. Tel quel ce code ne traite qu'un seul hyperlien. La personnalisation est cependant facile
; à réaliser
;
Enumeration
  #Window_Main
  #Gadget_HyperLink
EndEnumeration

Procedure WindowCallback(WindowID, Message, wParam, lParam)
Static HyperlinkBrush.l, OverHyperLink.l, HyperlinkColor.l
    Result = #PB_ProcessPureBasicEvents
    Select Message
      Case #WM_LBUTTONUP ; Si le bouton est relaché et que le pointeur était sur le lien
        If OverHyperlink
            ShellExecute_(0, "open", "http:\\www.purebasic.com", 0, 0, #SW_SHOWNORMAL) ; On exécute la fonction prévue pour ce lien
        EndIf
      Case #WM_MOUSEMOVE ; Lorsque la souris bouge
        GetWindowRect_(GadgetID(#Gadget_HyperLink), Rectangle.RECT) ; On relève le rectangle contenant le lien
        GetCursorPos_(Point.POINT)
        OverHyperLink = PtInRect_(Rectangle, Point\x, Point\y) ; et on mémorise si le curseur se trouve dans le rectangle ou non
        If OverHyperLink ; Si tel est le cas
            HyperlinkColor = RGB(240, 0, 0) ; On utilise une couleur donnée
            SetCursor_(LoadCursor_(0, #IDC_HAND)) ; et un curseur 'main'
          Else
            HyperlinkColor = RGB(0, 0, 255) ; ou une autre couleur si le lien n'est pas atteint.
            SetCursor_(LoadCursor_(0, #IDC_ARROW)) ; et on revient au curseur standard
        EndIf
        InvalidateRect_(WindowID(), 0, 0)
      Case #WM_CTLCOLORSTATIC
        If lParam = GadgetID(#Gadget_HyperLink) ; Le gadget est mis à jour selon la couleur correspondant à son état.
            DeleteObject_(HyperlinkBrush)
            HyperlinkBrush = GetStockObject_(#HOLLOW_BRUSH)
            SetTextColor_(wParam, HyperlinkColor)
            SetBkMode_(wParam, #TRANSPARENT)
            Result = HyperlinkBrush
        EndIf
    EndSelect
    ProcedureReturn Result
EndProcedure

  WindowXSize = 320
  WindowYSize = 240
  Quit = #FALSE
  If OpenWindow(0, 0, 0, WindowXSize, WindowYSize, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "HyperlinkGadget")
      AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
      If CreateGadgetList(WindowID())
          TextGadget(#Gadget_HyperLink, 10, 50, 200, 20, "www.purebasic.com")
          SetGadgetFont(#Gadget_HyperLink, LoadFont(0, "Verdana", 10, #PB_Font_Bold | #PB_Font_Underline))
      EndIf
      SetCursorPos_(WindowX() + WindowWidth() / 2, WindowY() + WindowHeight() / 2) ; On génère un évènement fictif pour valider les séquences du callback
      SetWindowCallback(@WindowCallback())
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Quit = #TRUE
          Case #PB_Event_Menu
            Select EventMenuID()
              Case #PB_Shortcut_Escape
                Quit = #TRUE
            EndSelect
        EndSelect
      Until Quit
  EndIf
End