Re: Picpak
Posted: Mon Feb 11, 2013 1:43 am
Great I'll see what I can do.
The IDE complained about the #MB_ICONERROR. I also added the color constants (not on the Mac). I've just commented out the drag/drop so there may be some surprises yet otherwise it is running. The Requester file patterns don't work on the Mac either (no big deal).
This version runs on my Mac.
Code: Select all
MessageRequester("Problem","File must be: BMP, JPG, PNG or TIF",#MB_ICONERROR)This version runs on my Mac.
Code: Select all
;**************************************************************
; Program: PicPak
; Author: netmaestro
; Date: April 15, 2006
; Updated: February 9, 2013
; Target OS: Microsoft Windows All
; Target Compiler: PureBasic 5.10 and later
; License: Free, unrestricted, credit appreciated
; but not required
;**************************************************************
; *** Mac version ***
UseZipPacker()
#Red=$0000FF
#White=$FFFFFF
Global clip$
line$=Chr(10)
line$+ "Written in PureBasic by netmaestro, April 2006"+Chr(10)+Chr(10)
line$+ "Updated February 2013 to generate quads with PB 5.10 Line continuations"+Chr(10)+Chr(10)
line$+ "100% free to use, distribute, reverse-engineer,"+Chr(10)
line$+ "repackage and say you wrote it, anything you want"+Chr(10)
line$+ "to do with it is A-OK with me"+Chr(10)
use$=""+Chr(10)
use$ + Space(3) + "1. Drop an image file on the window"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "2. Select a label name"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "3. Paste generated code into your source"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "4. The #image img0 will be ready to use!"+Chr(13)+Chr(10)+Chr(10)
Procedure CreateDataSection(picin.s)
Pattern$ = "BMP (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif"
If picin = ""
picin.s = OpenFileRequester("Choose an image file", "", pattern$, 0)
EndIf
ext.s = GetExtensionPart(picin)
If ReadFile(0,picin)
FileLength = Lof(0)
*original = AllocateMemory(FileLength)
*compressed = AllocateMemory(FileLength)
If FileLength And *original And *compressed
ReadData(0, *original, FileLength)
CompressedLength = CompressMemory(*original, MemorySize(*original), *compressed, FileLength)
If CompressedLength>0 And CompressedLength<FileLength
*compressed = ReAllocateMemory(*compressed, CompressedLength)
DecompressedLength = UncompressMemory(*compressed, MemorySize(*compressed), *original, MemorySize(*original))
If DecompressedLength = FileLength
StickyWindow(0,#False)
MessageRequester("Info", "Compression succeeded:"+Chr(10)+Chr(10)+"Old size: "+Str(FileLength)+Chr(10)+"New size: "+Str(CompressedLength))
StickyWindow(0,#True)
FreeMemory(*original)
*original = AllocateMemory(compressedLength)
CopyMemory(*compressed,*original,compressedlength)
EndIf
Else
compressedlength=filelength
StickyWindow(0,#False)
MessageRequester("Info", "Compression not needed")
StickyWindow(0,#True)
EndIf
StickyWindow(0,#False)
label.s = InputRequester("Label Input","Enter a label For the DataSection: ","PicPak:")
If Trim(label)=""
label="picpak"
EndIf
label=" "+label
StickyWindow(0,#True)
label=RemoveString(label,":")
endlabel.s = label+"end:"
label+":"
clip$=Chr(10)
Select ext
Case "jpg"
clip$+"UseJPEGImageDecoder()"+Chr(10)
Case "png"
clip$+"UsePNGImageDecoder()"+Chr(10)
Case "tif"
clip$+"UseTIFFImageDecoder()"+Chr(10)
EndSelect
If compressedlength<>filelength
clip$+"UseZipPacker()"+Chr(10)
clip$+"*unpacked = AllocateMemory("+Str(Filelength)+")"+Chr(10)
clip$+"Uncompressmemory(?"+Trim(RemoveString(label,":"))+", "+CompressedLength+", *unpacked, "+FileLength+")"+Chr(10)
clip$+"img0 = CatchImage(#PB_Any, *unpacked, "+Str(Filelength)+")"+Chr(10)
Else
clip$+"img0 = CatchImage(#PB_Any, ?" + Trim(RemoveString(label,":")) + ", "+Str(Filelength)+")"+Chr(10)
EndIf
clip$+Chr(10)
clip$ + "Datasection" + Chr(10)
clip$ + label + Chr(10)
clip$ + " Data.q "
quads = CompressedLength/8
bytes = compressedlength%8
For i = 0 To quads-1
clip$ + "$"+RSet(Hex(PeekQ(*original+(i*8)),#PB_Quad),16,"0")+","
If (i+1)%6=0
If i<>quads-1
clip$ + Chr(10)+Space(9)
EndIf
EndIf
Next
clip$=Left(clip$, Len(clip$)-1)+Chr(10)
If bytes
*bytestart = *original+(quads*8)
clip$ + Space(2) + "Data.b "
For i=0 To bytes-1
clip$ + "$"+RSet(Hex(PeekA(*bytestart+i),#PB_Ascii),2,"0")+","
Next
clip$=Left(clip$, Len(clip$)-1)+Chr(10)
EndIf
clip$ + endlabel + Chr(10)
clip$ + "EndDatasection" + Chr(10)
SetClipboardText(clip$)
FreeMemory(*original)
FreeMemory(*compressed)
CloseFile(0)
MessageRequester("Success!","Datasection is on the clipboard")
EndIf
Else
MessageRequester("Problem","Could not open input file")
EndIf
EndProcedure
CreateImage(0, 512,512,32)
StartDrawing(ImageOutput(0))
Box(0,0,512,512,#White)
Circle(256,256,256,#Red)
Circle(256,256,200,#White)
Circle(256,256,145,#Red)
Circle(256,256,80,#White)
Circle(256,256,40,#Red)
StopDrawing()
ResizeImage(0,120,120)
OpenWindow(0,0,0,150,170,"PicPak",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ImageGadget(0,15,15,0,0,ImageID(0))
DisableGadget(0,1)
StickyWindow(0,#True)
If CreateMenu(0, WindowID(0))
MenuTitle("Menu")
MenuItem( 1, "Usage")
MenuItem( 2, "About...")
MenuBar()
MenuItem(3,"Load pict")
EndIf
source.s=OpenFileRequester("Choose an image file", "", "BMP (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif",0)
If Len(source) : CreateDataSection(source) : EndIf
Repeat
ev=WaitWindowEvent()
Select ev
Case #PB_Event_Menu
Select EventMenu()
Case 1
StickyWindow(0,#False)
MessageRequester("How to use PicPak",use$,$C0)
StickyWindow(0,#True)
Case 2
StickyWindow(0,#False)
MessageRequester("About PicPak",line$, $C0)
StickyWindow(0,#True)
Case 3 ; load
source.s=OpenFileRequester("Load picture...","Test.jpg","BMP (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif",0)
If Len(source) : CreateDataSection(source) : EndIf
EndSelect
EndSelect
Until ev=#PB_Event_CloseWindow