[Module] ResourceModule.pbi
Verfasst: 29.11.2017 13:54
Ich habe nach einer simplen, betriebssystemübergreifenden Lösung für meine Ressouren (Images) gesucht.
Nachdem ich nicht wirklich etwas gefunden habe, habe ich selber etwas zusammengebastelt.
Vielleicht hat ja noch jemand Verwendung dafür.
Hier noch eine simple GUI, die gleichzeitig als Anwendungsbeispiel dienen kann:
Download: ResourceModule.zip
Nachdem ich nicht wirklich etwas gefunden habe, habe ich selber etwas zusammengebastelt.
Vielleicht hat ja noch jemand Verwendung dafür.
Hier noch eine simple GUI, die gleichzeitig als Anwendungsbeispiel dienen kann:
Download: ResourceModule.zip
Code: Alles auswählen
;/ ===================================
;/ = 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