PureBasic

Code : Tout sélectionner

DeclareModule BT_FACTORY
  Interface BUTTON
    setHeight(h)
    getHeight()
    setWidth(w)
    setPosX(x)
    getPosX()
    setPosY(y)
    getPosY()
    getTitle.s()
    show()
  EndInterface
  
  Declare new(title.s,*callback,x.l,y.l,w.l,h.l)
EndDeclareModule

Module BT_FACTORY
  Structure _border
    color.l       ; la couleur de bordure -1 si pas de bordure
    weight.d      ; l'épaisseur de bordure
  EndStructure
  Structure _colors
    bg.l          ; la couleur de fond
    fg.l          ; la couleur de texte
  EndStructure
  Structure _pos
    x.l
    y.l
    w.l
    h.l
  EndStructure
  Structure _struct
    *methods       ; les methodes publiques
    id_canvas.l    ; l'id du canvas qui sera créer et ou sera dessiner le bouton
    title.s        ; le titre du bouton
    *call_back     ; la procédure qui sera appellée au clique sur le bouton
    border._border ; la bordure
    colors._colors ; les couleurs du bouton
    myPos._pos     ; les positions et tailles du bouton
    font.l
  EndStructure
  ; prototype
  Prototype CALL(*this)
  ; constante
  #NONE = -1
  ; methode privée
  Procedure _draw(*this._struct)
    With *this
      StartVectorDrawing(CanvasVectorOutput(\id_canvas))
      ; remplissage du fond
      VectorSourceColor(\colors\bg)
      FillVectorOutput()
      ; dessin de ladordure
      If(\border\color <> #NONE)
        AddPathBox(\myPos\x,\myPos\y,\myPos\w,\myPos\h)
        VectorSourceColor(\border\color)
        StrokePath(\border\weight)
      EndIf
      ; titre du bouton
      VectorFont(FontID(\font)) ; ATTENTION : la fonte doit être chargée pour le calcul
      Protected title.s = \title
      ; concatenation du titre si nécessaire
      While VectorTextWidth(title) > \myPos\w
        If Len(title)<=4
          title ="..."
          Break
        EndIf
        title = Left(title,Len(title)-4)
        title + "..."
      Wend
      ; calcul de la position central du text
      Protected xc = (\myPos\w / 2) - (VectorTextWidth(title)/2),
                yc = (\myPos\h / 2) - (VectorTextHeight(title)/2)
      MovePathCursor(xc,yc)
      VectorSourceColor(\colors\fg)
      DrawVectorText(title)
      StopVectorDrawing()
    EndWith
  EndProcedure
  
  Procedure _eventBt()
    Protected *this._struct = GetGadgetData(EventGadget()) ; on recupère l'instance de l'objet
    With *this
      Select EventType()
        Case #PB_EventType_MouseEnter
          Debug "La souris entre sur le bouton "+\title
        Case #PB_EventType_MouseLeave
          Debug "La souris sort du le bouton "+\title
        Case #PB_EventType_LeftClick
          ; on appelle le callack
          Protected myProcedure.CALL = \call_back
          myProcedure(*this)
      EndSelect
    EndWith
  EndProcedure
  ; getters et setter
  Procedure setHeight(*this._struct,h)
    With *this\myPos
      ; on n'autorise une hauteur minimus
      If h<=0
        \h = 10
      Else
        \h = h
      EndIf
      If IsGadget(*this\id_canvas)  
        ResizeGadget(*this\id_canvas,#PB_Ignore,#PB_Ignore,#PB_Ignore,h)
      EndIf
    EndWith
  EndProcedure
  
  Procedure getHeight(*this._struct)
    With *this\myPos
      ProcedureReturn \h
    EndWith
  EndProcedure
  
  Procedure setWidth(*this._struct,w)
    With *this\myPos
      ; on n'autorise une largeur minimus
      If w<=0
        \w = 20
      Else
        \w = w
      EndIf
      If IsGadget(*this\id_canvas)  
        ResizeGadget(*this\id_canvas,#PB_Ignore,#PB_Ignore,w,#PB_Ignore)
      EndIf
    EndWith
  EndProcedure
  
  Procedure getWidth(*this._struct)
    With *this\myPos
      ProcedureReturn \w
    EndWith
  EndProcedure
  
  Procedure setPosX(*this._struct,x)
    With *this\myPos
      \x = x
      If IsGadget(*this\id_canvas)  
        ResizeGadget(*this\id_canvas,x,#PB_Ignore,#PB_Ignore,#PB_Ignore)
      EndIf
    EndWith
  EndProcedure
  
  Procedure getPosX(*this._struct)
    With *this\myPos
      ProcedureReturn \x 
    EndWith
  EndProcedure
  
  Procedure setPosY(*this._struct,y)
    With *this\myPos
      \y = y
      If IsGadget(*this\id_canvas)  
        ResizeGadget(*this\id_canvas,#PB_Ignore,y,#PB_Ignore,#PB_Ignore)
      EndIf
    EndWith
  EndProcedure
  
  Procedure getPosY(*this._struct)
    With *this\myPos
      ProcedureReturn \y 
    EndWith
  EndProcedure
  
  Procedure.s getTitle(*this._struct)
    With *this
      ProcedureReturn \title
    EndWith
  EndProcedure
  ; cette méthode affiche le bouton
  ; et lie le click bouton au callback
  Procedure show(*this._struct)
    With *this
      \id_canvas = CanvasGadget(#PB_Any,\myPos\x,\myPos\y,\myPos\w,\myPos\h)
      _draw(*this)
      ; on memorise l'instance de l'objet dans le canvas
      ; pour son utilisation depuis le callback
      SetGadgetData(\id_canvas,*this)
      BindGadgetEvent(\id_canvas,@_eventBt())
    EndWith
  EndProcedure
  
  ; le constructeur du bouton
  Procedure new(title.s,*callback,x.l,y.l,w.l,h.l)
    ; allocation de la mérmoire nécessaire (instantiation)
    Protected *this._struct = AllocateStructure(_struct)
    With *this
      \methods = ?M_START ; les adresses de méthodes accessible par les interfaces
      \myPos\x = x
      \myPos\y = y
      \myPos\w = w
      \myPos\h = h
      \title = title
      \border\color = #NONE
      \colors\bg = $FF00FF00 ; couleur de fond par défaut
      \colors\fg = $FF000000 ; couleuur de texte par défaut
      \call_back = *callback
      \font = LoadFont(#PB_Any,"arial",10,#PB_Font_HighQuality)
      
      ProcedureReturn *this
    EndWith
  EndProcedure
  
  
  ; data section pour les adresses des méthodes publiques
  DataSection
    M_START:
    Data.i @setHeight()
    Data.i @getHeight()
    Data.i @setWidth()
    Data.i @setPosX()
    Data.i @getPosX()
    Data.i @setPosY()
    Data.i @getPosY()
    Data.i @getTitle()
    Data.i @show()
    M_END:
  EndDataSection
EndModule

; teste
Procedure btEvent(*bt.BT_FACTORY::BUTTON)
  Debug "on cliquer sur le bouton "+*bt\getTitle()
EndProcedure

Procedure exit()
  End
EndProcedure

Global.BT_FACTORY::BUTTON bt1,bt2,bt3

OpenWindow(0,0,0,800,600,"Teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

bt1 = BT_FACTORY::new("Bouton 1",@btEvent(),10,10,80,40)
bt2 = BT_FACTORY::new("Bouton 2",@btEvent(),100,10,80,40)
bt3 = BT_FACTORY::new("Bouton 3",@btEvent(),200,10,30,40)

bt1\show()
bt2\show()
bt3\show()

BindEvent(#PB_Event_CloseWindow,@exit(),0)

Repeat:WaitWindowEvent():ForEver