Redimensionner fenêtre et mémoriser la position

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Redimensionner fenêtre et mémoriser la position

Message par microdevweb »

Bonjour à tous,

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
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
celtic88
Messages : 309
Inscription : sam. 12/sept./2015 14:31
Localisation : Alger

Re: Redimensionner fenêtre et mémoriser la position

Message par celtic88 »

merci :D
.....i Love Pb :)
Répondre