RibbonBar – Barre d'outils personnalisable pour PureBasic

; +======================================================+
; |                                                      |
; +------------------------------------------------------+
; | COPYRIGHT(C)2017-2026, ALL RIGHT RESERVED KOAKDESIGN |
; +--------------+---------------------------------------+
; | Program type | PUREBASIC 6.30 (MODULE)               |
; +--------------+---------------------------------------+
; | VER & REV    | 0.1.1                                 |
; +--------------+---------------------------------------+
; | Program name | RIBBONBAR (W11)                       |
; +======================================================+

; +======================================================+
; | Original Version: 0.0.1                              |
; +--------------+---------------------------------------+
; | Created by   | GallyHomeCopr                         |
; | Graphix by   | GallyHomeCopr                         |
; +--------------+---------------------------------------+
; | Comments:    |                                       |
; +--------------+                                       |
; | 0.1.0 : COULEURS DE L'OS (+ COULEUR D'ACCENT),       |
; |         CORRECTION DES BUGS, PRISE EN CHARGE DPI,    |
; |         FLECHES DE DEFILEMENT GAUCHE / DROITE.       |
; | 0.1.1 : FORMES CARREES SANS BORDURE, ONGLET ACTIF    |
; |         FONDU DANS LE RIBBON (SANS SOULIGNE).        |
; +======================================================+

; +==========================+===========================+
; |    Operating System      |   Gestion Compilation     |
; +----------------------+---+-----------------------+---+
; | Window               | X | Gestion Thread        |   |
; | Linux (non teste)    |   | Gestion OnError       |   |
; | MacOS (non teste)    |   |                       | - |
; +----------------------+---+-----------------------+---+
; | x32                  | X | Droit Administrateur  |   |
; | X64                  | X | Droit particulier     |   |
; +======================+===+=======================+===+

; ****************************************************************************

DisableASM
CompilerIf #PB_Compiler_EnableExplicit
  EnableExplicit
CompilerEndIf

UsePNGImageDecoder()

; ****************************************************************************
;-DeclareModule

