Dans code je montre un exemple de redimensionnement de fenêtre avec redimensionnement des gadgets. Mais le plus important, les nouvelles positions, dimensions sont sauvegardée. Ainsi l'utilisateur reprend la fenêtre ou il l'avais laissée.
Code : Tout sélectionner
;************************************************************************************************************************
; Author : MicrodevWeb
; Exemple de redimensionnement de fenêtre, adaptation des gadgets à la nouvelle taille
; et sauvegarde des nouvelle dimensions
; J'ai opté pour un développent Modulaire
;************************************************************************************************************************
DeclareModule Prj
;-* Les structures et map et liste qui servirons à JSON
Structure Pos
X.i
Y.i
W.i
H.i
EndStructure
Structure Form
myPos.Pos
Map myGadget.pos()
EndStructure
Structure Project
Map myForm.Form()
; On place ICI tous élement tel que les préférences etc...
EndStructure
Global myProject.Project
Global PreferencesName.s="preferences.pref"
;}
Declare AddForm(IdForm.s,WindowId)
Declare AddGadget(IdForm.s,IdGadget.s,GadgetId)
Declare SaveForm(IdForm.s,WindowId)
Declare SaveGadget(IdForm.s,IdGadget.s,GadgetId)
Declare LoadPreference()
EndDeclareModule
Module Prj
EnableExplicit
;}
;-* LOCAL PROCEDURE
Procedure SavePreferences()
; Création du fichier de p^référence si il n'existe pas
If FileSize(PreferencesName)=-1
CreateFile(0,PreferencesName)
CloseFile(0)
EndIf
; Sauvegarde du fichier JSON
Protected myJson
myJson=CreateJSON(#PB_Any)
If myJson=0
MessageRequester("Error SavePreferences","Can not init json")
ProcedureReturn #False
EndIf
InsertJSONStructure(JSONValue(myJson),myProject,Project)
If SaveJSON(myJson,PreferencesName,#PB_JSON_PrettyPrint)=0
MessageRequester("Error SavePreferences","Can not save preferences")
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
;}
;-* PUBLIC PROCEDUE
Procedure LoadPreference()
Protected myJson
ClearStructure(@myProject,Project)
InitializeStructure(@myProject,Project)
myJson=LoadJSON(#PB_Any,PreferencesName,#PB_JSON_NoCase)
If myJson=0
MessageRequester("Erreur LoadPreference","Load Json Error of line "+JSONErrorLine()+" : "+JSONErrorPosition())
ProcedureReturn
EndIf
ExtractJSONStructure(JSONValue(myJson),@myProject,Project)
EndProcedure
Procedure AddForm(IdForm.s,WindowId)
; Si la fenêtre existe déjà
If FindMapElement(myProject\myForm(),IdForm)<>0
MessageRequester("Error AddForm","This form "+IdForm+" allready exists")
ProcedureReturn #False
EndIf
AddMapElement(myProject\myForm(),IdForm)
; On mémorise la position de la fenêtre
With myProject\myForm()\myPos
\X=WindowX(WindowId)
\Y=WindowY(WindowId)
\W=WindowWidth(WindowId)
\H=WindowHeight(WindowId)
EndWith
If SavePreferences()
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure AddGadget(IdForm.s,IdGadget.s,GadgetId)
; Si la fenêtre n'existe pas
If FindMapElement(myProject\myForm(),IdForm)=0
MessageRequester("Error AddForm","This form "+IdForm+" not exists")
ProcedureReturn #False
EndIf
; Si le gadget existe déjà
If FindMapElement(myProject\myForm()\myGadget(),IdGadget)<>0
MessageRequester("Error AddForm","This gadget "+IdGadget+" allready exists")
ProcedureReturn #False
EndIf
AddMapElement(myProject\myForm()\myGadget(),IdGadget)
With myProject\myForm()\myGadget()
\X=GadgetX(GadgetId)
\Y=GadgetY(GadgetId)
\W=GadgetWidth(GadgetId)
\H=GadgetHeight(GadgetId)
EndWith
If SavePreferences()
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure SaveForm(IdForm.s,WindowId)
; Si la fenêtre existe déjà
If FindMapElement(myProject\myForm(),IdForm)=0
MessageRequester("Error AddForm","This form "+IdForm+" not exists")
ProcedureReturn #False
EndIf
; On mémorise la position de la fenêtre
With myProject\myForm()\myPos
\X=WindowX(WindowId)
\Y=WindowY(WindowId)
\W=WindowWidth(WindowId)
\H=WindowHeight(WindowId)
EndWith
If SavePreferences()
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure SaveGadget(IdForm.s,IdGadget.s,GadgetId)
; Si la fenêtre n'existe pas
If FindMapElement(myProject\myForm(),IdForm)=0
MessageRequester("Error AddForm","This form "+IdForm+" not exists")
ProcedureReturn #False
EndIf
; Si le gadget existe déjà
If FindMapElement(myProject\myForm()\myGadget(),IdGadget)=0
MessageRequester("Error AddForm","This gadget "+IdGadget+" not exists")
ProcedureReturn #False
EndIf
With myProject\myForm()\myGadget()
\X=GadgetX(GadgetId)
\Y=GadgetY(GadgetId)
\W=GadgetWidth(GadgetId)
\H=GadgetHeight(GadgetId)
EndWith
If SavePreferences()
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;}
EndModule
DeclareModule TesteForm
Declare Open(MotherWindow)
EndDeclareModule
Module TesteForm
EnableExplicit
Global Form,strTeste,myMotherWindow
Global Flag=#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_WindowCentered
; Ici on donne un nom à la fenêtre et gadget pour la map du fichier JSON
Global IdForm.s="TesteForm",IdGadget.s="TesteForm_strTeste"
;-* PRIVATE PROCEDURE
Procedure Exit()
DisableWindow(myMotherWindow,#False)
CloseWindow(Form)
EndProcedure
Procedure EventResize()
If FindMapElement(Prj::myProject\myForm(),IdForm)=0
MessageRequester("Error EventResize","The IdForm "+IdForm+" not exists")
ProcedureReturn
EndIf
Protected OldW=Prj::myProject\myForm()\myPos\W
Prj::SaveForm(IdForm,Form)
Protected W=Prj::myProject\myForm()\myPos\W-OldW
If FindMapElement(Prj::myProject\myForm()\myGadget(),IdGadget)=0
MessageRequester("Error EventResize","The IdGadget "+IdGadget+" not exists")
ProcedureReturn
EndIf
ResizeGadget(strTeste,#PB_Ignore,#PB_Ignore,Prj::myProject\myForm()\myGadget()\W+W,#PB_Ignore)
Prj::SaveGadget(IdForm,IdGadget,strTeste)
EndProcedure
;}
;-* PUBLIC PROCEDURE
Procedure Open(MotherWindow)
myMotherWindow=MotherWindow
DisableWindow(myMotherWindow,#True)
Protected W=400,H=400,X=0,Y=0,WG=W-20
Form=OpenWindow(#PB_Any,0,0,W,H,"teste fenêtre fille",Flag,WindowID(myMotherWindow))
; Recherche si la fenêtre existe dans les préférence
If FindMapElement(Prj::myProject\myForm(),IdForm)<>0
With Prj::myProject\myForm()\myPos
W=\W
H=\H
X=\X
Y=\Y
ResizeWindow(Form,X,Y,W,H)
EndWith
; Recherche si le gadget existe dans les préférence
If FindMapElement(Prj::myProject\myForm()\myGadget(),IdGadget)<>0
With Prj::myProject\myForm()\myGadget()
WG=\W
EndWith
EndIf
EndIf
strTeste=StringGadget(#PB_Any,10,10,WG,30,"TESTE")
BindEvent(#PB_Event_CloseWindow,@Exit(),Form)
BindEvent(#PB_Event_SizeWindow,@EventResize(),Form)
BindEvent(#PB_Event_MoveWindow,@EventResize(),Form)
; Ajoute la fenêtre au préférence
If FindMapElement(Prj::myProject\myForm(),IdForm)=0
Prj::AddForm(IdForm,Form)
EndIf
; Ajoute le gadget au préférences
If FindMapElement(Prj::myProject\myForm()\myGadget(),IdGadget)=0
Prj::AddGadget(IdForm,IdGadget,strTeste)
EndIf
EndProcedure
;}
EndModule
DeclareModule MainForm
Declare Open()
EndDeclareModule
Module MainForm
EnableExplicit
Global Form,btTeste
Global Flag=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
;-* PRIVATE PROCEDURE
Procedure Exit()
End
EndProcedure
Procedure EventBtTeste()
TesteForm::Open(Form)
EndProcedure
;}
;-* PUBLIC PROCEDURE
Procedure Open()
Form=OpenWindow(#PB_Any,0,0,800,600,"teste",Flag)
Protected W=200,H=30,X=(WindowWidth(Form)/2)-(W/2)
Protected Y=(WindowHeight(Form)/2)-(H/2)
btTeste=ButtonGadget(#PB_Any,X,Y,W,H,"TESTE")
BindEvent(#PB_Event_CloseWindow,@Exit(),Form)
BindGadgetEvent(btTeste,@EventBtTeste())
EndProcedure
;}
EndModule
If FileSize(Prj::PreferencesName)<>-1
Prj::LoadPreference()
EndIf
MainForm::Open()
Repeat:WaitWindowEvent():ForEver