- Choose your bit depth
- Load your bitmap image
- Open the Palette Table
- Select the transparent Colors
- Save the image
Have fun
Code: Select all
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
Global Result2,*Buffer,*NewBuffer,Newdepth,FileName$,SName$,Dim palette(0),Dim data8(0),Dim data4(0)
Procedure WindowProc(hWnd,uMsg,wParam,lParam)
Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_NCACTIVATE
Result = 1
EndSelect
ProcedureReturn Result
EndProcedure
Procedure SavePNG(Input$,Output$,depth)
If depth <> 4 And depth <> 8
End
EndIf
; If GetExtensionPart(SName$) <> LCase("png")
; Output$ = GetPathPart(Output$) + GetFilePart(Output$,#PB_FileSystem_NoExtension) + ".png"
; EndIf
If FileSize(SName$) > 0
del = MessageRequester("Error","File Exist,Delete?",#PB_MessageRequester_YesNo|#MB_ICONERROR)
If del = #PB_MessageRequester_Yes
DeleteFile(SName$,#PB_FileSystem_Force)
Else
End
EndIf
EndIf
LoadImage(0,Input$)
*Buffer = EncodeImage(0,#PB_ImagePlugin_PNG,0,depth)
result = MemorySize(*Buffer )
If depth = 8
Dim palette(255)
pos = *Buffer+41
For i = 0 To 255
palette(i) = RGB(PeekA(pos),PeekA(pos+1),PeekA(pos+2))
pos + 3
Next
Result2 = result +268
ElseIf depth = 4
Dim palette(15)
pos = *Buffer+41
For i = 0 To 15
palette(i) = RGB(PeekA(pos),PeekA(pos+1),PeekA(pos+2))
pos + 3
Next
Result2 = result +41
EndIf
*NewBuffer = AllocateMemory(Result2)
NewDepth = depth
EndProcedure
OpenWindow(0,0,0,320,500,"8bit PNG",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
SetWindowCallback(@WindowProc())
WindowBounds(0,250,250,#PB_Ignore,#PB_Ignore)
SetWindowColor(0,#Gray)
ImageGadget(300,10,10,300,380,0,#PB_Image_Raised)
ContainerGadget(310,10,445,330,52)
OptionGadget(315, 0,0,80,20,"8 bit Depth")
OptionGadget(320, 0,22,80,20,"4 bit Depth")
ButtonGadget(330,85,20,65,22,"Load")
ButtonGadget(340,155,20,65,22,"Pick TrColor")
ButtonGadget(360,225,20,65,22,"Save")
CloseGadgetList()
SetGadgetState(315,1)
SetGadgetColor(310,#PB_Gadget_BackColor,#Gray)
hdc = GetDC_(0)
While WindowEvent() : Wend
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #WM_MOUSEMOVE
If IsWindow(1)
GetCursorPos_(p.POINT)
Color = GetPixel_(hdc,p\x,p\y)
ScreenToClient_ (WindowID(1), @p)
Gad = GetDlgCtrlID_(ChildWindowFromPoint_ (WindowID(1), p\y<< 32+p\x))
If Gad >=0 And Gad <= 255
SetGadgetText(400," Index : " + Str(Gad) + " Red : " + Str(Red(color)) + " Green : " + Str(Green(color)) + " Blue : " + Str(Blue(color)))
EndIf
EndIf
Case #WM_LBUTTONDOWN
If IsWindow(1) And GetActiveGadget() < 260
GetCursorPos_(p.POINT)
ScreenToClient_ (WindowID(1), @p)
Gad = GetDlgCtrlID_(ChildWindowFromPoint_ (WindowID(1), p\y<< 32+p\x))
If GetGadgetColor(Gad,#PB_Gadget_BackColor) < $7C7C7C
SetGadgetColor(Gad,#PB_Gadget_FrontColor,#White)
Else
SetGadgetColor(Gad,#PB_Gadget_FrontColor,#Black)
EndIf
SetGadgetText(Gad,"S")
If NewDepth = 8
PokeA(*NewBuffer+821+gad,0)
ElseIf NewDepth = 4
PokeA(*NewBuffer+101+gad,0)
EndIf
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case 330
FileName$ = OpenFileRequester("SELECT IMAGE","","All supported formats|*.bmp; *.png; *.tif; *.tiff;| TIF image (*.tif)| *.tif| TIFF image (*.tiff)| *.tiff| PNG image (*.png)| *.png| BMP image (*.bmp)| *.bmp",0)
If GetGadgetState(315) = 1
Depth = 8
Else
Depth = 4
EndIf
If FileName$ <> ""
Path$ = GetHomeDirectory()
Name$ = GetFilePart(FileName$ ,#PB_FileSystem_NoExtension) +"_"+Str(Depth)+"bit"
SName$ = Path$ + Name$ +".png"
Else
End
EndIf
SavePNG(FileName$,SName$,Depth)
If NewDepth = 8
Dim data8(267)
Restore data_8bit
For i = 0 To 267
Read.a a
Data8(i) = a
Next
For i = 0 To 812
PokeA(*NewBuffer+i,PeekA(*Buffer+i))
Next
For i = 813 To 1080
PokeA(*NewBuffer+i,data8(i-813))
Next
For i = 1081 To Result2
PokeA(*NewBuffer+i,PeekA(*Buffer+i - 268))
Next
FreeMemory(*Buffer)
ElseIf NewDepth = 4
Dim data4(27)
Restore data_4bit
For i = 0 To 27
Read.a b
Data4(i) = b
Next
For i = 0 To 92
PokeA(*NewBuffer+i,PeekA(*Buffer+i))
Next
For i = 93 To 120
PokeA(*NewBuffer+i,data4(i-93))
Next
For i = 121 To Result2
PokeA(*NewBuffer+i,PeekA(*Buffer+i - 28))
Next
EndIf
LoadImage(0,FileName$)
ResizeWindow(0,#PB_Ignore,#PB_Ignore,ImageWidth(0)+20, ImageHeight(0)+80)
ResizeGadget(300,#PB_Ignore,#PB_Ignore,ImageWidth(0), ImageHeight(0)+40)
ResizeGadget(310,#PB_Ignore,ImageHeight(0)+20,ImageWidth(0), #PB_Ignore)
SetGadgetState(300,ImageID(0))
;
Case 340
OpenWindow(1,WindowX(0,#PB_Window_FrameCoordinate)+ WindowWidth(0)+20,WindowY(0,#PB_Window_FrameCoordinate),370, 400,"", #PB_Window_Invisible|#PB_Window_BorderLess)
TextGadget(400,10,370,300,22,"")
If NewDepth = 8
x = 10:y=10
For i = 0 To 255 Step 16
For k = i To i+15
TextGadget(k,x,y,20,20,"",#SS_NOTIFY|#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER):x+22
SetGadgetColor(k,#PB_Gadget_BackColor,palette(k))
Next
x = 10
y + 22
Next
ElseIf NewDepth = 4
x = 10:y=10
For i = 0 To 15
TextGadget(i,x,y,20,350,"",#SS_NOTIFY|#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER):x+22
SetGadgetColor(i,#PB_Gadget_BackColor, palette(i))
Next
EndIf
HideWindow(1,0)
Case 360
OpenFile(0, SName$ )
WriteData(0, *NewBuffer , result2)
CloseFile(0)
MessageRequester("Info","New Image saved successfully...",#PB_MessageRequester_Ok|#MB_ICONINFORMATION)
EndSelect
EndSelect
Until Quit = 1
End
DataSection
data_8bit:
Data.a $00, $00, $01, $00, $74, $52, $4E, $53, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF ;iNDEX 0 = data8(8) 256 Palette
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $8E, $EE, $A4, $0B
data_4bit:
Data.a $00, $00, $00, $10, $74, $52, $4E, $53, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF ;iNDEX 0 = data4(9) 16 Palette
Data.a $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $D9, $FE, $55, $FB
EndDataSection