DeclareModule RibbonBar

  EnableExplicit

  #_RIBBON_MAX_BUTTON = 100

  Enumeration ribbon_item_commande 0 Step 1
    #Ribbon_Button
    #Ribbon_TextBox
    #Ribbon_CheckBox
    #Ribbon_OptionBox
    #Ribbon_ComboBox
    #Ribbon_Image
    #Ribbon_Separator
  EndEnumeration

  Enumeration ribbon_item_option
    #Ribbon_Normal        = 1 << 0
    #Ribbon_Toggle        = 1 << 1
    #Ribbon_Toggle_Option = 1 << 2
    #Ribbon_Size_48x64    = 1 << 3
    #Ribbon_Size_96x32    = 1 << 4
    #Ribbon_Size_48x32    = 1 << 5
    #Ribbon_Menu          = 1 << 6
    #Ribbon_Top           = 1 << 7
    #Ribbon_Bottom        = 1 << 8
    #Ribbon_Center        = 1 << 9
  EndEnumeration

  Enumeration ribbon_color 0 Step 1
    #Ribbon_Default                   ; COULEURS DE L'OS + COULEUR D'ACCENT WINDOWS.
    #Ribbon_Red
    #Ribbon_Green
    #Ribbon_Blue
    #Ribbon_Yellow
    #Ribbon_Pink
    #Ribbon_Dark
  EndEnumeration

  ; IDENTIFIANTS DU MENU SYSTEME : ILS ARRIVENT DANS LA FENETRE EN #PB_Event_Menu.
  Enumeration ribbon_system_menu 60000
    #Ribbon_SysMenu_New
    #Ribbon_SysMenu_Open
    #Ribbon_SysMenu_Save
    #Ribbon_SysMenu_SaveAs
    #Ribbon_SysMenu_Preference
    #Ribbon_SysMenu_Quit
  EndEnumeration

  Declare.i _CreateGadget           (gadget.i, text.s = #Null$, window.i = -1)
  Declare   _AddRibbonTab           (gadget.i, name.s)
  Declare   _AddRibbonItem          (gadget.i, tab_number.i, gadget_number.i, name.s, type.i, option.i, image.i)
  Declare.i _RibbonColor            (gadget.i, Color.l)
  Declare   _RibbonItemColor        (gadget.i, item.i, color.i)
  Declare   _AttachRibbonButtonPopup(gadget.i, button.i, popup.i)
  Declare.i _DisableMenuRibbon      (gadget.i, state.b)
  Declare   _DisableGadget          (gadget.i, value.b)
  Declare   _HideGadget             (gadget.i, value.b)
  Declare   _FreeGadget             (gadget.i)
  Declare.i _GetItemState           (gadget.i, item.i)
  Declare   _SetItemState           (gadget.i, item.i, state.i)
  Declare.i _GetSystemMenu          ()

EndDeclareModule

; ****************************************************************************
;-Module

Module RibbonBar

  EnableExplicit

  UsePNGImageDecoder()

  ; ****************************************************************************
  ;- CONSTANTES PRIVEES

  #_RIBBON_TAB_Y        = 24          ; HAUTEUR DE LA BARRE D'ONGLETS.
  #_RIBBON_BORDER_Y     = 90          ; HAUTEUR DE LA PAGE DES BOUTONS.
  #_RIBBON_TAB_MIN_W    = 60          ; LARGEUR MINIMALE D'UN ONGLET.
  #_RIBBON_TAB_TEXT_DY  = 2           ; DECALAGE VERS LE BAS DU TEXTE DES ONGLETS (ET DE L'ICONE MENU).
  #_RIBBON_MENU_X       = 40          ; LARGEUR DE LA ZONE DU MENU SYSTEME.
  #_RIBBON_ARROW_W      = 16          ; LARGEUR DES FLECHES DE DEFILEMENT.
  #_RIBBON_SCROLL_STEP  = 80          ; DEFILEMENT PAR CLIC SUR UNE FLECHE.
  #_RIBBON_WHEEL_STEP   = 60          ; DEFILEMENT PAR CRAN DE MOLETTE.

  ; ZONES RENVOYEES PAR LE TEST DE POSITION SOURIS.
  #_HIT_NONE            = 0
  #_HIT_SYSMENU         = 1
  #_HIT_LEFT            = 2
  #_HIT_RIGHT           = 3
  #_HIT_TAB             = 1000        ; + NUMERO D'ONGLET.
  #_HIT_ITEM            = 2000        ; + NUMERO D'ITEM (ZONE PRINCIPALE DU BOUTON).
  #_HIT_ARROW           = 3000        ; + NUMERO D'ITEM (FLECHE DE MENU DU BOUTON).

  ; ****************************************************************************
  ;- STRUCTURES

  Structure _STRUCTURE_RIBBON_ITEM
    TYPE.i
    HANDLE.i                          ; NUMERO RENVOYE PAR EventMenu().
    TEXT.s
    OPTION.i
    IMAGE.i                           ; 0 = PAS D'IMAGE.
    TOGGLE.i
    BUTTONMENU.i                      ; -1 = PAS DE POPUP.
    BACKCOLOR.i                       ; -1 = COULEUR DU THEME.
    X.i                               ; POSITION CALCULEE (UNITES LOGIQUES, SANS DEFILEMENT).
    Y.i
    W.i
    H.i
    AW.i                              ; LARGEUR DE LA FLECHE DE MENU (0 SI ABSENTE).
  EndStructure

  Structure _STRUCTURE_RIBBON_BUTTON
    RIBBON_PAGE_NUMBER.i
    RIBBON_SELS_TOGGLE.i
    RIBBON_SCROLL_X.i                 ; DEFILEMENT PROPRE A CHAQUE ONGLET.
    CONTENT_W.i                       ; LARGEUR TOTALE DES BOUTONS DE L'ONGLET.
    TAB_X0.i                          ; POSITION DE L'ONGLET DANS LA BARRE.
    TAB_W.i
    ITEM._STRUCTURE_RIBBON_ITEM[#_RIBBON_MAX_BUTTON + 1]   ; INDICES 1 A #_RIBBON_MAX_BUTTON.
  EndStructure

  Structure _STRUCTURE_RIBBON_COLOR
    TabBar.i
    TabHover.i
    Page.i
    Line.i
    Text.i
    TextDisabled.i
    Accent.i
    BtnHover.i
    BtnDown.i
    BtnChecked.i
    Sep.i
    Arrow.i
    ArrowDisabled.i
  EndStructure

  Structure _STRUCTURE_RIBBON
    WINDOW.i
    gadget.i
    gadgetid.i
    TITLE.s
    RIBBON_MENU_DISABLE.b
    DISABLE.b
    RIBBON_TABBAR_NUMBER.i
    RIBBON_TABBAR_SELECT.i
    SCROLL_ON.i
    SCROLL_MAX.i
    HOVER.i
    PRESSED.i
    SCALE.d                           ; PIXELS PAR UNITE LOGIQUE (DPI).
    COL._STRUCTURE_RIBBON_COLOR
    Array RIBBON_TABBAR.s(1)
    Array RIBBON_TABPAGE._STRUCTURE_RIBBON_BUTTON(1)
  EndStructure

  ; ****************************************************************************
  ;- GLOBALES

  Structure _STRUCTURE_RIBBON_CHEVRON
    X.d                               ; CENTRE, EN PIXELS DU CANVAS.
    Y.d
    SIZE.d                            ; DEMI-TAILLE, EN PIXELS.
    WIDTH.d                           ; EPAISSEUR DU TRAIT, EN PIXELS.
    SENS.i                            ; 0 = BAS, 1 = GAUCHE, 2 = DROITE.
    COLOR.i
  EndStructure

  Global NewMap _CREATE_RIBBON._STRUCTURE_RIBBON()
  Global NewList _RIBBON_ARROWLIST._STRUCTURE_RIBBON_CHEVRON()   ; FLECHES A TRACER EN VECTORIEL.
  Global _S.d = 1.0                   ; ECHELLE DU DESSIN EN COURS.
  Global Dim _RIBBON_MENU_ICON.i(5)
  Global _RIBBON_MENU_SYSTEM.i

  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Global _RIBBON_FONT_TAB.i  = LoadFont(#PB_Any, "Segoe UI", 9)
    Global _RIBBON_FONT_ITEM.i = LoadFont(#PB_Any, "Segoe UI", 8)
  CompilerElse
    Global _RIBBON_FONT_TAB.i  = LoadFont(#PB_Any, "Sans", 9)
    Global _RIBBON_FONT_ITEM.i = LoadFont(#PB_Any, "Sans", 8)
  CompilerEndIf

  ; CONVERSION UNITES LOGIQUES -> PIXELS DU CANVAS.
  Macro _PX(v)
    Int((v) * _S)
  EndMacro

  ; ****************************************************************************
  ;- OUTILS DE DESSIN

  Procedure.i _RIBBON_Thick()
    ;
    ; EPAISSEUR D'UN TRAIT D'1 UNITE LOGIQUE, EN PIXELS.
    ;
    Protected.i t = Int(_S + 0.5)
    If t < 1 : t = 1 : EndIf
    ProcedureReturn t

  EndProcedure

  Procedure _RIBBON_SetFont(font.i)

    If IsFont(font)
      DrawingFont(FontID(font))
    Else
      DrawingFont(#PB_Default)
    EndIf

  EndProcedure

  Procedure.i _RIBBON_Mix(c1.i, c2.i, f.f)
    ;
    ; MELANGE DE DEUX COULEURS (f = PART DE c2, DE 0.0 A 1.0).
    ;
    ProcedureReturn RGB(Red(c1)   + (Red(c2)   - Red(c1))   * f,
                        Green(c1) + (Green(c2) - Green(c1)) * f,
                        Blue(c1)  + (Blue(c2)  - Blue(c1))  * f)

  EndProcedure

  Procedure _RIBBON_HLine(x.i, y.i, w.i, color.i)

    DrawingMode(#PB_2DDrawing_Default)
    Box(_PX(x), _PX(y), _PX(w), _RIBBON_Thick(), color)

  EndProcedure

  Procedure _RIBBON_VLine(x.i, y.i, h.i, color.i)

    DrawingMode(#PB_2DDrawing_Default)
    Box(_PX(x), _PX(y), _RIBBON_Thick(), _PX(h), color)

  EndProcedure

  Procedure _RIBBON_FillBox(x.i, y.i, w.i, h.i, color.i)
    ;
    ; RECTANGLE PLEIN. LES BORDS SONT CALCULES SEPAREMENT POUR QUE DEUX ZONES
    ; COLLEES RESTENT COLLEES A TOUTES LES ECHELLES (PAS DE TROU D'1 PIXEL).
    ;
    DrawingMode(#PB_2DDrawing_Default)
    Box(_PX(x), _PX(y), _PX(x + w) - _PX(x), _PX(y + h) - _PX(y), color)

  EndProcedure

  Procedure _RIBBON_TextCenter(x.i, y.i, w.i, h.i, text.s, color.i)

    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(_PX(x) + (_PX(w) - TextWidth(text)) / 2, _PX(y) + (_PX(h) - TextHeight(text)) / 2, text, color)

  EndProcedure

  Procedure _RIBBON_Chevron(cx.d, cy.d, size.d, sens.i, color.i)
    ;
    ; CHEVRON CENTRE EN (cx, cy), EN UNITES LOGIQUES. sens : 0 = BAS, 1 = GAUCHE, 2 = DROITE.
    ;
    ; LE DESSIN 2D CLASSIQUE (LineXY) N'EST PAS LISSE : LES FLECHES SONT DONC
    ; MISES EN ATTENTE ICI, PUIS TRACEES EN VECTORIEL (ANTICRENELE, BOUTS ARRONDIS)
    ; PAR _RIBBON_DrawChevrons(), APRES LE StopDrawing().
    ;
    AddElement(_RIBBON_ARROWLIST())
    _RIBBON_ARROWLIST()\X     = cx   * _S
    _RIBBON_ARROWLIST()\Y     = cy   * _S
    _RIBBON_ARROWLIST()\SIZE  = size * _S
    _RIBBON_ARROWLIST()\WIDTH = 1.6  * _S
    _RIBBON_ARROWLIST()\SENS  = sens
    _RIBBON_ARROWLIST()\COLOR = color

  EndProcedure

  Procedure _RIBBON_DrawChevrons(gadget.i)
    ;
    ; TRACE VECTORIEL DES FLECHES MISES EN ATTENTE, PAR-DESSUS LE CANVAS DEJA DESSINE.
    ;
    Protected.d s
    ;
    If ListSize(_RIBBON_ARROWLIST()) = 0 : ProcedureReturn : EndIf
    ;
    If StartVectorDrawing(CanvasVectorOutput(gadget))
      ForEach _RIBBON_ARROWLIST()
        With _RIBBON_ARROWLIST()
          s = \SIZE
          Select \SENS
            Case 0
              MovePathCursor(\X - s,     \Y - s / 2)
              AddPathLine   (\X,         \Y + s / 2)
              AddPathLine   (\X + s,     \Y - s / 2)
            Case 1
              MovePathCursor(\X + s / 2, \Y - s)
              AddPathLine   (\X - s / 2, \Y)
              AddPathLine   (\X + s / 2, \Y + s)
            Case 2
              MovePathCursor(\X - s / 2, \Y - s)
              AddPathLine   (\X + s / 2, \Y)
              AddPathLine   (\X - s / 2, \Y + s)
          EndSelect
          VectorSourceColor(RGBA(Red(\COLOR), Green(\COLOR), Blue(\COLOR), 255))
          StrokePath(\WIDTH, #PB_Path_RoundEnd | #PB_Path_RoundCorner)
        EndWith
      Next
      StopVectorDrawing()
    EndIf
    ClearList(_RIBBON_ARROWLIST())

  EndProcedure

  ; ****************************************************************************
  ;- COULEURS

  CompilerIf #PB_Compiler_OS = #PB_OS_Windows

    Procedure.i _RIBBON_AccentColor()
      ;
      ; COULEUR D'ACCENT CHOISIE DANS LES PARAMETRES DE WINDOWS (REGISTRE DWM).
      ; LA VALEUR EST AU FORMAT $AABBGGRR : LES 24 BITS DU BAS SONT DIRECTEMENT
      ; UNE COULEUR PUREBASIC. SI ELLE EST ABSENTE, ON PREND COLOR_HIGHLIGHT.
      ;
      Protected.i hKey, result = -1
      Protected.l value, size = 4, type
      ;
      If RegOpenKeyEx_(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\DWM", 0, #KEY_READ, @hKey) = #ERROR_SUCCESS
        If RegQueryValueEx_(hKey, "AccentColor", 0, @type, @value, @size) = #ERROR_SUCCESS And type = #REG_DWORD
          result = value & $FFFFFF
        EndIf
        RegCloseKey_(hKey)
      EndIf
      ;
      If result = -1
        result = GetSysColor_(#COLOR_HIGHLIGHT)
      EndIf
      ProcedureReturn result

    EndProcedure

  CompilerEndIf

  Procedure _RIBBON_BuildPalette(*r._STRUCTURE_RIBBON, theme.i)
    ;
    ; TOUTES LES COULEURS SONT DEDUITES DE 6 COULEURS DE BASE (OS OU THEME),
    ; PAR MELANGE : C'EST ICI QU'IL FAUT TOUCHER POUR AJUSTER LE RENDU.
    ;
    Protected.i face, win, text, gray, shadow, accent, tint = -1, white = RGB(255, 255, 255)
    ;
    CompilerIf #PB_Compiler_OS = #PB_OS_Windows
      face    = GetSysColor_(#COLOR_BTNFACE)
      win     = GetSysColor_(#COLOR_WINDOW)
      text    = GetSysColor_(#COLOR_WINDOWTEXT)
      gray    = GetSysColor_(#COLOR_GRAYTEXT)
      shadow  = GetSysColor_(#COLOR_BTNSHADOW)
      accent  = _RIBBON_AccentColor()
    CompilerElse
      face    = RGB(240, 240, 240)
      win     = white
      text    = 0
      gray    = RGB(109, 109, 109)
      shadow  = RGB(160, 160, 160)
      accent  = RGB(0, 120, 215)
    CompilerEndIf
    ;
    Select theme
      Case #Ribbon_Red    : tint = RGB(196,  43,  28)
      Case #Ribbon_Green  : tint = RGB( 16, 124,  16)
      Case #Ribbon_Blue   : tint = RGB(  0,  95, 184)
      Case #Ribbon_Yellow : tint = RGB(193, 156,   0)
      Case #Ribbon_Pink   : tint = RGB(191,   0, 119)
      Case #Ribbon_Dark
        face    = RGB( 32,  32,  32)
        win     = RGB( 45,  45,  45)
        text    = white
        gray    = RGB(120, 120, 120)
        shadow  = RGB(110, 110, 110)
        accent  = _RIBBON_Mix(accent, white, 0.35)
    EndSelect
    If tint <> -1
      accent = tint
    EndIf
    ;
    With *r\COL
      \Accent           = accent
      \Page             = _RIBBON_Mix(face, win, 0.6)
      If tint <> -1
        \TabBar         = _RIBBON_Mix(face, tint, 0.15)
      Else
        \TabBar         = face
      EndIf
      \TabHover         = _RIBBON_Mix(\TabBar, shadow, 0.20)
      \Line             = _RIBBON_Mix(face,    shadow, 0.45)
      \Text             = text
      \TextDisabled     = gray
      \BtnHover         = _RIBBON_Mix(\Page,   accent, 0.12)
      \BtnDown          = _RIBBON_Mix(\Page,   accent, 0.30)
      \BtnChecked       = _RIBBON_Mix(\Page,   accent, 0.20)
      \Sep              = _RIBBON_Mix(\Page,   shadow, 0.45)
      \Arrow            = _RIBBON_Mix(text,    \Page,  0.30)
      \ArrowDisabled    = _RIBBON_Mix(\Page,   shadow, 0.40)
    EndWith

  EndProcedure

  ; ****************************************************************************
  ;- CALCUL DE LA DISPOSITION

  Procedure.i _RIBBON_SelectedPage(*r._STRUCTURE_RIBBON)
    ;
    ; ADRESSE DE LA PAGE DE L'ONGLET ACTIF (0 SI AUCUN ONGLET).
    ;
    If *r\RIBBON_TABBAR_SELECT >= 1 And *r\RIBBON_TABBAR_SELECT <= *r\RIBBON_TABBAR_NUMBER
      ProcedureReturn @*r\RIBBON_TABPAGE(*r\RIBBON_TABBAR_SELECT)
    EndIf
    ProcedureReturn 0

  EndProcedure

  Procedure.i _RIBBON_OriginX(*r._STRUCTURE_RIBBON, *p._STRUCTURE_RIBBON_BUTTON)
    ;
    ; DECALAGE A AJOUTER A LA POSITION D'UN ITEM POUR OBTENIR SA POSITION A L'ECRAN.
    ;
    If *r\SCROLL_ON
      ProcedureReturn #_RIBBON_ARROW_W - *p\RIBBON_SCROLL_X
    EndIf
    ProcedureReturn 0

  EndProcedure

  Procedure _RIBBON_LayoutItems(*r._STRUCTURE_RIBBON)
    ;
    ; CALCULE LA POSITION DE CHAQUE ITEM DE L'ONGLET ACTIF, LA LARGEUR TOTALE,
    ; ET DECIDE SI LES FLECHES DE DEFILEMENT SONT NECESSAIRES.
    ;
    Protected.i i, x, prevx, ybase, dx, dy, ry, half, w, maxs
    Protected *p._STRUCTURE_RIBBON_BUTTON = _RIBBON_SelectedPage(*r)
    ;
    If *p = 0
      *r\SCROLL_ON  = #False
      *r\SCROLL_MAX = 0
      ProcedureReturn
    EndIf
    ;
    x     = 10
    prevx = 10
    ybase = #_RIBBON_TAB_Y + (#_RIBBON_BORDER_Y - 68) / 2
    ;
    For i = 1 To *p\RIBBON_PAGE_NUMBER
      With *p\ITEM[i]
        Select \TYPE
          Case #Ribbon_Button
            dx   = 1
            dy   = 1
            ry   = 0
            half = #False
            If \OPTION & #Ribbon_Size_48x64
              dx = 2
            EndIf
            If \OPTION & #Ribbon_Size_96x32
              dy = 2 : ry = 1 : half = #True
            EndIf
            If \OPTION & #Ribbon_Size_48x32
              dx = 2 : dy = 2 : ry = 1 : half = #True
            EndIf
            ;
            \W = 96 / dx
            \H = (68 / dy) - ry
            \Y = ybase
            If half And \OPTION & #Ribbon_Bottom
              x  = prevx                        ; ON SE PLACE SOUS LE BOUTON PRECEDENT.
              \Y = ybase + (68 / dy) + ry
            EndIf
            \X  = x
            \AW = 0
            If \OPTION & #Ribbon_Menu
              \AW = 17
            EndIf
            prevx = x
            x + (100 / dx) + \AW
            ;
          Case #Ribbon_Separator
            x + 6
            \X  = x
            \Y  = #_RIBBON_TAB_Y + 8
            \W  = 1
            \H  = #_RIBBON_BORDER_Y - 16
            \AW = 0
            x + 10
            prevx = x                           ; UN BOUTON "BOTTOM" NE REPASSE PLUS AVANT LE SEPARATEUR.
            ;
          Default                               ; TYPES PAS ENCORE GERES : IGNORES.
            \W  = 0
            \H  = 0
            \AW = 0
        EndSelect
      EndWith
    Next i
    ;
    *p\CONTENT_W = x + 6
    ;
    w = GadgetWidth(*r\gadget)
    If w > 0 And *p\CONTENT_W > w
      *r\SCROLL_ON = #True
      maxs         = *p\CONTENT_W - (w - 2 * #_RIBBON_ARROW_W)
    Else
      *r\SCROLL_ON = #False
      maxs         = 0
    EndIf
    *r\SCROLL_MAX = maxs
    ;
    If *p\RIBBON_SCROLL_X > maxs : *p\RIBBON_SCROLL_X = maxs : EndIf
    If *p\RIBBON_SCROLL_X < 0    : *p\RIBBON_SCROLL_X = 0    : EndIf

  EndProcedure

  ; ****************************************************************************
  ;- DESSIN

  Procedure _RIBBON_Draw(*r._STRUCTURE_RIBBON)

    Protected.i w, h, i, tx, tw, menux, areal, arear, ox, bx, ax, cy, iw, ih, ix, iy, tcol
    Protected.i hoverMain, hoverArr, pressMain
    Protected.s text
    Protected *p._STRUCTURE_RIBBON_BUTTON
    Protected *c._STRUCTURE_RIBBON_COLOR = @*r\COL
    ;
    If Not IsGadget(*r\gadget) : ProcedureReturn : EndIf
    w = GadgetWidth (*r\gadget)
    h = GadgetHeight(*r\gadget)
    If w <= 0 Or h <= 0 : ProcedureReturn : EndIf
    ;
    _RIBBON_LayoutItems(*r)
    ;
    If StartDrawing(CanvasOutput(*r\gadget))
      ;
      ; ECHELLE PIXELS / UNITES LOGIQUES (1.0 A 100 %, 1.5 A 150 %...).
      ;
      _S        = OutputWidth()
      _S        / w
      *r\SCALE  = _S
      ;
      ; FONDS.
      ;
      DrawingMode(#PB_2DDrawing_Default)
      Box(0, 0, OutputWidth(), OutputHeight(),         *c\Page)
      Box(0, 0, OutputWidth(), _PX(#_RIBBON_TAB_Y),    *c\TabBar)
      _RIBBON_HLine(0, #_RIBBON_TAB_Y - 1, w,          *c\Line)
      ;
      ; BOUTON DU MENU SYSTEME.
      ;
      If *r\RIBBON_MENU_DISABLE
        menux = 4
      Else
        menux = #_RIBBON_MENU_X
        If *r\HOVER = #_HIT_SYSMENU And *r\DISABLE = #False
          _RIBBON_FillBox(4, 3, menux - 8, #_RIBBON_TAB_Y - 4, *c\TabHover)
        EndIf
        If *r\DISABLE : tcol = *c\ArrowDisabled : Else : tcol = *c\Arrow : EndIf
        cy = (#_RIBBON_TAB_Y - 1) / 2 + #_RIBBON_TAB_TEXT_DY
        For i = -1 To 1
          _RIBBON_HLine(menux / 2 - 6, cy + i * 4, 12, tcol)
        Next i
      EndIf
      ;
      ; ONGLETS (LARGEUR SELON LE TEXTE).
      ;
      _RIBBON_SetFont(_RIBBON_FONT_TAB)
      tx = menux
      For i = 1 To *r\RIBBON_TABBAR_NUMBER
        text = *r\RIBBON_TABBAR(i)
        tw   = TextWidth(text) / _S + 28
        If tw < #_RIBBON_TAB_MIN_W : tw = #_RIBBON_TAB_MIN_W : EndIf
        *r\RIBBON_TABPAGE(i)\TAB_X0 = tx
        *r\RIBBON_TABPAGE(i)\TAB_W  = tw
        ;
        If i = *r\RIBBON_TABBAR_SELECT
          ;
          ; ONGLET ACTIF : FOND DE LA PAGE DU HAUT DE L'ONGLET JUSQU'AU RIBBON.
          ; IL RECOUVRE LA LIGNE DE SEPARATION, L'ONGLET ET LA PAGE NE FONT QU'UN.
          ; CADRE CARRE A GAUCHE, EN HAUT ET A DROITE (PAS EN BAS), QUI REJOINT
          ; LA LIGNE DE SEPARATION DE CHAQUE COTE.
          ;
          _RIBBON_FillBox(tx,          3, tw, #_RIBBON_TAB_Y - 3, *c\Page)
          _RIBBON_HLine  (tx,          3, tw,                     *c\Line)
          _RIBBON_VLine  (tx,          3,     #_RIBBON_TAB_Y - 3, *c\Line)
          _RIBBON_VLine  (tx + tw - 1, 3,     #_RIBBON_TAB_Y - 3, *c\Line)
        ElseIf *r\HOVER = #_HIT_TAB + i And *r\DISABLE = #False
          _RIBBON_FillBox(tx, 3, tw, #_RIBBON_TAB_Y - 4, *c\TabHover)
        EndIf
        ;
        If *r\DISABLE : tcol = *c\TextDisabled : Else : tcol = *c\Text : EndIf
        _RIBBON_TextCenter(tx, 3 + #_RIBBON_TAB_TEXT_DY, tw, #_RIBBON_TAB_Y - 7, text, tcol)
        tx + tw + 2
      Next i
      ;
      ; ITEMS DE L'ONGLET ACTIF (DESSINES ENTRE LES FLECHES, AVEC DECOUPAGE).
      ;
      *p = _RIBBON_SelectedPage(*r)
      If *p
        areal = 0
        arear = w
        If *r\SCROLL_ON
          areal = #_RIBBON_ARROW_W
          arear = w - #_RIBBON_ARROW_W
        EndIf
        ox = _RIBBON_OriginX(*r, *p)
        ;
        ClipOutput(_PX(areal), _PX(#_RIBBON_TAB_Y), _PX(arear - areal), _PX(#_RIBBON_BORDER_Y - 1))
        _RIBBON_SetFont(_RIBBON_FONT_ITEM)
        ;
        For i = 1 To *p\RIBBON_PAGE_NUMBER
          With *p\ITEM[i]
            Select \TYPE
              Case #Ribbon_Button
                ;
                bx = ox + \X
                If bx + \W + \AW < areal Or bx > arear
                  Continue                      ; HORS DE LA ZONE VISIBLE.
                EndIf
                ;
                hoverMain = Bool(*r\HOVER   = #_HIT_ITEM  + i And *r\DISABLE = #False)
                hoverArr  = Bool(*r\HOVER   = #_HIT_ARROW + i And *r\DISABLE = #False)
                pressMain = Bool(*r\PRESSED = #_HIT_ITEM  + i And hoverMain)
                ;
                ; FOND DU BOUTON (CARRE, SANS BORDURE).
                ;   APPUYE  > BtnDown
                ;   BASCULE > BtnChecked (BtnDown SI SURVOLE)
                ;   SURVOL  > BtnHover
                ;
                If pressMain
                  _RIBBON_FillBox(bx, \Y, \W, \H, *c\BtnDown)
                ElseIf \TOGGLE
                  If hoverMain
                    _RIBBON_FillBox(bx, \Y, \W, \H, *c\BtnDown)
                  Else
                    _RIBBON_FillBox(bx, \Y, \W, \H, *c\BtnChecked)
                  EndIf
                ElseIf hoverMain
                  _RIBBON_FillBox(bx, \Y, \W, \H, *c\BtnHover)
                ElseIf \BACKCOLOR <> -1
                  _RIBBON_FillBox(bx, \Y, \W, \H, \BACKCOLOR)
                EndIf
                ;
                ; FLECHE DE MENU, COLLEE A DROITE DU BOUTON.
                ;
                If \AW
                  ax = bx + \W
                  If hoverArr
                    If \TOGGLE
                      _RIBBON_FillBox(ax, \Y, \AW, \H, *c\BtnDown)
                    Else
                      _RIBBON_FillBox(ax, \Y, \AW, \H, *c\BtnHover)
                    EndIf
                  ElseIf \TOGGLE
                    _RIBBON_FillBox(ax, \Y, \AW, \H, *c\BtnChecked)
                  EndIf
                  If *r\DISABLE : tcol = *c\ArrowDisabled : Else : tcol = *c\Arrow : EndIf
                  ;
                  ; LE TRACE VECTORIEL N'EST PAS DECOUPE PAR ClipOutput : ON NE MET LA
                  ; FLECHE QUE SI ELLE EST ENTIEREMENT DANS LA ZONE VISIBLE.
                  ;
                  If ax + \AW / 2 - 5 >= areal And ax + \AW / 2 + 5 <= arear
                    _RIBBON_Chevron(ax + \AW / 2.0, \Y + \H / 2.0, 3.5, 0, tcol)
                  EndIf
                EndIf
                ;
                ; IMAGE (REDIMENSIONNEE SELON LE DPI).
                ;
                If \IMAGE And IsImage(\IMAGE)
                  iw = _PX(ImageWidth (\IMAGE))
                  ih = _PX(ImageHeight(\IMAGE))
                  ix = _PX(bx) + (_PX(\W) - iw) / 2
                  If \TEXT = #Null$
                    iy = _PX(\Y) + (_PX(\H) - ih) / 2
                  Else
                    iy = _PX(\Y) + ((_PX(\H) - (TextHeight(\TEXT) + _PX(4))) - ih) / 2
                  EndIf
                  DrawingMode(#PB_2DDrawing_AlphaBlend)
                  DrawImage(ImageID(\IMAGE), ix, iy, iw, ih)
                EndIf
                ;
                ; TEXTE.
                ;
                If *r\DISABLE : tcol = *c\TextDisabled : Else : tcol = *c\Text : EndIf
                DrawingMode(#PB_2DDrawing_Transparent)
                If \H <= 48
                  DrawText(_PX(bx) + (_PX(\W) - TextWidth(\TEXT)) / 2, _PX(\Y) + (_PX(\H) - TextHeight(\TEXT)) / 2, \TEXT, tcol)
                Else
                  DrawText(_PX(bx) + (_PX(\W) - TextWidth(\TEXT)) / 2, _PX(\Y + \H - 6) - TextHeight(\TEXT), \TEXT, tcol)
                EndIf
                ;
              Case #Ribbon_Separator
                _RIBBON_VLine(ox + \X, \Y, \H, *c\Sep)
            EndSelect
          EndWith
        Next i
        ;
        UnclipOutput()
        ;
        ; FLECHES DE DEFILEMENT.
        ;
        If *r\SCROLL_ON
          ; GAUCHE.
          If *r\HOVER = #_HIT_LEFT And *p\RIBBON_SCROLL_X > 0
            _RIBBON_FillBox(0, #_RIBBON_TAB_Y, #_RIBBON_ARROW_W - 1, #_RIBBON_BORDER_Y - 1, *c\BtnHover)
          EndIf
          If *p\RIBBON_SCROLL_X > 0 And *r\DISABLE = #False : tcol = *c\Arrow : Else : tcol = *c\ArrowDisabled : EndIf
          _RIBBON_Chevron(#_RIBBON_ARROW_W / 2.0, #_RIBBON_TAB_Y + #_RIBBON_BORDER_Y / 2.0, 5, 1, tcol)
          _RIBBON_VLine  (#_RIBBON_ARROW_W - 1, #_RIBBON_TAB_Y + 4, #_RIBBON_BORDER_Y - 9, *c\Line)
          ; DROITE.
          If *r\HOVER = #_HIT_RIGHT And *p\RIBBON_SCROLL_X < *r\SCROLL_MAX
            _RIBBON_FillBox(w - #_RIBBON_ARROW_W + 1, #_RIBBON_TAB_Y, #_RIBBON_ARROW_W - 1, #_RIBBON_BORDER_Y - 1, *c\BtnHover)
          EndIf
          If *p\RIBBON_SCROLL_X < *r\SCROLL_MAX And *r\DISABLE = #False : tcol = *c\Arrow : Else : tcol = *c\ArrowDisabled : EndIf
          _RIBBON_Chevron(w - #_RIBBON_ARROW_W / 2.0, #_RIBBON_TAB_Y + #_RIBBON_BORDER_Y / 2.0, 5, 2, tcol)
          _RIBBON_VLine  (w - #_RIBBON_ARROW_W,     #_RIBBON_TAB_Y + 4, #_RIBBON_BORDER_Y - 9, *c\Line)
        EndIf
      EndIf
      ;
      ; LIGNE DU BAS.
      ;
      _RIBBON_HLine(0, h - 1, w, *c\Line)
      ;
      StopDrawing()
      ;
      ; 2E PASSE : LES FLECHES EN VECTORIEL (LISSEES).
      ;
      _RIBBON_DrawChevrons(*r\gadget)
    EndIf

  EndProcedure

  ; ****************************************************************************
  ;- SOURIS

  Procedure.i _RIBBON_HitTest(*r._STRUCTURE_RIBBON, mx.i, my.i)
    ;
    ; RENVOIE LA ZONE SOUS LA SOURIS (COORDONNEES EN UNITES LOGIQUES).
    ;
    Protected.i i, w, h, lx
    Protected *p._STRUCTURE_RIBBON_BUTTON
    ;
    w = GadgetWidth (*r\gadget)
    h = GadgetHeight(*r\gadget)
    If mx < 0 Or my < 0 Or mx >= w Or my >= h
      ProcedureReturn #_HIT_NONE
    EndIf
    ;
    ; BARRE D'ONGLETS.
    ;
    If my < #_RIBBON_TAB_Y
      If *r\RIBBON_MENU_DISABLE = #False And mx >= 4 And mx < #_RIBBON_MENU_X - 4
        ProcedureReturn #_HIT_SYSMENU
      EndIf
      For i = 1 To *r\RIBBON_TABBAR_NUMBER
        If mx >= *r\RIBBON_TABPAGE(i)\TAB_X0 And mx < *r\RIBBON_TABPAGE(i)\TAB_X0 + *r\RIBBON_TABPAGE(i)\TAB_W
          ProcedureReturn #_HIT_TAB + i
        EndIf
      Next i
      ProcedureReturn #_HIT_NONE
    EndIf
    ;
    ; PAGE : FLECHES PUIS ITEMS.
    ;
    *p = _RIBBON_SelectedPage(*r)
    If *p = 0
      ProcedureReturn #_HIT_NONE
    EndIf
    If *r\SCROLL_ON
      If mx < #_RIBBON_ARROW_W      : ProcedureReturn #_HIT_LEFT  : EndIf
      If mx >= w - #_RIBBON_ARROW_W : ProcedureReturn #_HIT_RIGHT : EndIf
    EndIf
    ;
    lx = mx - _RIBBON_OriginX(*r, *p)
    For i = 1 To *p\RIBBON_PAGE_NUMBER
      With *p\ITEM[i]
        If \TYPE = #Ribbon_Button And my >= \Y And my < \Y + \H
          If \AW And lx >= \X + \W And lx < \X + \W + \AW
            ProcedureReturn #_HIT_ARROW + i
          EndIf
          If lx >= \X And lx < \X + \W
            ProcedureReturn #_HIT_ITEM + i
          EndIf
        EndIf
      EndWith
    Next i
    ;
    ProcedureReturn #_HIT_NONE

  EndProcedure

  Procedure _RIBBON_Refresh(*r._STRUCTURE_RIBBON, mx.i, my.i)
    ;
    ; APRES UN DEFILEMENT OU UN CHANGEMENT D'ONGLET : RECALCULE LE SURVOL PUIS REDESSINE.
    ;
    _RIBBON_LayoutItems(*r)
    *r\HOVER = _RIBBON_HitTest(*r, mx, my)
    _RIBBON_Draw(*r)

  EndProcedure

  Procedure _RIBBON_ShowPopup(*r._STRUCTURE_RIBBON, menu.i, x.i, y.i)
    ;
    ; AFFICHE UN POPUP SOUS LA ZONE CLIQUEE (x, y EN UNITES LOGIQUES DU GADGET).
    ;
    *r\HOVER   = #_HIT_NONE
    *r\PRESSED = #_HIT_NONE
    _RIBBON_Draw(*r)
    ;
    If IsMenu(menu) And IsWindow(*r\WINDOW)
      DisplayPopupMenu(menu, WindowID(*r\WINDOW), GadgetX(*r\gadget, #PB_Gadget_ScreenCoordinate) + x, GadgetY(*r\gadget, #PB_Gadget_ScreenCoordinate) + y)
    EndIf

  EndProcedure

  Procedure _RIBBON_ItemAction(*r._STRUCTURE_RIBBON, *p._STRUCTURE_RIBBON_BUTTON, index.i)
    ;
    ; CLIC VALIDE SUR UN BOUTON : GESTION DES BASCULES, PUIS EVENEMENT MENU A LA FENETRE.
    ;
    Protected.i j
    ;
    If *p\ITEM[index]\OPTION & #Ribbon_Toggle_Option
      For j = 1 To *p\RIBBON_PAGE_NUMBER
        If *p\ITEM[j]\OPTION & #Ribbon_Toggle_Option
          *p\ITEM[j]\TOGGLE = #False
        EndIf
      Next j
      *p\ITEM[index]\TOGGLE = #True
      *p\RIBBON_SELS_TOGGLE = index
    ElseIf *p\ITEM[index]\OPTION & #Ribbon_Toggle
      *p\ITEM[index]\TOGGLE = Bool(*p\ITEM[index]\TOGGLE = #False)
    EndIf
    ;
    PostEvent(#PB_Event_Menu, *r\WINDOW, *p\ITEM[index]\HANDLE)

  EndProcedure

  Procedure _RIBBON_OnEvent()

    Protected.i gadget = EventGadget(), event = EventType(), mx, my, hit, i
    Protected *r._STRUCTURE_RIBBON = FindMapElement(_CREATE_RIBBON(), Str(gadget))
    Protected *p._STRUCTURE_RIBBON_BUTTON
    ;
    If *r = 0 Or *r\DISABLE
      ProcedureReturn
    EndIf
    If *r\SCALE <= 0
      *r\SCALE = 1.0
    EndIf
    ;
    mx = GetGadgetAttribute(gadget, #PB_Canvas_MouseX) / *r\SCALE
    my = GetGadgetAttribute(gadget, #PB_Canvas_MouseY) / *r\SCALE
    *p = _RIBBON_SelectedPage(*r)
    ;
    Select event
      Case #PB_EventType_Resize
        _RIBBON_Draw(*r)
        ;
      Case #PB_EventType_MouseMove, #PB_EventType_MouseEnter
        hit = _RIBBON_HitTest(*r, mx, my)
        If hit <> *r\HOVER                      ; ON NE REDESSINE QUE SI LE SURVOL CHANGE.
          *r\HOVER = hit
          _RIBBON_Draw(*r)
        EndIf
        ;
      Case #PB_EventType_MouseLeave
        If *r\HOVER Or *r\PRESSED
          *r\HOVER   = #_HIT_NONE
          *r\PRESSED = #_HIT_NONE
          _RIBBON_Draw(*r)
        EndIf
        ;
      Case #PB_EventType_LeftButtonDown
        hit      = _RIBBON_HitTest(*r, mx, my)
        *r\HOVER = hit
        Select hit
          Case #_HIT_SYSMENU
            _RIBBON_ShowPopup(*r, _RIBBON_MENU_SYSTEM, 4, #_RIBBON_TAB_Y)
          Case #_HIT_LEFT
            *p\RIBBON_SCROLL_X - #_RIBBON_SCROLL_STEP
            _RIBBON_Refresh(*r, mx, my)
          Case #_HIT_RIGHT
            *p\RIBBON_SCROLL_X + #_RIBBON_SCROLL_STEP
            _RIBBON_Refresh(*r, mx, my)
          Case #_HIT_TAB + 1 To #_HIT_TAB + 999
            *r\RIBBON_TABBAR_SELECT = hit - #_HIT_TAB
            _RIBBON_Refresh(*r, mx, my)
          Case #_HIT_ITEM + 1 To #_HIT_ITEM + 999
            *r\PRESSED = hit                    ; L'ACTION AURA LIEU AU RELACHEMENT.
            _RIBBON_Draw(*r)
          Case #_HIT_ARROW + 1 To #_HIT_ARROW + 999
            i = hit - #_HIT_ARROW
            _RIBBON_ShowPopup(*r, *p\ITEM[i]\BUTTONMENU, _RIBBON_OriginX(*r, *p) + *p\ITEM[i]\X, *p\ITEM[i]\Y + *p\ITEM[i]\H)
          Default
            _RIBBON_Draw(*r)
        EndSelect
        ;
      Case #PB_EventType_LeftButtonUp
        hit = _RIBBON_HitTest(*r, mx, my)
        If *r\PRESSED > #_HIT_ITEM And *r\PRESSED < #_HIT_ARROW And hit = *r\PRESSED And *p
          _RIBBON_ItemAction(*r, *p, *r\PRESSED - #_HIT_ITEM)
        EndIf
        *r\PRESSED = #_HIT_NONE
        *r\HOVER   = hit
        _RIBBON_Draw(*r)
        ;
      Case #PB_EventType_MouseWheel
        If *r\SCROLL_ON And *p
          *p\RIBBON_SCROLL_X - GetGadgetAttribute(gadget, #PB_Canvas_WheelDelta) * #_RIBBON_WHEEL_STEP
          _RIBBON_Refresh(*r, mx, my)
        EndIf
    EndSelect

  EndProcedure

  Procedure _RIBBON_Resize()
    ;
    ; LE RIBBON SUIT LA LARGEUR DE SA FENETRE.
    ;
    Protected.i window = EventWindow()
    ;
    ForEach _CREATE_RIBBON()
      If _CREATE_RIBBON()\WINDOW = window And IsGadget(_CREATE_RIBBON()\gadget)
        ResizeGadget(_CREATE_RIBBON()\gadget, #PB_Ignore, #PB_Ignore, WindowWidth(window), #PB_Ignore)
        _RIBBON_Draw(@_CREATE_RIBBON())
      EndIf
    Next

  EndProcedure

  ; ****************************************************************************
  ;- MENU SYSTEME

  Procedure.i _RIBBON_IconID(index.i)

    If IsImage(_RIBBON_MENU_ICON(index))
      ProcedureReturn ImageID(_RIBBON_MENU_ICON(index))
    EndIf
    ProcedureReturn 0

  EndProcedure

  Procedure _RIBBON_InitSystemMenu()

    Protected.i i, img
    ;
    img = CatchImage(#PB_Any, ?icon_menu_system_png_start, ?icon_menu_system_png_end - ?icon_menu_system_png_start)
    If img
      For i = 0 To 5
        _RIBBON_MENU_ICON(i) = GrabImage(img, #PB_Any, i * 16, 0, 16, 16)
      Next i
      FreeImage(img)
    EndIf
    ;
    _RIBBON_MENU_SYSTEM = CreatePopupImageMenu(#PB_Any)
    If _RIBBON_MENU_SYSTEM
      MenuItem(#Ribbon_SysMenu_New,        "Nouveau"     + Chr(9) + "Ctrl+N", _RIBBON_IconID(0))
      MenuItem(#Ribbon_SysMenu_Open,       "Ouvrir..."   + Chr(9) + "Ctrl+O", _RIBBON_IconID(1))
      MenuBar()
      MenuItem(#Ribbon_SysMenu_Save,       "Enregistrer" + Chr(9) + "Ctrl+S", _RIBBON_IconID(2))
      MenuItem(#Ribbon_SysMenu_SaveAs,     "Enregistrer sous...",             _RIBBON_IconID(3))
      MenuBar()
      MenuItem(#Ribbon_SysMenu_Preference, "Préférences",                     _RIBBON_IconID(4))
      MenuBar()
      MenuItem(#Ribbon_SysMenu_Quit,       "Quitter",                         _RIBBON_IconID(5))
    EndIf

  EndProcedure

  _RIBBON_InitSystemMenu()

  ; ****************************************************************************
  ;- FONCTIONS PUBLIQUES

  Procedure.i _RIBBON_Get(gadget.i)

    ProcedureReturn FindMapElement(_CREATE_RIBBON(), Str(gadget))

  EndProcedure

  Procedure.i _CreateGadget(gadget.i, text.s = #Null$, window.i = -1)

    Protected.i result, number, bound = #False
    Protected *r._STRUCTURE_RIBBON
    ;
    If window = -1
      window = GetActiveWindow()
    EndIf
    If Not IsWindow(window)
      ProcedureReturn 0
    EndIf
    ;
    result = CanvasGadget(gadget, 0, 0, WindowWidth(window), #_RIBBON_TAB_Y + #_RIBBON_BORDER_Y, #PB_Canvas_Container | #PB_Canvas_Keyboard)
    If result = 0
      ProcedureReturn 0
    EndIf
    CloseGadgetList()
    ;
    If gadget = #PB_Any
      number = result
    Else
      number = gadget
    EndIf
    ;
    ; UN SEUL BindEvent PAR FENETRE, MEME AVEC PLUSIEURS RIBBONS.
    ;
    ForEach _CREATE_RIBBON()
      If _CREATE_RIBBON()\WINDOW = window
        bound = #True
      EndIf
    Next
    ;
    *r = AddMapElement(_CREATE_RIBBON(), Str(number))
    *r\WINDOW               = window
    *r\gadget               = number
    *r\gadgetid             = GadgetID(number)
    *r\TITLE                = text
    *r\RIBBON_TABBAR_SELECT = 1
    *r\RIBBON_MENU_DISABLE  = #False
    *r\SCALE                = 1.0
    ;
    _RIBBON_BuildPalette(*r, #Ribbon_Default)
    _RIBBON_Draw(*r)
    ;
    BindGadgetEvent(number, @_RIBBON_OnEvent())
    If bound = #False
      BindEvent(#PB_Event_SizeWindow, @_RIBBON_Resize(), window)
    EndIf
    ;
    ProcedureReturn result

  EndProcedure

  Procedure _AddRibbonTab(gadget.i, name.s)

    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn : EndIf
    ;
    *r\RIBBON_TABBAR_NUMBER + 1
    ReDim *r\RIBBON_TABBAR (*r\RIBBON_TABBAR_NUMBER)
    ReDim *r\RIBBON_TABPAGE(*r\RIBBON_TABBAR_NUMBER)
    *r\RIBBON_TABBAR(*r\RIBBON_TABBAR_NUMBER) = name
    ;
    _RIBBON_Draw(*r)

  EndProcedure

  Procedure _AddRibbonItem(gadget.i, tab_number.i, gadget_number.i, name.s, type.i, option.i, image.i)

    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    Protected *p._STRUCTURE_RIBBON_BUTTON
    ;
    If *r = 0 : ProcedureReturn : EndIf
    If tab_number < 1 Or tab_number > *r\RIBBON_TABBAR_NUMBER : ProcedureReturn : EndIf
    ;
    *p = @*r\RIBBON_TABPAGE(tab_number)
    If *p\RIBBON_PAGE_NUMBER >= #_RIBBON_MAX_BUTTON : ProcedureReturn : EndIf
    ;
    If type = #Ribbon_Separator
      name   = #Null$
      option = 0
      image  = 0
    EndIf
    ;
    *p\RIBBON_PAGE_NUMBER + 1
    With *p\ITEM[*p\RIBBON_PAGE_NUMBER]
      \TYPE       = type
      \HANDLE     = gadget_number
      \TEXT       = name
      \OPTION     = option
      \IMAGE      = image
      \TOGGLE     = #False
      \BUTTONMENU = -1
      \BACKCOLOR  = -1
      ;
      ; LE PREMIER BOUTON D'UN GROUPE D'OPTIONS EST SELECTIONNE PAR DEFAUT.
      ;
      If option & #Ribbon_Toggle_Option And *p\RIBBON_SELS_TOGGLE = 0
        *p\RIBBON_SELS_TOGGLE = *p\RIBBON_PAGE_NUMBER
        \TOGGLE               = #True
      EndIf
    EndWith
    ;
    _RIBBON_Draw(*r)

  EndProcedure

  Procedure.i _RibbonColor(gadget.i, Color.l)

    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn #False : EndIf
    _RIBBON_BuildPalette(*r, Color)
    _RIBBON_Draw(*r)
    ProcedureReturn #True

  EndProcedure

  Procedure _RibbonItemColor(gadget.i, item.i, color.i)
    ;
    ; COULEUR DE FOND D'UN BOUTON AU REPOS (-1 = COULEUR DU THEME).
    ;
    Protected.i i, j
    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn : EndIf
    For j = 1 To *r\RIBBON_TABBAR_NUMBER
      For i = 1 To *r\RIBBON_TABPAGE(j)\RIBBON_PAGE_NUMBER
        If *r\RIBBON_TABPAGE(j)\ITEM[i]\TYPE = #Ribbon_Button And *r\RIBBON_TABPAGE(j)\ITEM[i]\HANDLE = item
          *r\RIBBON_TABPAGE(j)\ITEM[i]\BACKCOLOR = color
        EndIf
      Next i
    Next j
    _RIBBON_Draw(*r)

  EndProcedure

  Procedure _AttachRibbonButtonPopup(gadget.i, button.i, popup.i)

    Protected.i i, j
    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn : EndIf
    For j = 1 To *r\RIBBON_TABBAR_NUMBER
      For i = 1 To *r\RIBBON_TABPAGE(j)\RIBBON_PAGE_NUMBER
        If *r\RIBBON_TABPAGE(j)\ITEM[i]\TYPE = #Ribbon_Button And *r\RIBBON_TABPAGE(j)\ITEM[i]\HANDLE = button
          *r\RIBBON_TABPAGE(j)\ITEM[i]\BUTTONMENU = popup
        EndIf
      Next i
    Next j

  EndProcedure

  Procedure.i _DisableMenuRibbon(gadget.i, state.b)

    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn #False : EndIf
    *r\RIBBON_MENU_DISABLE = Bool(state)
    _RIBBON_Draw(*r)
    ProcedureReturn #True

  EndProcedure

  Procedure _DisableGadget(gadget.i, value.b)

    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn : EndIf
    *r\DISABLE = Bool(value)
    *r\HOVER   = #_HIT_NONE
    *r\PRESSED = #_HIT_NONE
    DisableGadget(gadget, value)
    _RIBBON_Draw(*r)

  EndProcedure

  Procedure _HideGadget(gadget.i, value.b)

    If _RIBBON_Get(gadget)
      HideGadget(gadget, value)
    EndIf

  EndProcedure

  Procedure _FreeGadget(gadget.i)

    Protected.i window, other = #False
    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r = 0 : ProcedureReturn : EndIf
    ;
    window = *r\WINDOW
    UnbindGadgetEvent(gadget, @_RIBBON_OnEvent())
    If IsGadget(gadget)
      FreeGadget(gadget)
    EndIf
    DeleteMapElement(_CREATE_RIBBON(), Str(gadget))
    ;
    ; ON NE DETACHE LE REDIMENSIONNEMENT QUE S'IL N'Y A PLUS DE RIBBON DANS CETTE FENETRE.
    ;
    ForEach _CREATE_RIBBON()
      If _CREATE_RIBBON()\WINDOW = window
        other = #True
      EndIf
    Next
    If other = #False
      UnbindEvent(#PB_Event_SizeWindow, @_RIBBON_Resize(), window)
    EndIf

  EndProcedure

  Procedure.i _GetItemState(gadget.i, item.i)
    ;
    ; ETAT D'UN BOUTON BASCULE (#True / #False), -1 SI INTROUVABLE.
    ;
    Protected.i i, j
    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    ;
    If *r
      For j = 1 To *r\RIBBON_TABBAR_NUMBER
        For i = 1 To *r\RIBBON_TABPAGE(j)\RIBBON_PAGE_NUMBER
          If *r\RIBBON_TABPAGE(j)\ITEM[i]\TYPE = #Ribbon_Button And *r\RIBBON_TABPAGE(j)\ITEM[i]\HANDLE = item
            ProcedureReturn *r\RIBBON_TABPAGE(j)\ITEM[i]\TOGGLE
          EndIf
        Next i
      Next j
    EndIf
    ProcedureReturn -1

  EndProcedure

  Procedure _SetItemState(gadget.i, item.i, state.i)

    Protected.i i, j, k
    Protected *r._STRUCTURE_RIBBON = _RIBBON_Get(gadget)
    Protected *p._STRUCTURE_RIBBON_BUTTON
    ;
    If *r = 0 : ProcedureReturn : EndIf
    For j = 1 To *r\RIBBON_TABBAR_NUMBER
      *p = @*r\RIBBON_TABPAGE(j)
      For i = 1 To *p\RIBBON_PAGE_NUMBER
        If *p\ITEM[i]\TYPE = #Ribbon_Button And *p\ITEM[i]\HANDLE = item
          If state And *p\ITEM[i]\OPTION & #Ribbon_Toggle_Option
            For k = 1 To *p\RIBBON_PAGE_NUMBER
              If *p\ITEM[k]\OPTION & #Ribbon_Toggle_Option
                *p\ITEM[k]\TOGGLE = #False
              EndIf
            Next k
            *p\RIBBON_SELS_TOGGLE = i
          EndIf
          *p\ITEM[i]\TOGGLE = Bool(state)
        EndIf
      Next i
    Next j
    _RIBBON_Draw(*r)

  EndProcedure

  Procedure.i _GetSystemMenu()
    ;
    ; NUMERO DU POPUP SYSTEME (POUR SetMenuItemText, DisableMenuItem...).
    ;
    ProcedureReturn _RIBBON_MENU_SYSTEM

  EndProcedure

  DataSection
  icon_menu_system_png_start:
    Data.q $0A1A0A0D474E5089,$524448490D000000,$1000000060000000,$7ABAE90000000608,$59487009000000F9,$0B0000130B000073,$0000189C9A000113,$00004D5248632000
    Data.q $000085800000447A,$00000E82000041FB,$0000F2F00000947C,$2C9D671A0000923A,$44491E020000A2D8,$4B4B58DCDA785441,$48B452773E145102,$AB415573BDB69822
    Data.q $AAAE203FC2D95681,$FF0AB575C48BF8B5,$5AA12B30936C3D80,$D2443038216918B5,$7BD464642DBAB14B,$7C0E203D464C63EE,$731E7BBEF9DCCCE7,$70291E1FEE14A509
    Data.q $0C101C4C381C71CC,$EC2DAF78DCD2546F,$C74A2D9F27DCF45D,$F5EBC5C3353D6CB2,$3EF73F111F1C9C3A,$C65E3BE000A73B3D,$A8D08A800000AC88,$02FDB401316869A4
    Data.q $822D26AB6FC0EDB4,$7CE8B5292E4C8057,$F25D121F8024A8B6,$4DF38A9A08951B5D,$98A13F5A84C296E9,$96830D97844FCF0F,$4C8BEA9A60AA830D,$BDC227E58C5E08AB
    Data.q $2F3F34C3CD13F6E4,$8D12E61FF099ED32,$2A08A34C0250C465,$97849A6FBBE59E35,$AEBA81E6485F9815,$D6D818951FC91C4F,$A75DF91BB12C002B,$4B856582497267F9
    Data.q $49A6FB474D8E3F74,$D4A60852259E3B78,$89493B9593E3E43A,$022B20BEB1AF77C8,$D812ADB00440FC8B,$CBC6F08729E34E96,$0B4112C414DE3549,$087A2C7D054FA16A
    Data.q $D4562B0F5345FB56,$87D1209558F85970,$7AD51189910C9F98,$BD491AC3B2B0D119,$45B3E70A5B8DA099,$53C6C0EFCDDAD229,$640FF6AC64975F19,$66AFE0B4A2346CC0
    Data.q $DCD8556B9EA1502B,$01E595D5800002D8,$35E8A3559A2A82DC,$66EB0F3A4FDEDDDE,$6F6905FA561C3840,$652A7D68BFCF67CE,$DB1725DC22312B08,$A2244880CDD618F1
    Data.q $39F4C402607BC2C8,$B7F21A3841AFCE88,$D64D63E7EC86C576,$26D9DDDB31434EA4,$5EEA55B6D1C76A00,$933A38E6190E53C7,$55BC666BABCB924B,$3CA3F5A9978A91F8
    Data.q $634EEE9C001BFE8E,$00000000A51A5984,$826042AE444E4549
  icon_menu_system_png_end:
  EndDataSection

EndModule

; ****************************************************************************
;- ROUTINE DE TEST DES FONCTIONS (MODULE).

CompilerIf #PB_Compiler_IsMainFile = 1

  Define.i event, i, ribbon, popup

  OpenWindow(0, 0, 0, 800, 600, "Custom Ribbon", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

  ribbon = RibbonBar::_CreateGadget(#PB_Any, "Purelight Pro", 0)

  RibbonBar::_AddRibbonTab(ribbon, "File")
  RibbonBar::_AddRibbonTab(ribbon, "Project")
  RibbonBar::_AddRibbonTab(ribbon, "Compiler")
  RibbonBar::_AddRibbonTab(ribbon, "Language")

  RibbonBar::_AddRibbonItem(ribbon, 1, 1,   "New",      RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x64, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 2,   "Open",     RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x64, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 3,   "Save",     RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x64, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 0,   #Null$,     RibbonBar::#Ribbon_Separator, 0, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 99,  "Dark",     RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x64, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 100, "Default",  RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 101, "Red",      RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Bottom, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 102, "Green",    RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 103, "Blue",     RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Bottom, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 104, "Yellow",   RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 105, "Pink",     RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Bottom, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 0,   #Null$,     RibbonBar::#Ribbon_Separator, 0, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 4,   "Toggle 1", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_96x32 | RibbonBar::#Ribbon_Menu, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 5,   "Toggle 2", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_96x32 | RibbonBar::#Ribbon_Menu | RibbonBar::#Ribbon_Bottom, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 6,   "Toggle 3", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Menu, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 7,   "Toggle 4", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Menu | RibbonBar::#Ribbon_Bottom, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 0,   #Null$,     RibbonBar::#Ribbon_Separator, 0, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 8,   "Toggle 5", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x64 | RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Toggle_Option | RibbonBar::#Ribbon_Menu, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 9,   "Toggle 6", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 10,  "Toggle 7", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Bottom | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 11,  "Toggle 8", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 12,  "Toggle 9", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Bottom | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 0,   #Null$,     RibbonBar::#Ribbon_Separator, 0, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 13,  "Button 4", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32, 0)
  RibbonBar::_AddRibbonItem(ribbon, 1, 14,  "Button 5", RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Size_48x32 | RibbonBar::#Ribbon_Bottom, 0)

  RibbonBar::_AddRibbonItem(ribbon, 4, 15,  "French",   RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 4, 16,  "English",  RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 4, 17,  "German",   RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 4, 18,  "Italian",  RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Toggle_Option, 0)
  RibbonBar::_AddRibbonItem(ribbon, 4, 19,  "Spanish",  RibbonBar::#Ribbon_Button,    RibbonBar::#Ribbon_Toggle | RibbonBar::#Ribbon_Toggle_Option, 0)

  ; POPUP DE TEST POUR LES BOUTONS AVEC FLECHE (#Ribbon_Menu).
  popup = CreatePopupMenu(#PB_Any)
  If popup
    MenuItem(200, "Option A")
    MenuItem(201, "Option B")
    For i = 4 To 8
      RibbonBar::_AttachRibbonButtonPopup(ribbon, i, popup)
    Next i
  EndIf

  Repeat
    event = WaitWindowEvent()
    Select event
      Case #PB_Event_Menu
        Select EventMenu()
          Case 99  : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Dark)
          Case 100 : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Default)
          Case 101 : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Red)
          Case 102 : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Green)
          Case 103 : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Blue)
          Case 104 : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Yellow)
          Case 105 : RibbonBar::_RibbonColor(ribbon, RibbonBar::#Ribbon_Pink)
          Case RibbonBar::#Ribbon_SysMenu_Quit
            If MessageRequester("Quitter", "Voulez-vous vraiment quitter le logiciel ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
              Break
            EndIf
          Default
            Debug "Menu : " + EventMenu() + "   état : " + RibbonBar::_GetItemState(ribbon, EventMenu())
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver

CompilerEndIf