- No need for FreeImage.lib for the EXE after compilation
- Tested with PB v5.30 x86 Windows 8.1 x64
- Saved file will be in your Home dir
- Use ScrollBar & Preview to trim for best value before saving
Code: Select all
UsePNGImageDecoder()
Global Img,dib,dib2,TransColor,Color
Global Dim Transparency.l(255)
Enumeration -1
#FIF_UNKNOWN
#FIF_BMP
#FIF_ICO
#FIF_JPEG
#FIF_JNG
#FIF_KOALA
#FIF_LBM
#FIF_MNG
#FIF_PBM
#FIF_PBMRAW
#FIF_PCD
#FIF_PCX
#FIF_PGM
#FIF_PGMRAW
#FIF_PNG
#FIF_PPM
#FIF_PPMRAW
#FIF_RAS
#FIF_TARGA
#FIF_TIFF
#FIF_WBMP
#FIF_PSD
#FIF_CUT
#FIF_XBM
#FIF_XPM
#FIF_DDS
#FIF_GIF
#FIF_HDR
#FIF_FAXG
#FIF_SGI
#FIF_EXR
#FIF_J2K
#FIF_JP2
EndEnumeration
Enumeration 0
#FIQ_WUQUANT
#FIQ_NNQUANT
EndEnumeration
Import "FreeImage.lib"
CompilerIf #PB_Compiler_Unicode = #False
FreeImage_Load(fif.l,filename.p-ascii,flags.l=0) As "_FreeImage_Load@12"
CompilerElse
FreeImage_Load(fif.l,filename.p-unicode,flags.l=0) As "_FreeImage_LoadU@12"
CompilerEndIf
CompilerIf #PB_Compiler_Unicode = #False
FreeImage_GetFIFFromFilename(filename.p-ascii) As "_FreeImage_GetFIFFromFilename@4"
CompilerElse
FreeImage_GetFIFFromFilename(filename.p-ascii) As "_FreeImage_GetFIFFromFilenameU@4"
CompilerEndIf
FreeImage_GetWidth(dib.l) As "_FreeImage_GetWidth@4"
FreeImage_GetHeight(dib.l) As "_FreeImage_GetHeight@4"
FreeImage_GetBPP(dib.l) As "_FreeImage_GetBPP@4"
FreeImage_GetInfo(dib.l) As "_FreeImage_GetInfo@4"
FreeImage_GetBits(dib.l) As "_FreeImage_GetBits@4"
FreeImage_IsTransparent(dib.l) As "_FreeImage_IsTransparent@4"
FreeImage_ConvertTo24Bits(dib.l) As "_FreeImage_ConvertTo24Bits@4"
FreeImage_ColorQuantize(dib.l,quantize.l) As "_FreeImage_ColorQuantize@8"
FreeImage_GetPalette(dib.l) As "_FreeImage_GetPalette@4"
FreeImage_SetTransparencyTable(dib.l,table.l,count.l) As "_FreeImage_SetTransparencyTable@12"
FreeImage_GetTransparencyCount(dib.l) As "_FreeImage_GetTransparencyCount@4"
FreeImage_SetTransparent(dib.l,enabled.l) As "_FreeImage_SetTransparent@8"
FreeImage_SetTransparentIndex(dib.l, index.l) As "_FreeImage_SetTransparentIndex@8"
FreeImage_GetTransparentIndex(dib.l) As "_FreeImage_GetTransparentIndex@4"
FreeImage_Save(fif.l,dib.l,filename.p-ascii,flags.l=0) As "_FreeImage_Save@16"
FreeImage_Unload(dib.l) As "_FreeImage_Unload@4"
EndImport
Procedure PB_Image(dib)
Img = CreateImage(#PB_Any,FreeImage_GetWidth(dib),FreeImage_GetHeight(dib))
hdc = StartDrawing(ImageOutput(Img))
StretchDIBits_(hDC, 0, 0, FreeImage_GetWidth(dib), FreeImage_GetHeight(dib), 0, 0, FreeImage_GetWidth(dib), FreeImage_GetHeight(dib), FreeImage_GetBits(dib), FreeImage_GetInfo(dib), #DIB_RGB_COLORS, #SRCCOPY)
StopDrawing()
ReleaseDC_(#Null, hdc)
ProcedureReturn Img
EndProcedure
OpenWindow(0,0,0,320,500,"8bit PNG",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
WindowBounds(0,250,250,#PB_Ignore,#PB_Ignore)
SetWindowColor(0,#Gray)
ImageGadget(1,10,10,300,380,0,#PB_Image_Raised)
ContainerGadget(2,10,445,330,52)
ScrollBarGadget(3,0,0,300,16,0,250,1)
SetGadgetState(3,1)
ButtonGadget(4,0,25,65,22,"Load Image")
ButtonGadget(5,70,25,65,22,"Pick TrColor")
ButtonGadget(6,140,25,65,22,"Preview")
ButtonGadget(7,210,25,65,22,"Save Image")
TextGadget(8,278,24,23,24,"",#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER)
SetGadgetText(8,"1")
CloseGadgetList()
SetGadgetColor(2,#PB_Gadget_BackColor,#Gray)
DisableGadget(3,1)
DisableGadget(5,1)
While WindowEvent() : Wend
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #WM_MOUSEMOVE
GetCursorPos_(p.POINT)
hdc = GetDC_(0)
Color = GetPixel_(hdc,p\x,p\y)
ReleaseDC_(WindowID(0),hdc)
Case #WM_LBUTTONDOWN
If TransFlag = 1
TransColor = Color
TransFlag = 0
SystemParametersInfo_(#SPI_SETCURSORS,0,0,0)
DisableGadget(5,1)
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 3
Constant = GetGadgetState(3)
SetGadgetText(8,Str(GetGadgetState(3)))
Case 4
DisableGadget(5,0)
If dib > 0
FreeImage_Unload(dib) : dib = 0
FreeImage_Unload(dib2) : dib2 = 0
SetGadgetState(3,1)
SetGadgetText(8,"1")
DisableGadget(5,0)
FileName$ = ""
TransFlag = 0
SetGadgetAttribute(1,#PB_Button_Image, 0)
EndIf
FileName$ = OpenFileRequester("SELECT IMAGE","","All supported formats|*.bmp; *.ico; *.gif; *.jpg; *.jpeg; *.png; *.tif; *.tiff; *.tga| TGA image (*.tga)| *.tga|TIF image (*.tif)| *.tif| TIFF image (*.tiff) | *.tiff| PNG image (*.png)| *.png| BMP image (*.bmp)| *.bmp| Icon file (*.ico)| *.ico| JPEG image (*.jpg;*.jpeg)| *.jpg; *.jpeg| GIF image (*.gif)|*.gif",0)
If FileName$ <> ""
Path$ = GetHomeDirectory()
Name$ = GetFilePart(FileName$ ,#PB_FileSystem_NoExtension) +"_8bit"
SName$ = Path$ + Name$ +".png"
dib = FreeImage_Load(FreeImage_GetFIFFromFilename(FileName$) ,FileName$, 0)
If FreeImage_IsTransparent(dib) = 1
FreeImage_Unload(dib) : dib = 0
LoadImage(0,FileName$ )
CreateImage(1,ImageWidth(0),ImageHeight(0),24)
StartDrawing(ImageOutput(1))
Box(0,0,ImageWidth(0),ImageHeight(0),#White)
DrawAlphaImage(ImageID(0),0,0,255)
StopDrawing()
out$ = GetHomeDirectory() + "temp.bmp"
SaveImage(1,out$,#PB_ImagePlugin_BMP)
dib = FreeImage_Load(FreeImage_GetFIFFromFilename(out$ ) ,out$ , 0)
FreeImage(0)
FreeImage(1)
DeleteFile(out$)
EndIf
If FreeImage_GetBPP(dib) < 24
dib = FreeImage_ConvertTo24Bits(dib)
EndIf
PB_Image(dib)
ResizeWindow(0,#PB_Ignore ,#PB_Ignore ,ImageWidth(Img)+20,ImageHeight(Img)+100)
ResizeGadget(1,10,10 ,ImageWidth(Img),ImageHeight(Img))
ResizeGadget(2,10,ImageHeight(Img)+40 ,310,52)
SetGadgetState(1,ImageID(Img))
EndIf
Case 5
TransFlag = 1
SetSystemCursor_(LoadCursor_(0, #IDC_CROSS ), #OCR_NORMAL )
DisableGadget(3,0)
Case 6
If TransColor = #White
dib2 = FreeImage_ColorQuantize(dib,#FIQ_WUQUANT)
Else
dib2 = FreeImage_ColorQuantize(dib,#FIQ_NNQUANT)
EndIf
Palette = FreeImage_GetPalette(dib2)
For i = 0 To 255
Transparency(i) = 255
If PeekL(Palette+i) = TransColor
Transparency(i) = 0
EndIf
Next
FreeImage_SetTransparencyTable(dib2, Transparency(), GetGadgetState(3))
FreeImage_Save(#FIF_PNG,dib2,SName$,0)
LoadImage(0, SName$)
SetGadgetState(1,ImageID(0))
Case 7
MessageRequester("Info","New Image saved successfully...",#PB_MessageRequester_Ok|#MB_ICONINFORMATION)
EndSelect
EndSelect
Until Quit = 1
End
Edit :ver 2.0 Modified a little bit
Stuff Mr RASHAD.
