It is currently Sat Dec 16, 2017 7:35 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 4 posts ] 
Author Message
 Post subject: [Module] ResourceModule.pbi
PostPosted: Wed Nov 29, 2017 12:54 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Aug 24, 2005 4:02 pm
Posts: 610
Location: Germany
I was looking for a simple, cross-platform solution for my ressources (images).
After I didn't really find something, I made it myself.
Maybe someone else will use it.

Here is a simple GUI, which can be used as an application example at the same time:

Download: ResourceModule.zip

Code:
;/ ===================================
;/ =  ResourceModule [PB 5.6x]       =
;/ ===================================
;/
;/ All OS
;/
;/ Module by Thorsten1867 (11/2017)
;/

#PackResource = #True

CompilerIf #PackResource
 
  DeclareModule PackResource
   
    Declare Open(File$, Name$)
    Declare Close(Name$)
    Declare Add(Name$, File$)
    Declare Create(Name$)
   
  EndDeclareModule

  Module PackResource
   
    EnableExplicit
   
    UseLZMAPacker()
   
    #Pack = 1
    #Json = 1
   
    Structure File_Structure
      File.s
      Size.i
    EndStructure
   
    Structure ResPack_Structure
      Open.i
      File.s
      Map Files.File_Structure()
    EndStructure
   
    Global NewMap ResPack.ResPack_Structure()
   
    Procedure Open(File$, Name$)
     
      If AddMapElement(ResPack(), Name$)
        ResPack()\Open = #True
        ResPack()\File = File$
        ProcedureReturn #True
      EndIf
     
      ProcedureReturn #False
    EndProcedure
   
    Procedure Create(Name$)
      Define Size.i, *Buffer
      Define File$, PackFile$
     
      If FindMapElement(ResPack(), Name$)
       
        PackFile$ = ResPack()\File
       
        If CreatePack(#Pack, PackFile$, #PB_PackerPlugin_Lzma, 9)
         
          ForEach ResPack()\Files()
            File$ = ResPack()\Files()\File
            AddPackFile(#Pack, File$, GetFilePart(File$))
          Next
         
          If CreateJSON(#Json)
            InsertJSONMap(JSONValue(#Json), ResPack()\Files())
            Size = ExportJSONSize(#JSON)
            *Buffer = AllocateMemory(Size)
            If *Buffer
              If ExportJSON(#JSON, *Buffer, Size)
                AddPackMemory(#Pack, *Buffer, Size, "Content.json")
              EndIf
              FreeMemory(*Buffer)
            EndIf
            FreeJSON(#Json)
          EndIf
 
          ClosePack(#Pack)
        EndIf
       
      EndIf
     
      ProcedureReturn #False
    EndProcedure
   
    Procedure Add(Name$, File$)
      Define FileName$, Size.i
     
      If FindMapElement(ResPack(), Name$)
       
        Size = FileSize(File$)
        If Size > 0
         
          FileName$ = GetFilePart(File$)
          ResPack()\Files(FileName$)\File = File$
          ResPack()\Files(FileName$)\Size = Size
         
          ProcedureReturn #True
        EndIf
       
      EndIf
     
      ProcedureReturn #False
    EndProcedure
   
    Procedure Close(Name$)
      If FindMapElement(ResPack(), Name$)
        DeleteMapElement(ResPack())
      EndIf
    EndProcedure
   
  EndModule

CompilerEndIf


DeclareModule Resource
 
  Declare Open(Pack.i, File$)
  Declare.i GetImage(Pack.i, Image.i, FileName$)
  Declare.i GetXML(Pack.i, XML.i, FileName$)
  Declare.i GetJSON(Pack.i, JSON.i, FileName$)
  Declare.i GetSound(Pack.i, Sound.i, FileName$)
  Declare.i GetFileSize(Pack.i, FileName$)
  Declare.i GetFileMemory(Pack.i, *Buffer, FileName$)
  Declare Close(Pack.i)
 
EndDeclareModule

Module Resource
 
  EnableExplicit

  UseLZMAPacker()
 
  #Pack = 1
  #JSON = 1
 
  Structure File_Structure
    Name.s
    Size.i
  EndStructure
 
  Structure Content_Structure
    PackFile.s
    Map Content.File_Structure()
  EndStructure
 
  Global NewMap ResEx.Content_Structure()
 
  Procedure Open(Pack.i, File$)
    Define.i Result, Size
    Define *Buffer
   
    Result = OpenPack(Pack, File$ , #PB_PackerPlugin_Lzma)
    If Result
     
      If Pack = #PB_Any : Pack = Result : EndIf
     
      ResEx(Str(Pack))\PackFile = File$
     
      If ExaminePack(Pack)
        While NextPackEntry(Pack)
          If PackEntryName(Pack) = "Content.json"
            Size    = PackEntrySize(Pack)
            *Buffer = AllocateMemory(Size)
            If *Buffer
              If UncompressPackMemory(Pack, *Buffer, Size)
                If CatchJSON(#JSON, *Buffer, Size)
                  ExtractJSONMap(JSONValue(#JSON), ResEx()\Content())
                  FreeJSON(#JSON)
                EndIf
              EndIf
              FreeMemory(*Buffer)
            EndIf
            Break
          EndIf
        Wend
      EndIf
     
      ProcedureReturn Pack
    EndIf
   
    ProcedureReturn #False
  EndProcedure
 
  Procedure.i GetImage(Pack.i, Image.i, FileName$)
    Define.i Result.i, *Buffer

    If FindMapElement(ResEx(), Str(Pack))
     
      FileName$ = GetFilePart(FileName$)
      If FindMapElement(ResEx()\Content(), FileName$)
       
        *Buffer = AllocateMemory(ResEx()\Content()\Size)
        If *Buffer
          If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
            Result = CatchImage(Image, *Buffer, ResEx()\Content()\Size)
            If Result
              If Image = #PB_Any : Image = Result :  EndIf
            Else
              Image = #False
            EndIf
          EndIf
          FreeMemory(*Buffer)
        EndIf
       
        ProcedureReturn Image
      EndIf
     
    EndIf
   
    ProcedureReturn #False
  EndProcedure
 
  Procedure.i GetSound(Pack.i, Sound.i, FileName$)
    Define.i Result.i, *Buffer

    If FindMapElement(ResEx(), Str(Pack))
     
      FileName$ = GetFilePart(FileName$)
      If FindMapElement(ResEx()\Content(), FileName$)
       
        *Buffer = AllocateMemory(ResEx()\Content()\Size)
        If *Buffer
          If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
            Result =  CatchSound(Sound, *Buffer, ResEx()\Content()\Size)
            If Result
              If Sound = #PB_Any : Sound = Result :  EndIf
            Else
              Sound = #False
            EndIf
          EndIf
          FreeMemory(*Buffer)
        EndIf
       
        ProcedureReturn Sound
      EndIf
     
    EndIf
   
    ProcedureReturn #False
  EndProcedure
 
  Procedure.i GetXML(Pack.i, XML.i, FileName$)
    Define.i Result.i, *Buffer

    If FindMapElement(ResEx(), Str(Pack))
      FileName$ = GetFilePart(FileName$)
      If FindMapElement(ResEx()\Content(), FileName$)
        *Buffer = AllocateMemory(ResEx()\Content()\Size)
        If *Buffer
          If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
            Result = CatchXML(XML, *Buffer, ResEx()\Content()\Size)
            If Result
              If XML = #PB_Any : XML = Result :  EndIf
            Else
              XML = #False
            EndIf
          EndIf
          FreeMemory(*Buffer)
        EndIf
      EndIf
      ProcedureReturn XML
    EndIf
   
    ProcedureReturn #False
  EndProcedure
 
  Procedure.i GetJSON(Pack.i, JSON.i, FileName$)
    Define Result.i, *Buffer

    If FindMapElement(ResEx(), Str(Pack))
      FileName$ = GetFilePart(FileName$)
      If FindMapElement(ResEx()\Content(), FileName$)
        *Buffer = AllocateMemory(ResEx()\Content()\Size)
        If *Buffer
          If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
            Result = CatchJSON(JSON, *Buffer, ResEx()\Content()\Size)
            If Result
              If JSON = #PB_Any : JSON = Result :  EndIf
            Else
              JSON = #False
            EndIf
          EndIf
          FreeMemory(*Buffer)
        EndIf
      EndIf
      ProcedureReturn JSON
    EndIf
  EndProcedure
 
  Procedure.i GetFileSize(Pack.i, FileName$)
    If FindMapElement(ResEx(), Str(Pack))
      FileName$ = GetFilePart(FileName$)
      If FindMapElement(ResEx()\Content(), FileName$)
        ProcedureReturn ResEx()\Content()\Size
      EndIf
    EndIf
  EndProcedure
 
  Procedure.i GetFileMemory(Pack.i, *Buffer, FileName$)
    Define Result.i
   
    If FindMapElement(ResEx(), Str(Pack))
      FileName$ = GetFilePart(FileName$)
      If FindMapElement(ResEx()\Content(), FileName$)
        Result = UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
        ProcedureReturn Result
      EndIf
    EndIf
    ProcedureReturn #False
  EndProcedure
 
  Procedure Close(Pack.i)
    If FindMapElement(ResEx(), Str(Pack))
      DeleteMapElement(ResEx())
      ClosePack(Pack)
    EndIf
  EndProcedure
 
EndModule


CompilerIf #PB_Compiler_IsMainFile
 
  UsePNGImageDecoder()
 
  CompilerIf #PackResource
    If PackResource::Open("Test.res", "Test")
     
      PackResource::Add("Test", #PB_Compiler_Home + "examples\sources\Data\PureBasic.bmp")
      PackResource::Add("Test", #PB_Compiler_Home + "examples\sources\Data\CdPlayer.ico")
      PackResource::Add("Test", #PB_Compiler_Home + "examples\sources\Data\world.png")
     
      PackResource::Create("Test")
     
      PackResource::Close("Test")
    EndIf
  CompilerEndIf
 
  #Win = 0
  #Pack = 1
  #ImageGadget = 1
  #Image = 1
 
  If Resource::Open(#Pack, "Test.res")
    Resource::GetImage(#Pack, #Image, "PureBasic.bmp")
    Resource::Close(#Pack)
  EndIf
 
  If OpenWindow(#Win, 100, 100, 300, 200, "Resource - Image")
   
    If IsImage(#Image)
      ImageGadget(#ImageGadget, 10, 10, 100, 100, ImageID(#Image), #PB_Image_Border)
    EndIf
   
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
   
    CloseWindow(#Win)
  EndIf

 
CompilerEndIf

_________________
Sorry for my English. My language is German.
(Translated with www.DeepL.com/Translator)

[Windows 10 x64] [PB V5.61x]


Top
 Profile  
Reply with quote  
 Post subject: Re: [Module] ResourceModule.pbi
PostPosted: Thu Nov 30, 2017 9:32 am 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 382
Location: Berlin and Ibiza
Thank you, that's great. Image

_________________
ImageImageImageImage


Top
 Profile  
Reply with quote  
 Post subject: Re: [Module] ResourceModule.pbi
PostPosted: Fri Dec 01, 2017 3:52 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Aug 24, 2005 4:02 pm
Posts: 610
Location: Germany
Now use ZIP instead of LZMA, because this has caused an inexplicable memory error with certain images.

Internal changes in the module. It is now enough to pack the resources into a ZIP archive.

_________________
Sorry for my English. My language is German.
(Translated with www.DeepL.com/Translator)

[Windows 10 x64] [PB V5.61x]


Top
 Profile  
Reply with quote  
 Post subject: Re: [Module] ResourceModule.pbi
PostPosted: Tue Dec 05, 2017 2:15 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 3958
Location: Lyon - France
Thanks for sharing 8)

_________________
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  [ 4 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 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