Tuto menu onglet Partie 5 (dessin des groupes)
Publié : mer. 27/août/2014 12:11
Dans cette partie nous allons nous occuper du dessin des groupes
Modifier maintenant la procédure principale du dessin
Le code pour le teste
Et devriez avoir ceci

Dessin des bouttons image
réactivez DrawImageButton() dans DrawGroupe()
Les images pour le teste sont ici
http://www.alldev.be/ALLDEV_WEB/FR/IMG.zip
Et le code pour le teste
Vous devez maintenant avoir Ceci

La gestion des événement (Le survol des onglets)
Nous allons placer une procédure Event
Insérez avant la procédure WereIsMouse() petite astuce, j'ai configurer mon ID de telle sorte que ;-*Texte apparaisse dans ma liste de procédures et ;-* suivi de ;} puisse être plier pratique pour de long code

Important: Insérez dans le module les variables globales suivantes
Voici maintenant à quoi doit ressembler votre déclaration de module
Et enfin votre gestion événementielle
Vous devez maintenant avoir ceci

La gestion du clique sur une onglet
ajoutez dans le module le avant la procédure Event la procédure suivante
modifiez la procédure Event comme suit
J'ai également modifier l'initialisation comme suit
Vous devez maintenant avoir ceci

Le survol des boutons
J'ai modifier les tailles de tous les boutons à 48 au lieu de 64, et une position Y de 5 au lieu de 0
Ajoutez ces trois variable dans le module
Et ce code dans la procédure WereIsMouse()
Et voici le résultat

