PureBasic

Code : Tout sélectionner

;
; fabriquer un beau .pak - source PureBasic 4.20
;

If ReadFile(0, OpenFileRequester("Choose a file to compress", "", "*.*", 0))
  FileLength = Lof(0)
  
  ; Allocate the 2 memory buffers needed for compression..
  ;
  *Source = AllocateMemory(FileLength)
  *Target = AllocateMemory(FileLength+8)
  If FileLength And *Source And *Target
    ReadData(0, *Source, FileLength) ; Read the whole file in the memory buffer
    
    ; Compress our file, which is in memory (and use a timer to see the time spend by compression..)
    ;
    CompressedLength = PackMemory(*Source, *Target, FileLength)

; Resultat = AddPackMemory(AdresseMemoire, Longueur [, NiveauCompression])

  If CreatePack("test.pak")
    AddPackMemory(*Target, FileLength+8, 9);Ajoute et compresse les données de l'image
    ClosePack()
  EndIf

    FreeMemory(*Source)
    FreeMemory(*Target)    
    
  EndIf
  
  CloseFile(0)
EndIf

End

Code : Tout sélectionner

; ------------------------------------------------------------
; - PC - winXp 
; Test de lecture d'une image compressé dans un pack - source PureBasic 4.20
; pseudo: beauregard
; ------------------------------------------------------------
If InitMouse ()=0 Or InitKeyboard ()=0 Or InitSprite ()=0  Or InitSprite3D ()=0 
     MessageRequester ( "Error" , "Can't open DirectX 7 or later" , 0)
     End
EndIf
UsePNGImageDecoder()


; °°°°°°°°°°°°°°°°°°°°  fonte °°°°°°°°°°°°°°°°°°°°°°°°°°
LoadFont ( 0 , "Comic Sans Ms" ,20, #PB_Font_Bold)
; °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°

Enumeration ; ici, on donne un petit nom à nos sprites( non, chuis pas un numéro !):
#sortie
EndEnumeration

Declare Fin()

If OpenWindow ( 0 , 0, 0, 1024+48, 768+48, "test" , #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar|#PB_Window_ScreenCentered  ) ; on ouvre une fenetre
 OpenWindowedScreen ( WindowID ( 0 ), 23, 23, 1024, 768, 0, 1, 1) ; un ecran graphique dans la fenêtre.
EndIf

LoadSprite(#sortie, "image.bmp",0) ; <- ligne à désactiver une fois que j'aurai réussi à extraire les données du .pak

; le champ de bataille:

;CreatePack("test.pak")

;OpenPack("test.pak");NomFichier$) 
;  *Source = AllocateMemory(FileLength)
;  *Target = AllocateMemory(FileLength+8)
;  If FileLength And *Source And *Target
;    ReadData(0, *Source, FileLength) ; Read the whole file in the memory buffer
    

;      DecompressedLength = UnpackMemory(*Target, *Source) ; heu, je ne sais plus où je vais là, ni même d'où je viens...



; ******************************************************************************************************
Repeat ; Boucle principale
; ******************************************************************************************************
 Event= WindowEvent ()

 ;ExamineMouse():
 ExamineKeyboard ()


DisplayTransparentSprite( #sortie , 512-32, 384-32)



vram=AvailableScreenMemory()

 StartDrawing ( ScreenOutput ())
 DrawingMode (1)
 FrontColor ( RGB (255,255,255))

     vram$= Str (vram)
     FrontColor ( RGB (154,154,154)) :DrawText (1+1,120+1, "vram: " +vram$)
     FrontColor ( RGB (234,234,234)) :DrawText (1,120, "vram: " +vram$)

 StopDrawing ()

 If KeyboardPushed ( #PB_Key_F ) And nbreis=0:nbreis+1:EndIf
 If KeyboardPushed ( #PB_Key_F )=0 And nbreis=1:nbreis+1:EndIf
 If KeyboardPushed ( #PB_Key_F ) And nbreis=2:nbreis+1:EndIf
 If KeyboardPushed ( #PB_Key_F )=0 And nbreis=3:nbreis=0:EndIf

         Gosub fps ; nombre d'image par seconde. 
; ******************************************************************************************************   

 FlipBuffers(1) 
 ClearScreen(RGB(0, 42, 255)) 
 
 If Event= #PB_Event_CloseWindow Or KeyboardPushed ( #PB_Key_Escape ):Fin():EndIf; si clique coin haut droit ou touche Esc, alors ferme fenêtre.
ForEver

fps:
If Val ( FormatDate ( "%ss" , Date ()))=sek 
    fps+1
Else
    FPS$= Str (fps)
    fps=0
EndIf
sek= Val ( FormatDate ( "%ss" , Date ()))
StartDrawing ( ScreenOutput ())
DrawingMode (1)
FrontColor ( RGB (255,255,255))
If nbreis=1 Or nbreis=2:DrawText (1,1, "FPS: " +FPS$):EndIf
StopDrawing ()
Return

Procedure.l Fin()
   
 If IsImage( #sortie):FreeImage(#sortie):EndIf
 End
EndProcedure 

Code : Tout sélectionner

;      DecompressedLength = UnpackMemory(*Target, *Source) ; heu, je ne sais plus où je vais là, ni même d'où je viens... 

Code : Tout sélectionner

CatchImage(#sortie, *Target)

Code : Tout sélectionner

; le champ de bataille:

OpenPack("test.pak");NomFichier$)
  *Source = AllocateMemory(FileLength) ;<- ligne 32
  *Target = AllocateMemory(FileLength+8)
  If FileLength And *Source And *Target
    ReadData(0, *Source, FileLength) ; Read the whole file in the memory buffer
   
    DecompressedLength = UnpackMemory(*Source, *Target) 
  
    CatchImage(#sortie, *Target)
  EndIf