SaveFile procedure

Share your advanced PureBasic knowledge/code with the community.
Chris
User
User
Posts: 60
Joined: Wed Jun 11, 2003 4:54 pm
Location: Somewhere... But i can see you!

SaveFile procedure

Post by Chris »

Code updated For 5.20+

Hi! :)

I've made this procedure for save files.

Explanation.
If several extensions are contained in the filter, (eg: *.jpg; *.jpeg; *.bmp), and if you don't specify any extension in the title of the file, or if you put an extension which is not contained in the filter, (eg: .png), the file will be saved with the first extension found in the selected filter (eg: .jpg)

If you put an extension, and if she is contained in the filter, the file will be saved with the extension you are entered.

If you choose "all types", you can save with the extension which you want. (eg: .glop), and if you don't put extension, it will have nothing.

Code: Select all

Procedure.s SaveFile(Titre$, Defaut$, Filtre$, Position)
  ;{- Getting the extensions and associated indexes
  Structure SAUVEFICHIERS
    id.w
    Extens.s
  EndStructure
  NewList Extensions.SAUVEFICHIERS()
  
  Num = 0 : I = 1 : J = 2
  
  Repeat
    Typ$ = StringField(Filtre$, I, "|")
    Ext$ = StringField(Filtre$, J, "|")
    
    If Ext$
      If FindString(Ext$, ";", 1)
        Count = CountString(Ext$, ";")
        For k = 0 To Count
          n$ = StringField(Ext$, k + 1, ";")
          AddElement(Extensions())
          Extensions()\id = Num
          Extensions()\Extens = StringField(n$, 2, ".") ;n$
        Next
      Else
        AddElement(Extensions())
        Extensions()\id = Num
        Extensions()\Extens = StringField(Ext$, 2, ".") ;Ext$
      EndIf
    EndIf
    I + 2 : J + 2 : Num + 1
  Until Ext$ = "" Or Typ$ = ""
  ;}-
  
  ;{- Treatment of the filenames
  ;
  Full_Path$ = SaveFileRequester(Titre$, Defaut$, Filtre$, Position)
  
  If Full_Path$
    ; Verify that the path does not ended by a point
    If Right(Full_Path$,1) = "."
      Full_Path$  = Left(Full_Path$, Len(Full_Path$)-1)
    EndIf
    
    ; Getting de datas of the file
    Fic_Chemin$     = GetPathPart(Full_Path$)
    Fic_Extension$  = GetExtensionPart(Full_Path$)
    Fic_Fichier$    = StringField(GetFilePart(Full_Path$),1,".")
    Fic_Index       = SelectedFilePattern()
    
    ; Vérifiez que le choix n'est pas "*. *".
    ForEach Extensions()
      If Extensions()\id = Fic_Index And Extensions()\Extens = "*"
        If Fic_Extension$
          ProcedureReturn Fic_Chemin$+Fic_Fichier$+"."+Fic_Extension$
        Else
          ProcedureReturn Fic_Chemin$+Fic_Fichier$
        EndIf
        Break
      EndIf
    Next
    ResetList(Extensions())
    
    ; If the choice are not "*.*"
    ForEach Extensions()
      If Extensions()\id = Fic_Index
        P = ListIndex(Extensions())
        Fic_Def$ = Extensions()\Extens
        Break
      EndIf
    Next
    
    If Fic_Extension$
      SelectElement(Extensions(),P)
      While Extensions()\id = Fic_Index
        If Extensions()\Extens = Fic_Extension$
          Extension$ = Extensions()\Extens
          Break
        Else
          Extension$ = Fic_Def$
        EndIf
        NextElement(Extensions())
      Wend
    Else
      Extension$ = Fic_Def$
    EndIf
    
    NomFichier$ = Fic_Chemin$ + Fic_Fichier$ + "." + Extension$
    ClearList(Extensions())
    ProcedureReturn NomFichier$
  Else
    ClearList(Extensions())
    ProcedureReturn
  EndIf ;}
EndProcedure

;-============================ Procedure test ============================
;/ Title
T$ = "Save a file"
;/ Default file & path
D$ = "\..\PureBasic\ParDefaut.txt"
;/ Filters
F$ = "Fichiers texte (*.txt)|*.txt|Texte enrichi (*.rtf,rtx,rty,rtz)|*.rtf;*.rtx;*.rty;*.rtz|Format Word (*.doc,*.dog,*.dod)|*.doc;*.dog;*.dod|Tous types (*.*)|*.*"
;/ Default position
P = 1

CheminFichier$ = SaveFile(T$,D$,F$,P) ; appel de la procédure

If CheminFichier$
  MessageRequester("Saved file", "A file have been saved in:"+Chr(10) + CheminFichier$, #MB_ICONINFORMATION)
EndIf

If CheminFichier$
  If CreateFile(0, CheminFichier$)
    CloseFile(0)
  EndIf
EndIf
My english is bad !!!... It's normal, i'm french :lol:
My english is not really the English.
It's the FrogLish (Froggy's English) ;)
Bonne_den_kule
Addict
Addict
Posts: 841
Joined: Mon Jun 07, 2004 7:10 pm

Post by Bonne_den_kule »

Have u heard about SaveFileRequester(Title$, DefaultFile$, Pattern$, PatternPosition) :?:

8O
filperj
User
User
Posts: 77
Joined: Tue Sep 16, 2003 8:53 pm
Location: Nevers(France)

Post by filperj »

I think he has heard of SaveFileRequester(), as his procedure uses it :lol:
It just add some features.
Chris
User
User
Posts: 60
Joined: Wed Jun 11, 2003 4:54 pm
Location: Somewhere... But i can see you!

Post by Chris »

filperj wrote:I think he has heard of SaveFileRequester(), as his procedure uses it :lol:
It just add some features.
Maybe... he has answered by looking the title, without reading the message or examining the code :roll: :lol:
My english is bad !!!... It's normal, i'm french :lol:
My english is not really the English.
It's the FrogLish (Froggy's English) ;)
Bonne_den_kule
Addict
Addict
Posts: 841
Joined: Mon Jun 07, 2004 7:10 pm

Post by Bonne_den_kule »

Sorry! I didn't read the code.
Good work!
Post Reply