Save any image to a Transparent PNG [Windows]

[RASHAD]

New era then

Code: Select all

UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

Procedure TransPNG(File$,TransColor)
LoadImage(0,File$)

If TransColor <> #White
   StartDrawing(ImageOutput(0))
       For x = 0 To ImageWidth(0) - 1
          For y = 0 To ImageHeight(0) - 1
             If Point(x,y) = TransColor
                Plot(x,y,RGB(255, 255, 255))
             EndIf
          Next
       Next
   StopDrawing()
 EndIf 

i.ICONINFO
i\fIcon = #False
i\hbmMask = ImageID(0)
i\hbmColor = ImageID(0)

curHnd = CreateIconIndirect_(i)

CreateImage(10,ImageWidth(0),ImageHeight(0),32)
StartDrawing(ImageOutput(10))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawImage(curHnd,0,0,ImageWidth(0),ImageHeight(0))
StopDrawing()

FreeImage(0)
EndProcedure

TransPNG("e:\girlgreen.bmp",#Green)   ;The filename including path ,The required color to be transparent
SaveImage(10, "e:\girltrans.png",#PB_ImagePlugin_PNG)
   

[Bisonte]

But not so "Q'n'D" , you are the first ...

More like

Code: Select all

;:=============================================================================
;:- TransPNG()
;:- Author          : Rashad
;:- Date            : August 19, 2013
;:- Compiler        : PureBasic 5.20 beta 11 LTS
;:- Target OS       : Windows
;:- Source --------------------------------------------------------------------
;:- http://purebasic.fr/english/viewtopic.php?p=421780#p421780
;:=============================================================================

EnableExplicit

; Init ImagePlugins

UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

Procedure TransPNG(File.s, TransColor)
  
  Protected Image, curHnd, x, y
  Protected i.ICONINFO
  Protected SImage = #False
  
  Image = LoadImage(#PB_Any, File)
  
  If IsImage(Image)
    
    If TransColor <> #White
      If StartDrawing(ImageOutput(Image))
        For x = 0 To ImageWidth(Image) - 1
          For y = 0 To ImageHeight(Image) - 1
            If Point(x,y) = TransColor
              Plot(x,y,RGB(255, 255, 255))
            EndIf
          Next
        Next
        StopDrawing()
      EndIf  
    EndIf
  
    i\fIcon = #False
    i\hbmMask = ImageID(Image)
    i\hbmColor = ImageID(Image)

    curHnd = CreateIconIndirect_(i)
    
    SImage = CreateImage(#PB_Any, ImageWidth(Image), ImageHeight(Image), 32, #PB_Image_Transparent)
    
    If IsImage(SImage)
      If StartDrawing(ImageOutput(SImage))
        DrawingMode(#PB_2DDrawing_AllChannels)
        DrawImage(curHnd, 0, 0, ImageWidth(Image), ImageHeight(Image))
        StopDrawing()
      EndIf
      FreeImage(Image)  
    EndIf
  EndIf
  
  ProcedureReturn SImage
  
EndProcedure

;: Usage :
;:
;: Image = TransPNG(File, TransColor)
;:
;: Parameter :
;: File       = The filename including path
;: TransColor = Color To be transparent

Define Image, File.s, TColor, SFile.s

File    = #PB_Compiler_Home + "Examples\Sources\Data\Geebee2.bmp"
TColor  = RGB(255,0,255)
SFile   = "D:\GeeBeeTrans.png"

Image = TransPNG(File, TColor)

If IsImage(Image)
  SaveImage(Image, SFile, #PB_ImagePlugin_PNG)
EndIf

[fsw]

Hi Rashad,
could you please change the topic from

Save any image to a Transparent PNG [Windows]

to

[Windows] Save any image to a Transparent PNG

this way it's consistent with what Fred and Co. normally write.

Examples...

[Done] Limits of CanvasGadget
[Implemented] Rename Frame3DGadget() to FrameGadget()

Thank you.

[Fred]

No need to nitpick about topic subject format, there is no absolute enforcement on the forum, so it's not possible to force everyone to do it the same way. It never been a real problem anyway

[fsw]

...so it's not possible to force everyone

I was forcing no one.

The phrase

could you please change

is a simple request.
Following a request is voluntary

[Olliv]

Just a private request so!

Such a break prevent me to get the code of Rashad, quickly, wildly and secretly!!!

When I will have time, I rework my own codes. There are obsolete!!! Built-in now! Good new! Thanks Fred and Hervé also!