La suite ICI
http://www.purebasic.fr/french/viewtopi ... 21&t=14743
Code : Tout sélectionner
Procedure DrawGroupeTitle()
Protected X,Y,H,Marg=2,HTxt,Y2,W,X2,Txt$,Truncate.b=#False
Y=myTools()\Y+myTools()\HeightOnglet+(Marg*2)
H=myTools()\H-myTools()\HeightOnglet-(Marg*4)
X=Marg
DrawingFont(FontID(myTools()\FontGroupeTitle))
DrawingMode(#PB_2DDrawing_Transparent)
HTxt=TextHeight("A")
;Parcours de tous les groupe de l'onglet
ForEach myTools()\MyOnglet()\myGroupe()
Truncate=#False ;Par defaut le titre ne sera pas couper
W=myTools()\MyOnglet()\myGroupe()\Widht-(Marg*2)
X2=X
X2+W/2
If myTools()\MyOnglet()\myGroupe()\TilePosUp=#False
Y2=Y+(H-HTxt)
Else
Y2=Y
EndIf
;On ne dessine le titre que si l'utilisateur la renseigné
If myTools()\MyOnglet()\myGroupe()\Title$<>""
Txt$=myTools()\MyOnglet()\myGroupe()\Title$
;cette petite routine vas couper le title si il dépasse et lui ajouté ...
While TextWidth(Txt$)>(myTools()\MyOnglet()\myGroupe()\Widht-20)
Txt$=Left(Txt$,Len(Txt$)-4)
Truncate=#True
Wend
If Truncate=#True
Txt$+"..."
EndIf
X2-TextWidth(Txt$)/2
DrawText(X2,Y2,Txt$,myTools()\FrontColorGroupeTitle)
EndIf
X+myTools()\MyOnglet()\myGroupe()\Widht
Next
EndProcedure
Code : Tout sélectionner
Procedure DrawGroupeBoxTitle()
Protected X,Y,W,H,Marg=2,HTxt,Y2
Y=myTools()\Y+myTools()\HeightOnglet+(Marg*2)
H=myTools()\H-myTools()\HeightOnglet-(Marg*4)
X=Marg
DrawingFont(FontID(myTools()\FontGroupeTitle))
DrawingMode(#PB_2DDrawing_Default)
HTxt=TextHeight("A")
;Recherche de tous les groupes de l'onglet
ForEach myTools()\MyOnglet()\myGroupe()
W=myTools()\MyOnglet()\myGroupe()\Widht-(Marg*2)
If myTools()\MyOnglet()\myGroupe()\TilePosUp=#False
Y2=Y+(H-HTxt)
Else
Y2=Y
EndIf
;On ne dessine le titre que si l'utilisateur en à renseigné un
If myTools()\MyOnglet()\myGroupe()\TitleBox And myTools()\MyOnglet()\myGroupe()\Title$<>""
Box(X,Y2,W,HTxt,myTools()\BackColorGroupeTitle)
EndIf
X+myTools()\MyOnglet()\myGroupe()\Widht ;Pour passer au groupe suivant
Next
EndProcedure
Code : Tout sélectionner
Procedure DrawGroupeBorder()
Protected X,Y,W,H,Marg=2
Y=myTools()\Y+myTools()\HeightOnglet+(Marg*2)
H=myTools()\H-myTools()\HeightOnglet-(Marg*4)
X=Marg
DrawingMode(#PB_2DDrawing_Outlined)
;Parcour de tous les groupes
ForEach myTools()\MyOnglet()\myGroupe()
W=myTools()\MyOnglet()\myGroupe()\Widht-(Marg*2)
If myTools()\MyOnglet()\myGroupe()\BordreOn ;Le l'utisateur à activer la bordure du groupe
RoundBox(X,Y,W,H,5,5,myTools()\ColorLineGroupe)
EndIf
myTools()\MyOnglet()\myGroupe()\X1=X
myTools()\MyOnglet()\myGroupe()\X2=X+W
myTools()\MyOnglet()\myGroupe()\Y1=Y
myTools()\MyOnglet()\myGroupe()\Y2=Y+H
X+myTools()\MyOnglet()\myGroupe()\Widht ;Saute à la colonne suivante
Next
EndProcedure
Code : Tout sélectionner
Procedure DrawGroupe()
;On ne déssine le groupe que si sont onglet est sélectionné
ForEach myTools()\MyOnglet()
If myTools()\MyOnglet()\Selected=#True
Break ;pour pointer sur le bon record
EndIf
Next
DrawGroupeBoxTitle()
DrawGroupeTitle()
;DrawImageButton() on vera cela plus tard
;DrawSpin()
;DrawLabel()
DrawGroupeBorder()
EndProcedure
Code : Tout sélectionner
Procedure DrawTools(IdTools)
;Vérifie que le menu onglet existe
If FindMapElement(myTools(),Str(IdTools))=0
MessageRequester("Error ToolsBar Show","This Id Tolls not exist...")
ProcedureReturn #False
EndIf
;Petite précaution pour être sur la bonne fenêtre
UseGadgetList(WindowID(myTools()\IdWindow))
StartDrawing(CanvasOutput(myTools()\IdCanvas))
EraseCanvas()
DrawOnglet()
DrawTxtOnglet()
DrawGroupe()
StopDrawing()
EndProcedure
Code : Tout sélectionner
Procedure OpenMainForm()
#Id_Menu_Onglet=0
#ID_Form=0
#Onglet1=0
#Onglet2=1
OpenWindow(#ID_Form,0,0,800,600,"Teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ToolsBar::Init(#Id_Menu_Onglet,#ID_Form,0,0,-1,100)
ToolsBar::AddOnglet(#Id_Menu_Onglet,#Onglet1,"Onglet 1",#True)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 1")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 2")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 3")
ToolsBar::AddOnglet(#Id_Menu_Onglet,#Onglet2,"Onglet 2",#False)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 1")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 2")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 3")
ToolsBar::DrawTools(#Id_Menu_Onglet)
EndProcedure
OpenMainForm()
Global Event
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindow

Dessin des bouttons image
Code : Tout sélectionner
Procedure DrawImageButton()
Protected X,Y,W,H,Marg=2,X2,Y2
Protected Image,WImg,HImg
X=myTools()\X+Marg
Y=myTools()\Y+Marg+myTools()\HeightOnglet
DrawingMode(#PB_2DDrawing_AlphaClip)
ForEach myTools()\MyOnglet()\myGroupe()
ForEach myTools()\MyOnglet()\myGroupe()\myImgButton()
X2=X+myTools()\MyOnglet()\myGroupe()\myImgButton()\X
Y2=Y+myTools()\MyOnglet()\myGroupe()\myImgButton()\Y
W=myTools()\MyOnglet()\myGroupe()\myImgButton()\W
H=myTools()\MyOnglet()\myGroupe()\myImgButton()\H
;Calcul de la largeur d'un état de l'image
WImg=ImageWidth(myTools()\MyOnglet()\myGroupe()\myImgButton()\IdImage)/4
HImg=ImageHeight(myTools()\MyOnglet()\myGroupe()\myImgButton()\IdImage)
;Si le bouton est déselectionné on prend le 4ème état
If myTools()\MyOnglet()\myGroupe()\myImgButton()\Disabled=#True
Image=GrabImage(myTools()\MyOnglet()\myGroupe()\myImgButton()\IdImage,#PB_Any,WImg*3,0,WImg,HImg)
EndIf
;Si le bouton est sélectionné (si toogle) on prend le 3ème état
If myTools()\MyOnglet()\myGroupe()\myImgButton()\State=#True
Image=GrabImage(myTools()\MyOnglet()\myGroupe()\myImgButton()\IdImage,#PB_Any,WImg*2,0,WImg,HImg)
EndIf
;Si le bouton est survolé on prend le 2ème état
If Val(MapKey(myTools()\MyOnglet()\myGroupe()\myImgButton()))=FlyImageButton
Image=GrabImage(myTools()\MyOnglet()\myGroupe()\myImgButton()\IdImage,#PB_Any,WImg*1,0,WImg,HImg)
EndIf
;Rien de spéciale on prend le 1er etat
If myTools()\MyOnglet()\myGroupe()\myImgButton()\Disabled=#False And
myTools()\MyOnglet()\myGroupe()\myImgButton()\State=#False And
Val(MapKey(myTools()\MyOnglet()\myGroupe()\myImgButton()))<>FlyImageButton
Image=GrabImage(myTools()\MyOnglet()\myGroupe()\myImgButton()\IdImage,#PB_Any,0,0,WImg,HImg)
EndIf
DrawImage(ImageID(Image),X2,Y2,W,H)
;On memorise la position pour le susrvol de la souris
myTools()\MyOnglet()\myGroupe()\myImgButton()\X1=X2
myTools()\MyOnglet()\myGroupe()\myImgButton()\X2=X2+W
myTools()\MyOnglet()\myGroupe()\myImgButton()\Y1=Y2
myTools()\MyOnglet()\myGroupe()\myImgButton()\Y2=Y2+H
FreeImage(Image); Liberer la mémoire
Next
X+myTools()\MyOnglet()\myGroupe()\Widht+Marg ;Pour passer à la colonne suivante
Next
EndProcedure
Les images pour le teste sont ici
http://www.alldev.be/ALLDEV_WEB/FR/IMG.zip
Et le code pour le teste
Code : Tout sélectionner
Global Img_NewProject=CatchImage(#PB_Any,?Img_NewProject)
Global Img_CloseProject=CatchImage(#PB_Any,?Img_CloseProject)
Global Img_OpenProject=CatchImage(#PB_Any,?Img_OpenProject)
Global Img_NewFile=CatchImage(#PB_Any,?Img_NewFile)
Global Img_DeleteFile=CatchImage(#PB_Any,?Img_DeleteFile)
Global Img_EditFile=CatchImage(#PB_Any,?Img_EditFile)
Procedure OpenMainForm()
#Id_Menu_Onglet=0
#ID_Form=0
#Onglet1=0
#Onglet2=1
#NewProject=1
#OpenProject=2
#CloseProject=3
#NewFile=1
#EditFile=2
#DeleteFile=3
OpenWindow(#ID_Form,0,0,800,600,"Teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ToolsBar::Init(#Id_Menu_Onglet,#ID_Form,0,0,-1,100)
ToolsBar::AddOnglet(#Id_Menu_Onglet,#Onglet1,"Onglet 1",#True)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,(64*3)+10,"Groupe 1")
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet1,0,#NewProject,Img_NewProject,5,0,64,64)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet1,0,#OpenProject,Img_OpenProject,(64*1)+5,0,64,64)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet1,0,#CloseProject,Img_CloseProject,(64*2)+5,0,64,64)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 2")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 3")
ToolsBar::AddOnglet(#Id_Menu_Onglet,#Onglet2,"Onglet 2",#False)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 1")
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet2,0,#NewFile,Img_NewFile,5,0,64,64)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet2,0,#EditFile,Img_EditFile,(64*1)+5,0,64,64)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet2,0,#DeleteFile,Img_DeleteFile,(64*2)+5,0,64,64)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 2")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 3")
ToolsBar::DrawTools(#Id_Menu_Onglet)
EndProcedure
OpenMainForm()
Global Event
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindow
DataSection
Img_NewProject: :IncludeBinary "IMG\NewProject.png"
Img_CloseProject: :IncludeBinary "IMG\CloseProject.png"
Img_OpenProject: :IncludeBinary "IMG\OpenProject.png"
Img_NewFile: :IncludeBinary "IMG\NewFile.png"
Img_EditFile: :IncludeBinary "IMG\EditFile.png"
Img_DeleteFile: :IncludeBinary "IMG\DeleteFile.png"
EndDataSection

La gestion des événement (Le survol des onglets)
Nous allons placer une procédure Event
Code : Tout sélectionner
Procedure Event(IdTools,Event)
;Vérifie que le menu onglet existe
If FindMapElement(myTools(),Str(IdTools))=0
MessageRequester("Error ToolsBar Event","This Id Tolls not exist...")
ProcedureReturn #False
EndIf
If Event<>#PB_Event_Gadget :ProcedureReturn #False :EndIf
If EventGadget()<>myTools()\IdCanvas :ProcedureReturn #False :EndIf
Select EventType()
Case #PB_EventType_MouseMove
;Pour savoir ou est la souris
If WereIsMouse()=#True
ProcedureReturn #True
EndIf
EndSelect
EndProcedure

Code : Tout sélectionner
Procedure WereIsMouse()
Protected MouseX,MouseY,X1,Y1,X2,Y2
MouseX=GetGadgetAttribute(myTools()\IdCanvas,#PB_Canvas_MouseX)
MouseY=GetGadgetAttribute(myTools()\IdCanvas,#PB_Canvas_MouseY)
;-*Regarde sur quel onglet
Y1=myTools()\Y
Y2=Y1+myTools()\HeightOnglet
ForEach myTools()\MyOnglet()
X1=myTools()\MyOnglet()\X1
X2=myTools()\MyOnglet()\X2
CurrentOnglet=-1 ;On ne survole pas un onglet
If MouseX>=X1 And MouseX<=X2
If MouseY>=Y1 And MouseY<=Y2
CurrentOnglet=Val(MapKey(myTools()\MyOnglet())) ;On survole un onglet
ProcedureReturn #True ;On survole quelque chose
EndIf
EndIf
Next
ProcedureReturn #False ;On ne survole rien
;}
EndProcedure
Code : Tout sélectionner
;-*Variables
Global NewMap myTools.Tools()
Global X1noLine,X2noLine ;Cela va servir pour le dessin du bas de l'onglet
Global CurrentOnglet=-1 ;L'onglet survolé
Global BoxOverOnglet.b=#False
Global FlyImageButton=-1 ;Le bouton survolé
;}
Code : Tout sélectionner
DeclareModule ToolsBar
Enumeration Alignement
#Middle
#Left
#Right
EndEnumeration
Declare Init(Id,IdWindow,X,Y,Width=-1,Heidht=100)
Declare AddOnglet(IdTools,Id,Title$,Selected.b=#False)
Declare AddGroupe(IdTools,IdOnglet,Widht,Title$,BorderOn.b=#True,TitleBox.b=#True,TitlePosUp.b=#False)
Declare AddImageButton(IdTools,IdOnglet,Ngroupe,Id,Image,X,Y,W,H,Toogle.b=#False)
Declare AddSpin(IdTools,IdOnglet,Ngroupe,Id,X,Y,Width,Height,Min,Max,Value=0)
Declare AddLabel(IdTools,IdOnglet,Ngroupe,X,Y,Width,height,Value$,Justification=#Left)
Declare DrawTools(IdTools)
Declare Event(IdTools,Event)
EndDeclareModule
Code : Tout sélectionner
Repeat
Event=WaitWindowEvent()
If ToolsBar::Event(0,Event)
ToolsBar::DrawTools(0)
EndIf
Until Event=#PB_Event_CloseWindow

La gestion du clique sur une onglet
ajoutez dans le module le avant la procédure Event la procédure suivante
Code : Tout sélectionner
Procedure DeselectAllOnglet()
ForEach myTools()\MyOnglet()
myTools()\MyOnglet()\Selected=#False
Next
EndProcedure
Code : Tout sélectionner
Procedure Event(IdTools,Event)
;Vérifie que le menu onglet existe
If FindMapElement(myTools(),Str(IdTools))=0
MessageRequester("Error ToolsBar Event","This Id Tolls not exist...")
ProcedureReturn #False
EndIf
If Event<>#PB_Event_Gadget :ProcedureReturn #False :EndIf
If EventGadget()<>myTools()\IdCanvas :ProcedureReturn #False :EndIf
Select EventType()
Case #PB_EventType_MouseMove
;Pour savoir ou est la souris
If WereIsMouse()=#True
ProcedureReturn #True ;Un événement
EndIf
Case #PB_EventType_LeftClick
;-*Clique sur un onglet
If CurrentOnglet<>-1
DeselectAllOnglet() ;Deslectionner tous les onglets
FindMapElement(myTools()\MyOnglet(),Str(CurrentOnglet)) ;Pointe sur l'onglet survolé
myTools()\MyOnglet()\Selected=#True ;Un événement
ProcedureReturn #True
EndIf
;}
EndSelect
ProcedureReturn #False ;Pas d'évenement
EndProcedure
Code : Tout sélectionner
ToolsBar::Init(#Id_Menu_Onglet,#ID_Form,0,0,-1,100)
ToolsBar::AddOnglet(#Id_Menu_Onglet,#Onglet1,"Onglet 1",#True)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,(64*3)+10,"Groupe 1")
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet1,0,#NewProject,Img_NewProject,5,0,64,64)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet1,0,#OpenProject,Img_OpenProject,(64*1)+5,0,64,64)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet1,0,#CloseProject,Img_CloseProject,(64*2)+5,0,64,64)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 2")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet1,100,"Groupe 3")
ToolsBar::AddOnglet(#Id_Menu_Onglet,#Onglet2,"Onglet 2",#False)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,(48*3)+10,"Groupe 1")
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet2,0,#NewFile,Img_NewFile,5,5,48,48)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet2,0,#EditFile,Img_EditFile,(48*1)+5,5,48,48)
ToolsBar::AddImageButton(#Id_Menu_Onglet,#Onglet2,0,#DeleteFile,Img_DeleteFile,(48*2)+5,5,48,48)
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 2")
ToolsBar::AddGroupe(#Id_Menu_Onglet,#Onglet2,100,"Groupe 3")
ToolsBar::DrawTools(#Id_Menu_Onglet)

Le survol des boutons
J'ai modifier les tailles de tous les boutons à 48 au lieu de 64, et une position Y de 5 au lieu de 0
Ajoutez ces trois variable dans le module
Code : Tout sélectionner
Global FlyImageButton=-1 ;Le bouton survol
Global *FlyGroupe=-1 ; pointeur pour le groupe survolé
Global BoxOverGadget.b=#False
Code : Tout sélectionner
Procedure WereIsMouse()
Protected MouseX,MouseY,X1,Y1,X2,Y2
MouseX=GetGadgetAttribute(myTools()\IdCanvas,#PB_Canvas_MouseX)
MouseY=GetGadgetAttribute(myTools()\IdCanvas,#PB_Canvas_MouseY)
;-*Regarde sur quel onglet
Y1=myTools()\Y
Y2=Y1+myTools()\HeightOnglet
ForEach myTools()\MyOnglet()
X1=myTools()\MyOnglet()\X1
X2=myTools()\MyOnglet()\X2
CurrentOnglet=-1 ;On ne survole pas un onglet
If MouseX>=X1 And MouseX<=X2
If MouseY>=Y1 And MouseY<=Y2
CurrentOnglet=Val(MapKey(myTools()\MyOnglet())) ;On survole un onglet
ProcedureReturn #True ;On survole un onglet
EndIf
EndIf
Next
;}
;-*Sur quel Groupe
*FlyGroupe=-1
;-* Pointe sur l'onglet sélectionner
ForEach myTools()\MyOnglet()
If myTools()\MyOnglet()\Selected=#True :Break :EndIf
Next
;}
ForEach myTools()\MyOnglet()\myGroupe()
With myTools()\MyOnglet()\myGroupe()
X1=\X1
X2=\X2
Y1=\Y1
Y2=\Y2
EndWith
If (MouseX>=X1 And MouseX<=X2) And (MouseY>=Y1 And MouseY<=Y2)
*FlyGroupe=@myTools()\MyOnglet()\myGroupe()
Break ;Pour rester sur le bon record
EndIf
Next
If *FlyGroupe=-1 :ProcedureReturn #False : EndIf ;Pas sur un groupe sortir
;}
;-*Sur quel Image
FlyImageButton=-1
ForEach myTools()\MyOnglet()\myGroupe()\myImgButton()
With myTools()\MyOnglet()\myGroupe()\myImgButton()
X1=\X1
X2=\X2
Y1=\Y1
Y2=\Y2
EndWith
If (MouseX>=X1 And MouseX<=X2) And (MouseY>=Y1 And MouseY<=Y2)
;On ne prend que les boutons actifs
If myTools()\MyOnglet()\myGroupe()\myImgButton()\Disabled=#False
FlyImageButton=Val(MapKey(myTools()\MyOnglet()\myGroupe()\myImgButton()))
BoxOverGadget=#True
ProcedureReturn #True ;
EndIf
EndIf
Next
;}
ProcedureReturn #False ;On ne survole rien
EndProcedure

La suite ICI
http://www.purebasic.fr/french/viewtopi ... 21&t=14743