PicPak Packager
Posted: Thu Sep 04, 2008 11:37 am
Here is my addition to netmaestro's excellent PicPak code for formatting images for DataSections.
One of the advantages is that I store the packed/unpacked sizes and a compression flag in a header so the image can be extracted at runtime without any hard-coded lengths or ?End-?Start.
Use PickPak Packager in your projects and all you need to include is GetImageResource to read the data back.
One of the advantages is that I store the packed/unpacked sizes and a compression flag in a header so the image can be extracted at runtime without any hard-coded lengths or ?End-?Start.
Use PickPak Packager in your projects and all you need to include is GetImageResource to read the data back.
Code: Select all
Structure LoadResource
Filename.s
Progress.l
Cancel.l
EndStructure
Enumeration
#Main_Window
#Progress_Bar
#Cancel_Button
#Preview_Button
#Open_Button
#Image_Gadget
#Image
#Menu
EndEnumeration
Declare LoadImageResource(*LR.LoadResource)
Declare ClosePreview()
Declare ResizePreview()
Declare OpenNewImage(*LR.LoadResource)
Declare MakeImageResource(File.s, *Progress.LONG, *Cancel.LONG)
Declare GetImageResource(ImageID, *Memory)
Declare TextProgressBarCallback(hWnd, Msg, wParam, lParam)
Declare CreateTextProgressBarGadget(GadgetID, x, y, Width, Height, Minimum, Maximum, FirstTextColor=#PB_Ignore, SecondTextColor=#PB_Ignore, BarColor=#PB_Ignore, BackColor=#PB_Ignore)
Usage.s=Chr(10)
Usage.s+"Each byte is read into PicPak to be converted into a formatted hexedecimal datasection"+Chr(10)+Chr(10)
Usage.s+"When the progress bar is complete the data is copied to the clipboard. Simply paste it"+Chr(10)
Usage.s+"into your IDE, change the label is necessary, and you're good to go."+Chr(10)
About.s=Chr(10)
About.s+"Written in PureBasic by Matthew "+Chr(34)+"Mistrel"+Chr(34)+" D'Onofrio, September 2008"+Chr(10)
About.s+"Adapted from original code by netmaestro and gnozal"+Chr(10)+Chr(10)
About.s+"This code is 100% free to use, distribute, or reverse-engineer"+Chr(10)
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
Define LR.LoadResource
Define DefaultWindowHeight=74
; Allow an image to be passed as a parameter
If CountProgramParameters()
LR\Filename=ProgramParameter(0)
EndIf
ThreadID=OpenNewImage(@LR.LoadResource)
Repeat
If IsWindow(#Main_Window)
Event=WaitWindowEvent(1)
Else
Delay(1)
EndIf
If (IsGadget(#Progress_Bar) And Not GetGadgetState(#Progress_Bar)=100)
SetGadgetState(#Progress_Bar, LR\Progress)
EndIf
Select Event
Case #PB_Event_Menu
Select EventMenu()
Case 0
MessageRequester("How to use PicPak",Usage.s,$C0)
Case 1
MessageRequester("About PicPak",About.s,$C0)
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #Cancel_Button
If GetGadgetText(#Cancel_Button)="Done"
End
Else
If IsThread(ThreadID)
LR\Cancel=1
Repeat: Delay(10)
WindowEvent() ; Don't lock the main window
Until Not IsThread(ThreadID)
LR\Progress=0
LR\Filename.s=""
LR\Cancel=0
EndIf
SetGadgetText(#Cancel_Button,"Done")
EndIf
Case #Preview_Button
If WindowHeight(#Main_Window)=DefaultWindowHeight+MenuHeight()
ResizePreview()
Else
ClosePreview()
EndIf
Case #Open_Button
If Not LR\Progress=100
LR\Cancel=1
Repeat: Delay(10)
WindowEvent() ; Don't lock the main window
Until Not IsThread(ThreadID)
LR\Cancel=0
EndIf
LR\Progress=0
LR\Filename.s=""
SetGadgetState(#Progress_Bar,0)
ThreadID=OpenNewImage(@LR.LoadResource)
Repeat: Delay(10)
; Add a timeout here
Until LR\Filename.s Or Not IsThread(ThreadID)
; Only resize the preview if a new file has been selected
If LR\Filename.s
If Not WindowHeight(#Main_Window)=DefaultWindowHeight+MenuHeight()
ResizePreview()
EndIf
EndIf
EndSelect
Case #WM_CLOSE
End
EndSelect
ForEver
Procedure LoadImageResource(*LR.LoadResource)
MakeImageResource(*LR\Filename.s, @*LR\Progress, @*LR\Cancel)
EndProcedure
Procedure ClosePreview()
ResizeWindow(#Main_Window,#PB_Ignore,#PB_Ignore,#PB_Ignore,MenuHeight()+74)
HideGadget(#Image_Gadget,1)
EndProcedure
Procedure ResizePreview()
ResizeWindow(#Main_Window,#PB_Ignore,#PB_Ignore,#PB_Ignore,MenuHeight()+74)
Width=WindowWidth(#Main_Window)-10
Height=WindowHeight(#Main_Window)+MenuHeight()-117+220
ImageWidth=ImageWidth(#Image)
ImageHeight=ImageHeight(#Image)
NewHeight=(Width*ImageHeight)/ImageWidth
NewWidth=Width
If NewHeight>Height
NewWidth=(Height*ImageWidth)/ImageHeight
NewHeight=Height
EndIf
If Not NewWidth>ImageWidth And Not NewHeight>ImageHeight
ResizeImage(#Image,NewWidth,NewHeight,#PB_Image_Smooth)
Else
NewWidth=ImageWidth
NewHeight=ImageHeight
EndIf
ResizeWindow(#Main_Window,#PB_Ignore,#PB_Ignore,#PB_Ignore,WindowHeight(#Main_Window)+NewHeight+5)
ResizeGadget(#Image_Gadget,5,WindowHeight(#Main_Window)-MenuHeight()-NewHeight-5,Width,Height)
SetGadgetState(#Image_Gadget,ImageID(#Image))
HideGadget(#Image_Gadget,0)
If NewWidth<WindowWidth(#Main_Window)
ResizeGadget(#Image_Gadget,(WindowWidth(#Main_Window)-NewWidth)/2,#PB_Ignore,#PB_Ignore,#PB_Ignore)
EndIf
HideGadget(#Image_Gadget,0)
EndProcedure
Procedure OpenNewImage(*LR.LoadResource)
Shared DefaultWindowHeight
If Not *LR\Filename.s
Filename.s=OpenFileRequester("Select File","","*.bmp,*.ico,*.jpeg,*.jpg,*.png,*.tga,*.tif,*.tiff|*.bmp;*.ico;*.jpeg;*.jpg;*.png,*.tga;*.tif;*.tiff",0)
If Not Filename.s And Not IsWindow(#Main_Window)
End
EndIf
Else
Filename.s=*LR\Filename.s
EndIf
Extension.s=LCase(GetExtensionPart(Filename.s))
Select Extension.s
Case "bmp","ico","jpeg","jpg","png","tga","tif","tiff"
*LR\Filename.s=Filename.s
If Not LoadImage(#Image,Filename.s)
MessageRequester("Error","Couldn't load the image")
End
EndIf
If Not IsWindow(#Main_Window)
OpenWindow(#Main_Window,0,0,250,74+MenuHeight(),"PicPak Packager",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
If CreateGadgetList(WindowID(#Main_Window))
CreateTextProgressBarGadget(#Progress_Bar,5,5,240,30,0,100)
ButtonGadget(#Cancel_Button,185,45,60,24,"Cancel")
ButtonGadget(#Preview_Button,119,45,60,24,"Preview")
ButtonGadget(#Open_Button,53,45,60,24,"Open")
ImageGadget(#Image_Gadget,5,WindowHeight(#Main_Window)-MenuHeight()-NewHeight-5,Width,Height,ImageID(#Image))
HideGadget(#Image_Gadget,1)
CreateMenu(#Menu,WindowID(#Main_Window))
MenuTitle("Help")
MenuItem(0,"Usage")
MenuItem(1,"About")
EndIf
Else
DisableGadget(#Preview_Button,0)
SetGadgetText(#Cancel_Button,"Cancel")
EndIf
ThreadID=CreateThread(@LoadImageResource(),*LR)
Default
If Filename.s
MessageRequester("Error","Unknown file type "+Chr(34)+Extension.s+Chr(34))
EndIf
EndSelect
ProcedureReturn ThreadID
EndProcedure
Procedure MakeImageResource(File.s, *Progress.LONG, *Cancel.LONG)
; If the file exists
FileSize=FileSize(File.s)
If Not FileSize>0
MessageRequester("Error","Not a file or size of 0")
End
EndIf
; And the file is accessable
Mem=AllocateMemory(FileSize)
FileID=ReadFile(#PB_Any,File.s)
If Not FileID
MessageRequester("Error","Couldn't open the file")
End
EndIf
ReadData(FileID,Mem,FileSize)
CloseFile(FileID)
CompressedMem=AllocateMemory(FileSize+8)
CompressedLength=PackMemory(Mem,CompressedMem,FileSize)
If CompressedLength
UnpackLength=UnpackMemory(CompressedMem,Mem)
If Not UnpackLength=FileSize
MessageRequester("Error","Failed to verify compression")
End
EndIf
FreeMemory(Mem)
Mem=AllocateMemory(CompressedLength)
CopyMemory(CompressedMem,Mem,CompressedLength)
FreeMemory(CompressedMem)
Compressed=1
EndIf
FilePart.s=GetFilePart(File.s)
For i=1 To Len(FilePart.s)
Char.s=Mid(FilePart.s,i,1)
Asc=Asc(Char.s)
; If character is not alphanumeric
If Asc<48 Or (Asc>57 And Asc<65) Or (Asc>90 And Asc<97) Or Asc>122
Char.s="_"
EndIf
Label.s+Char.s
Next i
MemSize=MemorySize(Mem)
HeaderSize=9 ; Byte+Long+Long
Output.s="DataSection"+#CRLF$
Output.s+Chr(9)+Label.s+": "+#CRLF$
Output.s+Chr(9)+"Data.b "
If Compressed
Output.s+"$01," ; Compressed
For i=0 To SizeOf(LONG)-1 ; Uncompressed length
Output.s+"$"+RSet(Hex(PeekC(@FileSize+i)),2,"0")+","
Next i
For i=0 To SizeOf(LONG)-1 ; Compressed length
Output.s+"$"+RSet(Hex(PeekC(@CompressedLength+i)),2,"0")+","
Next i
Else
Output.s+"$00," ; Uncompressed
For i=0 To SizeOf(LONG)-1 ; Uncompressed length
Output.s+"$"+RSet(Hex(PeekC(@FileSize+i)),2,"0")+","
Next i
Output.s+"$00,$00,$00,$00," ; Compressed length
EndIf
Size=MemSize/20
If (MemSize%20)
Size+1
EndIf
Dim OutputArray.s(Size)
n=0
For i=0 To MemSize-1
If i=MemSize-1
LastByte=1 ; True
Else
LastByte=0 ; False
EndIf
If (Not (i+1+HeaderSize)%20 And Not i=0) Or LastByte
OutputArray(n)+"$"+RSet(Hex(PeekC(Mem+i)),2,"0")+#CRLF$
n+1
Else
OutputArray(n)+"$"+RSet(Hex(PeekC(Mem+i)),2,"0")+","
EndIf
PercentComplete=((i+1.0)/(MemSize+Size))*100-1
If PercentComplete<0
PercentComplete=0
EndIf
*Progress\L=PercentComplete
If *Cancel\L
*Progress\L=0
ClosePreview()
DisableGadget(#Preview_Button,1)
ProcedureReturn 0
EndIf
Next
PreviousCompleted=*Progress\L
FreeMemory(Mem)
Mem=AllocateMemory(Size*(20+Len(Chr(9)+"Data.b "+#CRLF$))*4+Len(Output.s+"EndDataSection"))
PokeS(Mem,Output.s)
For i=0 To PeekL(@OutputArray()-8)-1
If OutputArray(i)
If i=0
CopyMemory(@OutputArray(i),Mem+(Len(PeekS(Mem))),Len(OutputArray(i)))
Else
OutputArray(i)=Chr(9)+"Data.b "+OutputArray(i)
CopyMemory(@OutputArray(i),Mem+(Len(PeekS(Mem))),Len(OutputArray(i)))
EndIf
EndIf
PercentComplete=(((i-2)+1.0)/(MemSize+Size))*100-1
If PercentComplete<0
PercentComplete=0
EndIf
*Progress\L=PercentComplete+PreviousCompleted
If *Cancel\L
*Progress\L=0
ClosePreview()
DisableGadget(#Preview_Button,1)
ProcedureReturn 0
EndIf
Next i
PokeS(Mem+(Len(PeekS(Mem))),"EndDataSection")
SetClipboardText(PeekS(Mem))
FreeMemory(Mem)
*Progress\L=100
SetGadgetText(#Cancel_Button,"Done")
EndProcedure
Procedure GetImageResource(ImageID, *Memory)
Protected Byte,Long
Byte=SizeOf(BYTE)
Long=SizeOf(LONG)
HeaderSize=Byte+Long+Long
If Not *Memory
ProcedureReturn 0
EndIf
If ImageID=#PB_Any
i=1
While IsImage(i)
i+1
Wend: Delay(1)
ImageID=i
EndIf
; Read header
Compressed=PeekB(*Memory)
UnpackLength=PeekL(*Memory+Byte)
PackedLength=PeekL(*Memory+Byte+Long)
If Compressed ; If the resource is compressed
Unpacked=AllocateMemory(UnpackLength)
RepackageMemory=AllocateMemory(PackedLength)
CopyMemory(*Memory+HeaderSize,RepackageMemory,PackedLength)
UnpackMemory(RepackageMemory,Unpacked)
If Not CatchImage(ImageID,Unpacked,UnpackLength)
FreeImageID=0
EndIf
FreeMemory(Unpacked)
FreeMemory(RepackageMemory)
Else
If Not CatchImage(ImageID,*Memory+HeaderSize,UnpackLength)
FreeImageID=0
EndIf
EndIf
ProcedureReturn ImageID
EndProcedure
Procedure TextProgressBarCallback(hWnd, Msg, wParam, lParam)
Protected OldProc,ImgID,ImgID2,hdcOut,hdcIn,ps.PAINTSTRUCT,GadgetID
Protected Text.s,BarColor,Progression.d,BackColor,ProgWidth.d,TextColor2
OldProc=GetProp_(hWnd,"OldProc")
TextColor=GetProp_(hWnd,"TextColor")
TextColor2=GetProp_(hWnd,"TextColor2")
BackColor=GetProp_(hWnd,"BackColor")
BarColor=GetProp_(hWnd,"BarColor")
Select Msg
Case #WM_PAINT
GadgetID=GetDlgCtrlID_(hWnd)
Progression=(GetGadgetState(GadgetID)-GetGadgetAttribute(GadgetID,#PB_ProgressBar_Minimum))/(GetGadgetAttribute(GadgetID,#PB_ProgressBar_Maximum)-GetGadgetAttribute(GadgetID,#PB_ProgressBar_Minimum))
ProgWidth=GadgetWidth(GadgetID)* Progression
Text=StrD(Progression*100,0)+"%"
BeginPaint_(hWnd,@ps)
hdcOut=ps\hdc
ImgID2=CreateImage(#PB_Any,GadgetWidth(GadgetID),GadgetHeight(GadgetID),#PB_Image_DisplayFormat)
StartDrawing(ImageOutput(ImgID2))
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
Box(0,0,GadgetWidth(GadgetID),GadgetHeight(GadgetID),BarColor)
FrontColor(TextColor)
DrawText(GadgetWidth(GadgetID)/2-0.5*TextWidth(Text),GadgetHeight(GadgetID)/2-0.5*TextHeight(Text),Text)
StopDrawing()
ImgID=CreateImage(#PB_Any,GadgetWidth(GadgetID),GadgetHeight(GadgetID),#PB_Image_DisplayFormat)
hdcIn=StartDrawing(ImageOutput(ImgID))
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
Box(0,0,GadgetWidth(GadgetID),GadgetHeight(GadgetID),BackColor)
FrontColor(TextColor2)
DrawText(GadgetWidth(GadgetID)/2-0.5*TextWidth(Text),GadgetHeight(GadgetID)/2-0.5*TextHeight(Text),Text)
ImgTmpID=GrabImage(ImgID2 ,#PB_Any,0,0,ProgWidth,GadgetHeight(GadgetID))
DrawImage(ImageID(ImgTmpID),0,0)
BitBlt_(hdcOut,0,0,GadgetWidth(GadgetID),GadgetHeight(GadgetID),hdcIn,0,0,#SRCCOPY)
StopDrawing()
EndPaint_(hWnd,ps)
FreeImage(ImgID)
FreeImage(ImgID2)
FreeImage(ImgTmpID)
ProcedureReturn 0
Case #WM_NCDESTROY
RemoveProp_(hWnd,"OldProc")
RemoveProp_(hWnd,"TextColor")
RemoveProp_(hWnd,"TextColor2")
RemoveProp_(hWnd,"BackColor")
RemoveProp_(hWnd,"BarColor")
EndSelect
ProcedureReturn CallWindowProc_(OldProc, hWnd, Msg, wParam, lParam)
EndProcedure
Procedure CreateTextProgressBarGadget(GadgetID, x, y, Width, Height, Minimum, Maximum, FirstTextColor=#PB_Ignore, SecondTextColor=#PB_Ignore, BarColor=#PB_Ignore, BackColor=#PB_Ignore)
Protected ImgID,ImgID2
If GadgetID=#PB_Any
i=1
While IsGadget(i)
i+1
Wend: Delay(1)
GadgetID=i
EndIf
If FirstTextColor=#PB_Ignore
FirstTextColor=GetSysColor_(#COLOR_WINDOWTEXT)
EndIf
If SecondTextColor=#PB_Ignore
SecondTextColor=GetSysColor_(#COLOR_HIGHLIGHTTEXT)
EndIf
If BackColor=#PB_Ignore
BackColor=GetSysColor_(#COLOR_BTNFACE)
EndIf
If BarColor=#PB_Ignore
BarColor=GetSysColor_(#COLOR_HIGHLIGHT)
EndIf
ProgressBarGadget(GadgetID,X,Y,width,Height,Minimum,Maximum)
SetProp_(GadgetID(GadgetID),"BackColor",BackColor)
SetProp_(GadgetID(GadgetID),"BarColor",BarColor)
SetProp_(GadgetID(GadgetID),"TextColor",SecondTextColor)
SetProp_(GadgetID(GadgetID),"TextColor2",FirstTextColor)
SetProp_(GadgetID(GadgetID),"OldProc",SetWindowLong_(GadgetID(GadgetID),#GWL_WNDPROC,@TextProgressBarCallback()))
ProcedureReturn GadgetID
EndProcedure
