Redimensionnement automatique des gadgets

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Shadow
Messages : 1373
Inscription : mer. 04/nov./2015 17:39

Re: Redimensionnement automatique des gadgets

Message par Shadow »

Très bon se truc, merci !
Je t'encourage à l’améliorer, plus de gadget et se qu'on dit les copain, très bon !
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

Re: Redimensionnement automatique des gadgets

Message par Naheulf »

Coucou ! (Et un petit déterrage pour bien commencer la semaine)

J'ai apporté quelques modifications au code du premier message :
- mise sous forme de module
- changement du nom de certaines variable pour rendre le tout (je l'espère) plus compréhensible
- modification de la logique de fonctionnement pour avoir plus de possibilités (comme garder un élément centré)
- modification de l'exemple pour montrer un apperçu des nouvelles possibilités.
- modification de l'exemple pour montrer que WindowBounds() fonctionne correctement.

Fichier "GadgetR.pbi" :

Code : Tout sélectionner

EnableExplicit

;############################################################################################################################
;                  Redimensionnement automatique des gadgets - pf shadoko - 2016
;                   Mise sous forme de module et améliorations - Naheulf - 2020
;  
;  Code original :
;      https://www.purebasic.fr/french/viewtopic.php?f=6&t=16201
;  
;  Fonctionnement:
;      Les instructions OpenWindow, ButtonGadget, TextGadget, ..., CloseGadgetList
;      doivent etre utilisées avec le suffixe 'R'
;
;      Les 4 paramètres suplémentaires indiquent le ratio d'adaptation aux variation de taille du parent: 
;        - rdx : 0 -> Pas de déplacement horizontal ; 1 -> Reste collé au bord droit
;        - rdw : 0 -> Largeur fixe                  ; 1 -> S'étire à volonté
;        - rdy : 0 -> Pas de déplacement vertical   ; 1 -> Reste collé au bord bas
;        - rdh : 0 -> Hauteur fixe                  ; 1 -> S'étire à volonté
;      Note : 
;  
;  Équivalence avec les paramètres de la version originale :
;      rx,ry = 0 -> rdx,rdy = 0 ; rdw,rdh = 0
;      rx,ry = 1 -> rdx,rdy = 1 ; rdw,rdh = 0
;      rx,ry = 2 -> rdx,rdy = 0 ; rdw,rdh = 1
;      rx,ry = 3 -> rdx,rdy = position/tailleDuParent ; rdw,rdh = taille/tailleDuParent
;      rx,ry = 4 -> rdx,rdy = 0 ; rdw,rdh = (position+taille)/tailleDuParent
;      rx,ry = 5 -> rdx,rdy = position/tailleDuParent ; rdw,rdh = 1 - (position/tailleDuParent)
;
;  Signification des 2 paramètres suplémentaires utilisés dans la version originale.
;      rx et ry correspondent au type de redimensionnement:
;      rx/ry = 0 : pas de modification
;      rx/ry = 1 : modification de la position x/y
;      rx/ry = 2 : modification de la largeur/hauteur
;      rx/ry = 3 : positionnement proportionnel
;      rx/ry = 4 : positionnement proportionnel coté droit
;      rx/ry = 5 : positionnement proportionnel coté gauche
;
;############################################################################################################################


DeclareModule GadgetR
	
	;--------------------------------- gadgets
	Declare ButtonGadgetR     (Gadget,X,Y,Width,Height,Text$,  Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare TextGadgetR       (Gadget,X,Y,Width,Height,Text$,  Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare CheckBoxGadgetR   (Gadget,X,Y,Width,Height,Text$,  Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare StringGadgetR     (Gadget,X,Y,Width,Height,Text$,  Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare EditorGadgetR     (Gadget,X,Y,Width,Height,        Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare ButtonImageGadgetR(Gadget,X,Y,Width,Height,imageID,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	
	;--------------------------------- containers
	Declare ContainerGadgetR  (Gadget,X,Y,Width,Height,        Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare PanelGadgetR      (Gadget,X,Y,Width,Height,                     rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	Declare ScrollAreaGadgetR (Gadget,X,Y,Width,Height,
	                           scrolldx,scrolldy,scrollstep,   Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
	
	;--------------------------------- window
	Declare OpenWindowR(n,x,y,dx,dy,txt.s,f=#PB_Window_SystemMenu,pid=0)
	
	;---------------------------------
	Declare CloseGadgetListR()
EndDeclareModule ; GadgetR

Module GadgetR
	EnableExplicit
	
	Structure GadgetInfo
		id.i          ; gadgetID
		Map Glist.s() ; liste des gadgets contenus (pour les containers)
		x.w : y.w	  ; position d'origine
		w.w : h.w	  ; dimensions d'origine
		rdx.f : rdy.f ; contributions des positions lors des redimmentionnements
		rdw.f : rdh.f ; contributions dimentions lors des redimmentionnements
	EndStructure
	
	Global Dim GadgetCont.s(256), GadgetConti
	Global NewMap GadgetList.GadgetInfo()
	
	Procedure Redimensioner(c, nx.w, ny.w, ndw.w, ndh.w, type$="G")
		Protected.GadgetInfo gi, o
		Protected.w dw,dh, nw, nh
		If type$="G":ResizeGadget(c,nx, ny, ndw, ndh):EndIf
		gi=GadgetList(type$+Str(c))
		dw = ndw-gi\w
		dh = ndh-gi\h
		ForEach gi\Glist() : o=GadgetList(gi\Glist())
			If (o\rdx Or o\rdw Or o\rdy Or o\rdh)
				nx = o\x + o\rdx * dw
				nw = o\w + o\rdw * dw
				ny = o\y + o\rdy * dh
				nh = o\h + o\rdh * dh
				Redimensioner (o\id, nx, ny, nw, nh)
			EndIf
		Next
		
	EndProcedure
	
	Procedure _GadgetInfo(na, id, x.w,y.w,w.w,h.w, rdx.f,rdw.f,rdy.f,rdh.f, iscontainer=0)
		Protected gadget.GadgetInfo, tg$
		
		If id=#PB_Any : gadget\id=na : Else : gadget\id=id : EndIf
		gadget\x=x     : gadget\y=y
		gadget\w=w     : gadget\h=h
		gadget\rdx=rdx : gadget\rdy=rdy
		gadget\rdw=rdw : gadget\rdh=rdh
		
		If iscontainer=-1
			tg$="W"+Str(gadget\id)
			GadgetConti=0
		Else
			tg$="G"+Str(gadget\id)
			GadgetList(GadgetCont(GadgetConti))\Glist(tg$)=tg$
		EndIf
		GadgetList(tg$)=gadget
		If iscontainer
			GadgetConti+1
			GadgetCont(GadgetConti)=tg$
		EndIf
		ProcedureReturn gadget\id
	EndProcedure
	
	
	;--------------------------------- gadgets
	Procedure ButtonGadgetR(Gadget,X,Y,Width,Height,Text$,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=ButtonGadget(Gadget,X,Y,Width,Height,Text$,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh)
	EndProcedure
	
	Procedure TextGadgetR(Gadget,X,Y,Width,Height,Text$,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=TextGadget(Gadget,X,Y,Width,Height,Text$,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh)
	EndProcedure
	
	Procedure CheckBoxGadgetR(Gadget,X,Y,Width,Height,Text$,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=CheckBoxGadget(Gadget,X,Y,Width,Height,Text$,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh)
	EndProcedure
	
	Procedure StringGadgetR(Gadget,X,Y,Width,Height,Text$,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=StringGadget(Gadget,X,Y,Width,Height,Text$,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh)
	EndProcedure
	
	Procedure EditorGadgetR(Gadget,X,Y,Width,Height,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=EditorGadget(Gadget,X,Y,Width,Height,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh)
	EndProcedure
	
	Procedure ButtonImageGadgetR(Gadget,X,Y,Width,Height,imageID,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=ButtonImageGadget(Gadget,X,Y,Width,Height,imageID,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh)
	EndProcedure
	
	;--------------------------------- containers
	Procedure ContainerGadgetR(Gadget,X,Y,Width,Height,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=ContainerGadget(Gadget,X,Y,Width,Height,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh, 1)
	EndProcedure
	
	Procedure PanelGadgetR(Gadget,X,Y,Width,Height,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=PanelGadget(Gadget,X,Y,Width,Height)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh, 1)
	EndProcedure
	
	Procedure ScrollAreaGadgetR(Gadget,X,Y,Width,Height,scrolldx,scrolldy,scrollstep,Flags=#False,rdx.f=0,rdw.f=0,rdy.f=0,rdh.f=0)
		Protected na=ScrollAreaGadget(Gadget,X,Y,Width,Height,scrolldx,scrolldy,scrollstep,Flags)
		ProcedureReturn _GadgetInfo(na,Gadget,X,Y,Width,Height,rdx,rdw,rdy,rdh, 1)
	EndProcedure
	
	;--------------------------------- window
	Procedure _WindowResizeEvent()
		Protected n=EventWindow()
		Redimensioner(n,0,0,WindowWidth(n), WindowHeight(n),"W")
	EndProcedure
	
	Procedure OpenWindowR(Window,X,Y,Width,Height,Title$,Flags=#PB_Window_SystemMenu,ParentID=0)
		Protected na=OpenWindow(Window,X,Y,Width,Height,Title$,Flags,ParentID)
		Protected nw=_GadgetInfo(na,Window,X,Y,Width,Height,0,1,0,1, -1)
		BindEvent(#PB_Event_SizeWindow,@_WindowResizeEvent(), nw)
		ProcedureReturn nw
	EndProcedure
	
	;---------------------------------
	Procedure CloseGadgetListR()
		CloseGadgetList()
		GadgetConti-1
	EndProcedure
	
EndModule ; GadgetR
Exemple légèrement modifié pour s'adapter au nouveau fonctionnement et montrer un apercu des nouvelles possibilités :

Code : Tout sélectionner

XIncludeFile "GadgetR.pbi"

;############################################################################################################################
;                                                 Exemple
;############################################################################################################################

UseModule GadgetR

CreateImage(0,200,60):StartDrawing(ImageOutput(0)):Define i:For i=0 To 200:Circle(100,30,200-i,(i+50)*$010101):Next:StopDrawing()

;OpenWindowr(0, 0, 0,512, 200, "Resize gadget", #PB_Window_Background)
OpenWindowR(0, 10, 20, 512, 200, "Resize gadget",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget)
;OpenWindowr(0, 0, 0, 512, 200, "Resize gadget", #PB_Window_Maximize | #PB_Window_SizeGadget| #PB_Window_MaximizeGadget)


TextGadgetR(1, 10,  10, 200, 50, "Redimentionnez la fenetre, les gadgets seront automatiquement redimentionnés",#PB_Text_Center)
ButtonImageGadgetR(3, 10, 70, 200, 60, ImageID(0),0,0,0)
EditorGadgetR(2, 10,140, 200,20, 0, 0,0, 0,1):SetGadgetText(2,"Editor")
ButtonGadgetR(4, 110, 170, 290, 20, "Button / toggle", #PB_Button_Toggle,1/2,0,1,0)
TextGadgetr(5,220,10,190,20,"Text",#PB_Text_Center,0,1,0,0):SetGadgetColor(5, #PB_Gadget_BackColor, $00FFFF)
ContainerGadgetR(6, 220, 30, 190, 100,#PB_Container_Single,0,1,0,1):SetGadgetColor(6, #PB_Gadget_BackColor, $cccccc)
	EditorGadgetR(7, 10,  10, 170, 20, 0,0,1,0,1):SetGadgetText(7,"Editor")
	ButtonGadgetR(8, 10, 70, 80, 20, "Button",0,0,(10+80)/190,1,0)
	ButtonGadgetR(9, 100, 70, 80, 20, "Button",0,100/190,1-100/190,1,0)
	ButtonGadgetR(81, 10, 40, 80, 20, "Button",0,0,1/2,1,0)
	ButtonGadgetR(91, 100, 40, 80, 20, "Button",0,1/2,1/2,1,0)
CloseGadgetListR()
StringGadgetR(10, 220,  140, 190, 20, "String ",0,0,1,1,0)
ButtonGadgetR(11, 420,  10, 80, 80, "Bouton",0,1,0,0,1)
CheckBoxGadgetR(12, 420,  90, 200, 20, "CheckBox",0,1,0,1,0)
CheckBoxGadgetR(13, 420,  110, 200, 20, "CheckBox",0,1,0,1,0)
CheckBoxGadgetR(14, 420,  130, 200, 20, "CheckBox",0,1,0,1,0)
CheckBoxGadgetR(15, 420,  150, 200, 20, "CheckBox",0,1,0,1,0)

ResizeWindow(0, #PB_Ignore , #PB_Ignore ,512,400):
WindowBounds(0, 312, 200, #PB_Ignore, #PB_Ignore)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

Re: Redimensionnement automatique des gadgets

Message par Naheulf »

Tant que j'y suis, voici un code qui permet d'afficher un message d'avertissement via le débogueur lorsque l'on utilise la fonction OpenWindow() native par erreur :

Code : Tout sélectionner

; Si vous utilisez ce code, vous devez IMPÉRATIVEMENT le mettre APRÈS le corps du module GadgetR.

CompilerIf #PB_Compiler_Debugger
	DisableDebugger
	Procedure OpenWindowDebug(Windows, x, y, InnerWidth, InnerHeight, Title$, Flags, ParendID, poubelle)
		ProcedureReturn OpenWindow(Windows, x, y, InnerWidth, InnerHeight, Title$, Flags, ParendID)
	EndProcedure
	EnableDebugger
	
	; L'utilisation d'une macro permet de mettre le warning sur la ligne où l'on utilise openwindow()
	Macro OpenWindow(Win,x,y,W,H,T,F = #PB_Window_SystemMenu, P = #Null)
		OpenWindowDebug(Win,x,y,W,H,T,F,P,
		                Bool(DebuggerWarning("Pour profiter du redimentionnement automatique vous devez utiliser la procédure GadgetR::OpenWindowR()")))
	EndMacro
CompilerEndIf

CompilerIf #PB_Compiler_IsMainFile
	
	; Ce code doit ouvrir une fenêtre en mettant un warning sur cette ligne
	OpenWindow(0, -1, -1, 800, 600, "Exemple")
CompilerEndIf
Avatar de l’utilisateur
blendman
Messages : 2017
Inscription : sam. 19/févr./2011 12:46

Re: Redimensionnement automatique des gadgets

Message par blendman »

salut

j'ai testé, mais avec 2 panels l'un au dessus de l'autre et une statusbar, ça ne fonctionne pas trop.

Code : Tout sélectionner

XIncludeFile "GadgetR.pbi"

UseModule GadgetR

OpenWindowR(0, 10, 20, 512, 200, "Resize gadget",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget)

CreateMenu(0, WindowID(0))
MenuTitle("File")
MenuTitle("Edit")
MenuTitle("View")
MenuTitle("Layers")

CreateStatusBar(0, WindowID(0))


  ; tool parameter
  PanelGadgetR(1,0,0,150,270, 0,0,0,0)
  AddGadgetItem(1, 0, "Gen")
  AddGadgetItem(1, 1, "Tra")
  AddGadgetItem(1, 2, "DYn")
  CloseGadgetListR()
  
  ; color
  Define id = 2
  PanelGadgetR(id,0,270,150,2,0,0,0,1)
  AddGadgetItem(id, 0, "Color")
  AddGadgetItem(id, 1, "Gradient")
  CloseGadgetListR()
Je voudrais que le deuxième panel ne dépasse pas en hauteur la statusbar.

J'ai donc ajouter des conteneurs, mais si on réduit la fenêtre par la droite, le coté droit (les panels layer) finit par "disparaître".

Code : Tout sélectionner

XIncludeFile "GadgetR.pbi"

UseModule GadgetR

OpenWindowR(0, 10, 20, 512, 200, "Resize gadget",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget)

CreateMenu(0, WindowID(0))
MenuTitle("File")
MenuTitle("Edit")
MenuTitle("View")
MenuTitle("Layers")

CreateStatusBar(0, WindowID(0))

  
  ; LEFT; tool parameter
  ContainerGadgetR(10, 0, 0, 155, 175, #PB_Container_BorderLess,0,0,0,1)
  PanelGadgetR(1,0,0,150,270, 0,0,0,0)
  AddGadgetItem(1, 0, "Gen")
  AddGadgetItem(1, 1, "Tra")
  AddGadgetItem(1, 2, "Dyn")
  CloseGadgetListR()
  
  ; color
  Define id = 2
  PanelGadgetR(id,0,270,150,2,0,0,0,1)
  AddGadgetItem(id, 0, "Color")
  AddGadgetItem(id, 1, "Gradient")
  CloseGadgetListR()
  CloseGadgetListR()
  
; canvas to draw
  If ContainerGadgetR(6, 155, 0, 512-155*2, 175, #PB_Container_Single,0,1,0,1) : SetGadgetColor(6, #PB_Gadget_BackColor, RGB(120,120, 120))
    CanvasGadget(20, 0, 0, 600, 400) 
    
    CloseGadgetListR()
  EndIf

  
  ; RIGHT
  ; Layer
  Define x = 512-150
  ContainerGadgetR(11, x, 0, 155, 175, #PB_Container_BorderLess,1,1,0,1)

    Define id = 4
    PanelGadgetR(id,0,0,150,270, 0,0,0,0)
    AddGadgetItem(id, 0, "Layer")
    AddGadgetItem(id, 1, "Options")
    CloseGadgetListR()
    
    ; swatch
    Define id = 5
    PanelGadgetR(id,0,270,150,2,0,0,0,1)
    AddGadgetItem(id, 0, "Swatch")
    AddGadgetItem(id, 1, "Rough")
    CloseGadgetListR()
  
  CloseGadgetListR()
  

ResizeWindow(0, #PB_Ignore , #PB_Ignore ,512,400):
WindowBounds(0, 312, 200, #PB_Ignore, #PB_Ignore)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Répondre