It is currently Wed Oct 28, 2020 3:02 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: [PB4 IDE] ReadPureBasicTemplates()
PostPosted: Mon May 22, 2006 11:20 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Jul 22, 2003 5:02 pm
Posts: 1542
Location: In a long distant galaxy
Code:
; Read the PureBasic 4.0 Templates file

Structure PB_TEMPLATE
  name.s
  code.s
  comment.s
EndStructure

Procedure.l ReadPureBasicTemplates(gadget.l)
 
  Protected file.l, depth.l, result.l, line.s, value.s, *item.PB_TEMPLATE
 
  If IsGadget(gadget)
   
    file = ReadFile(#PB_Any, #PB_Compiler_Home + "Templates.prefs")
   
    If file
     
      While Eof(file) = #False
       
        line  = ReadString(file)
        value = Trim(StringField(line, 2, ":"))
       
        Select Trim(StringField(line, 1, ":"))
         
          Case "TEMPLATES"
            If value = "1.0"
              result = #True
            Else
              Break
            EndIf
           
          Case "Directory"
            AddGadgetItem(gadget, -1, value, 0, depth)
            depth + 1
           
          Case "Expanded"
            SetGadgetItemState(gadget, CountGadgetItems(gadget)-1, #PB_Tree_Expanded)
           
          Case "Template"
            *item = AllocateMemory(SizeOf(PB_TEMPLATE))
            If *item
              *item\name = value
              AddGadgetItem(gadget, -1, *item\name, 0, depth)
              SetGadgetItemData(gadget, CountGadgetItems(gadget)-1, *item)
            EndIf
           
          Case "Comment"
            *item\comment = ReplaceString(value, "\n", #CRLF$)
           
          Case "Code"
            *item\code = ReplaceString(value, "\n", #CRLF$)
           
          Case "CloseDirectory"
            depth - 1
           
        EndSelect
       
      Wend
     
      CloseFile(file)
     
    EndIf
   
  EndIf
 
  ProcedureReturn result
 
EndProcedure

Procedure.l Main()
 
  If OpenWindow(0, 0, 0, 320, 400, "PureBasic Templates", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
   
    If CreateGadgetList(WindowID(0))
      TreeGadget(0, 5, 5, 310, 390, #PB_Tree_AlwaysShowSelection)
    EndIf
   
    ReadPureBasicTemplates(0)
   
    Repeat
     
      Select WaitWindowEvent()
       
        Case #PB_Event_CloseWindow
          Break
         
        Case #PB_Event_Gadget
          If EventType() = #PB_EventType_Change
            *item.PB_TEMPLATE = GetGadgetItemData(0, GetGadgetState(0))
            If *item
              Debug *item\name
              Debug *item\comment
              Debug *item\code
            EndIf
          EndIf
         
      EndSelect
     
    ForEver
   
  EndIf
 
EndProcedure

Main()


it might be a good idea to share the templates between PureBasic IDE and jaPBe, no ? :roll:

_________________
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Mon May 22, 2006 11:24 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Jul 22, 2003 5:02 pm
Posts: 1542
Location: In a long distant galaxy
by the way there's a bug i can't solve line 38

Case "Expanded" : expands don't works.

_________________
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer


Top
 Profile  
Reply with quote  
 Post subject: Re: [PB4 IDE] ReadPureBasicTemplates()
PostPosted: Wed Aug 25, 2010 12:12 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4746
Location: Lyon - France
Hello my king FLYPE :wink:

I know you not pass enough on this forum :(
But i need this style of code.

And KCC dare to try to continue your splendid works, with only his stucco fingers and sink brain :oops:
Obviously, this is not of GREAT FLYPE code :oops: ....but i have try to copy your method for create two functions InsertListPureBasicTemplates and InsertPureBasicTemplates :D

I have created this code, because i have hundreds constants to manage, and i have not the courage to insert it one by one myself :(
And FRED not planned to can insert template by lot :(
So like Template.pref is text file..Kcc can modify it :D
Like this i can insert one template or furthermore a full text in the template

Apparently, that works....but be careful, because...the better code of KCC, can be sometime worse, that a real virus :lol: :lol:

So i have copy before all thing, the "template.pref" for not have several enemy after that members test my code :roll:

I have not understand the function of EXPANDED :oops:
If someone can explain to me ..... :roll:

If by miracle someone need this style of code....and furthermore not know how create it :lol: :lol:
I'm not sure this man exist in this world :roll:
It's for him :mrgreen:

So this is an example file text to can insert (Create it on the folder of PB)

Code:
Structure PB_TEMPLATE
Directory.s
Name.s
Code.s
Comment.s
EndStructure

Enumeration

#FenetreProgramme
#FenetreEntrer
#CadreCode
#CadreCommentaire
#BoutonEnregistrer
#BoutonAnnuler
#StringCommentaire
#StringCode
#ListTemplate

#Menu
#MenuAjouterListe
#MenuAjouterLigne

EndEnumeration

Define NewItem.PB_TEMPLATE
Define *Item.PB_TEMPLATE

Global CheminTemplate.s = #PB_Compiler_Home

Procedure InsertFichier(Fichier.s)
 
 If FileSize(Fichier) = - 1
       
  MessageRequester("", "Le fichier ''" + Fichier + "'' n'existe pas.")
  CloseFile(CanalFileRead)
  CloseFile(CanalFileWrite)
 
  If FileSize("Templates.temp") <> - 1
   DeleteFile("Templates.temp")
  EndIf
   
  ProcedureReturn
 
 Else
   
  CanalFichier = ReadFile(#PB_Any, Fichier) 
 
  Repeat
   
   Donnee$ = ReadString(CanalFichier)
   WriteStringN(CanalFileWrite, "  Template: " + Donnee$)
   WriteStringN(CanalFileWrite, "    Comment: ")
   WriteStringN(CanalFileWrite, "    Code: " + Donnee$)
   
  Until Eof(CanalFichier) <> 0
 
  CloseFile(CanalFichier)
   
 EndIf
 
EndProcedure

Procedure.l ReadPureBasicTemplates(Gadget.l)
 
 Protected File.l, Depth.l, Result.l, Line.s, Value.s, *Item.PB_TEMPLATE

 If IsGadget(Gadget)
 
  ClearGadgetItems(Gadget)
  File = ReadFile(#PB_Any, CheminTemplate + "Templates.prefs")
 
  If File
   
   While Eof(File) = #False
   
    Line  = ReadString(File)
    Value = Trim(StringField(Line, 2, ":"))
   
    Select Trim(StringField(Line, 1, ":"))
     
     Case "TEMPLATES"
     
      If Value = "1.0"
       Result = #True
      Else
       Break
      EndIf
     
     Case "Directory"
     
      AddGadgetItem(Gadget, -1, Value, 0, Depth)
      Depth + 1
      Folder$ = ReplaceString(Value, "\n", #CRLF$)
           
     Case "Expanded"
     
      SetGadgetItemState(Gadget, CountGadgetItems(Gadget)-1, #PB_Tree_Expanded)
     
     Case "Template"
     
      *Item = AllocateMemory(SizeOf(PB_TEMPLATE))
     
      If *Item
       *Item\Name = Value
       *Item\Directory = Folder$
       AddGadgetItem(Gadget, -1, *Item\Name, 0, Depth)
       SetGadgetItemData(Gadget, CountGadgetItems(Gadget) - 1, *Item)
      EndIf
     
     Case "Comment"
     
      *Item\Comment = ReplaceString(Value, "\n", #CRLF$)
     
     Case "Code"
     
      *Item\Code = ReplaceString(Value, "\n", #CRLF$)
     
     Case "CloseDirectory"
     
      Depth - 1
     
    EndSelect
   
   Wend
 
   CloseFile(File)
   
  EndIf
 
 EndIf

 ProcedureReturn Result
 
EndProcedure

Procedure.l InsertPureBasicTemplates(Directory.s, PreviousTemplate.s, *Item.PB_TEMPLATE)
 
 Protected CanalFileRead.l, CanalFileWrite.l, Line.s
 
 If FileSize("Templates.temp") <> - 1
  DeleteFile("Templates.temp")
 EndIf
 
 If Trim(StringField(Line, 2, ":")) = ""
  FoundPreviousTemplate = #True
 Else
  FoundPreviousTemplate = #False     
 EndIf
 
 FoundDirectory = #False
 
 RefDateHeure.s = FormatDate("%yy%mm%dd", Date()) + FormatDate("%hh%ii%ss", Date())
 CopyFile(CheminTemplate + "Templates.prefs", CheminTemplate + "Templates" + RefDateHeure + ".prefs")
 CanalFileRead = ReadFile(#PB_Any, CheminTemplate + "Templates.prefs")
 CanalFileWrite = OpenFile(#PB_Any, CheminTemplate + "Templates.temp")

 If CanalFileRead
 
  While Eof(CanalFileRead) = #False
   
   Line  = ReadString(CanalFileRead)
       
   Select Trim(StringField(Line, 1, ":"))
     
    Case "TEMPLATES"
     
     WriteStringN(CanalFileWrite, Line)
     WriteStringN(CanalFileWrite, "")
       
    Case "Directory"
     
     WriteStringN(CanalFileWrite, Line)
     
     If Trim(StringField(Line, 2, ":")) = Trim(Directory)
                 
      If Trim(PreviousTemplate) = ""
       WriteStringN(CanalFileWrite, "  Template: " + *Item\Name)
       WriteStringN(CanalFileWrite, "    Comment: " + *Item\Comment)
       WriteStringN(CanalFileWrite, "    Code: " + *Item\Code)
       FoundPreviousTemplate = #False
       FoundDirectory = #False
      Else
       FoundDirectory = #True
      EndIf
     
     EndIf
               
    Case "Template"
     
     If Trim(StringField(Line, 2, ":")) = Trim(PreviousTemplate)
      FoundPreviousTemplate = #True
     EndIf
     
     WriteStringN(CanalFileWrite, Line)
         
    Case "Code"
     
     If FoundDirectory And FoundPreviousTemplate
     
      WriteStringN(CanalFileWrite, Line)
      WriteStringN(CanalFileWrite, "  Template: " + *Item\Name)
      WriteStringN(CanalFileWrite, "    Comment: " + *Item\Comment)
      WriteStringN(CanalFileWrite, "    Code: " + *Item\Code)
      FoundPreviousTemplate = #False
      FoundDirectory = #False
     
     Else
     
      WriteStringN(CanalFileWrite, Line)
     
     EndIf
     
    Default
     
     If Trim(Line) <> ""
      WriteStringN(CanalFileWrite, Line)
     EndIf
     
   EndSelect
   
  Wend
 
  CloseFile(CanalFileRead)
  CloseFile(CanalFileWrite)
   
 EndIf
 
 If Not DeleteFile(CheminTemplate + "Templates.prefs")
 
  MessageRequester("" , "Le fichier ''Template.pref'' n'a pas pu etre éffacé")
 
 Else
 
  If Not RenameFile(CheminTemplate + "Templates.temp", CheminTemplate + "Templates.prefs")
   MessageRequester("" , "Le nouveau fichier ''Pref' n'a pas pu etre renommé")
  EndIf
 
 EndIf
 
EndProcedure
 
Procedure.l InsertListPureBasicTemplates(Directory.s, PreviousTemplate.s, FileList.s)
 
 Protected Line.s
 
 If FileSize("Templates.temp") <> - 1
  DeleteFile("Templates.temp")
 EndIf
 
 FoundPreviousTemplate = #False
 FoundDirectory = #False
 RefDateHeure.s = FormatDate("%yy%mm%dd", Date()) + FormatDate("%hh%ii%ss", Date())
 CopyFile(CheminTemplate + "Templates.prefs", CheminTemplate + "Templates" + RefDateHeure + ".prefs")
 CanalFileRead = ReadFile(#PB_Any, CheminTemplate + "Templates.prefs")
 CanalFileWrite = OpenFile(#PB_Any, CheminTemplate + "Templates.temp")

 If CanalFileRead
 
  While Eof(CanalFileRead) = #False
   
   Line  = ReadString(CanalFileRead)
       
   Select Trim(StringField(Line, 1, ":"))
     
    Case "TEMPLATES"
     
     WriteStringN(CanalFileWrite, Line)
     WriteStringN(CanalFileWrite, "")
       
    Case "Directory"
     
     WriteStringN(CanalFileWrite, Line)
     
     If Trim(StringField(Line, 2, ":")) = Trim(Directory)
           
      If Trim(PreviousTemplate) = ""
 
       InsertFichier(FileList)
       FoundPreviousTemplate = #False
       FoundDirectory = #False
       
      Else
       
       FoundDirectory = #True
       
      EndIf
     
     EndIf
               
    Case "Template"
     
     If Trim(StringField(Line, 2, ":")) = Trim(PreviousTemplate)
      FoundPreviousTemplate = #True
     EndIf
     
     WriteStringN(CanalFileWrite, Line)
         
    Case "Code"
     
     If FoundDirectory And FoundPreviousTemplate
      InsertFichier(FileList)
      FoundPreviousTemplate = #False
      FoundDirectory = #False
     EndIf
     
     WriteStringN(CanalFileWrite, Line)
     
    Default
     
     If Trim(Line) <> ""
      WriteStringN(CanalFileWrite, Line)
     EndIf
     
   EndSelect
   
  Wend
 
  CloseFile(CanalFileRead)
  CloseFile(CanalFileWrite)
   
 EndIf
 
 If Not DeleteFile(CheminTemplate + "Templates.prefs")
 
  MessageRequester("" , "Le fichier ''Template.pref'' n'a pas pu etre éffacé")
 
 Else
 
  If Not RenameFile(CheminTemplate + "Templates.temp", CheminTemplate + "Templates.prefs")
   MessageRequester("" , "Le nouveau fichier ''Pref' n'a pas pu etre renommé")
  EndIf
 
 EndIf
 
 MessageRequester("" , "Le fichier ''" + FileList + "'' a été ajouté")
 
EndProcedure

OpenWindow(#FenetreProgramme, 0, 0, 320, 400, "PureBasic Templates", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
TreeGadget(#ListTemplate, 5, 5, 310, 370, #PB_Tree_AlwaysShowSelection)
CreateMenu(#Menu, WindowID(#FenetreProgramme))
MenuTitle("Action")
MenuItem(#MenuAjouterLigne, "Add a template")
MenuItem(#MenuAjouterListe, "Add a file of template")

ReadPureBasicTemplates(#ListTemplate)

Repeat

Select WaitWindowEvent()
   
  Case #PB_Event_Menu   
   
   EvenementMenu = EventMenu()
     
   If EvenementMenu = #MenuAjouterLigne
   
    Template.s = InputRequester("Template", "Enter the name of template", "")
    OpenWindow(#FenetreEntrer, 333, 162, 960, 470, "",  #PB_Window_SystemMenu | #PB_Window_TitleBar )
    Frame3DGadget(#CadreCode, 10, 10, 941, 305, "Code:")
    Frame3DGadget(#CadreCommentaire, 12, 331, 938, 95, "Commentaire:")
    StringGadget(#StringCode, 20, 29, 918, 275, "", #ES_MULTILINE|#ES_AUTOVSCROLL|#WS_VSCROLL|#WS_HSCROLL|#ESB_DISABLE_LEFT|#ESB_DISABLE_RIGHT)
    StringGadget(#StringCommentaire, 21, 347, 920, 71, "", #ES_MULTILINE|#ES_AUTOVSCROLL|#WS_VSCROLL|#WS_HSCROLL|#ESB_DISABLE_LEFT|#ESB_DISABLE_RIGHT)
    ButtonGadget(#BoutonEnregistrer, 348, 438, 125, 25, "Enregistrer")
    ButtonGadget(#BoutonAnnuler, 486, 437, 125, 25, "Annuler")
    NewItem\Code = ""
    NewItem\Comment = ""
   
    Repeat 
     
     Evenement = WaitWindowEvent()
     
     Select Evenement
       
      Case #PB_Event_Gadget
       
       EvenementGadget = EventGadget()
       
       If EvenementGadget = #BoutonEnregistrer
       
        NewItem\Name = Template
        NewItem\Code = GetGadgetText(#StringCode)
        NewItem\Comment = GetGadgetText(#StringCommentaire)
        ActualDirectory.s = GetGadgetItemText(#ListTemplate, GetGadgetState(#ListTemplate))
       
        If *Item
         InsertPureBasicTemplates(*Item\Directory, *Item\Name, NewItem)
        Else
         InsertPureBasicTemplates(ActualDirectory, "", NewItem)
        EndIf
       
        ReadPureBasicTemplates(#ListTemplate)
        CloseWindow(#FenetreEntrer)
        Break
       
       ElseIf EvenementGadget = #BoutonAnnuler
       
        CloseWindow(#FenetreEntrer)
        Break
       
       EndIf
       
      Case #PB_Event_CloseWindow
       
       CloseWindow(#FenetreEntrer)
       Break
       
     EndSelect
     
    ForEver
   
   ElseIf EvenementMenu = #MenuAjouterListe
   
    FichierChoisi$ = OpenFileRequester("Select the file to insert", #PB_Compiler_Home, "Template|*.txt", 0)
   
    If Trim(FichierChoisi$) <> ""
     
     ActualDirectory.s = GetGadgetItemText(#ListTemplate, GetGadgetState(#ListTemplate))
   
     If *Item
      InsertListPureBasicTemplates(*Item\Directory, *Item\Name.s, FichierChoisi$)
     Else
      InsertListPureBasicTemplates(ActualDirectory, "", FichierChoisi$)
     EndIf
     
     ReadPureBasicTemplates(#ListTemplate)
                 
    EndIf
   
   EndIf
 
  Case #PB_Event_CloseWindow
   
   Break
   
  Case #PB_Event_Gadget
   
   EvenementGadget = EventType()
   
   If EvenementGadget = #PB_EventType_Change
   
    *Item.PB_TEMPLATE = GetGadgetItemData(#ListTemplate, GetGadgetState(#ListTemplate))
   
    If *Item
     Debug *Item\Directory
     Debug *Item\Name
     Debug *Item\Comment
     Debug *Item\Code
     Debug ""
    Else
     Debug GetGadgetItemText(#ListTemplate, GetGadgetState(#ListTemplate))
    Debug ""
   
   EndIf
       
  EndIf
   
EndSelect

ForEver



Edit : Fix a big bang......no no...a big bug :oops:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 19 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye