PureBasic Forums - English

Code: Select all

;'AlphaBmp2Png'.
;-----------------
;   srod + Netmaestro.
;   Created with Purebasic 4.1 for Windows.
;
;   Date:  August 2007.
;
;   Platforms:  Windows.
;               The gdi+ library needs to be installed which comes as standard with XP.
;               Earlier versions of Windows require the gdi+ redistributable.
;
;   Requirements : The Purebasic gdi+ wrappers found here :
;                       http://www.purebasic.fr/english/viewtopic.php?t=26459
;                  and the macro framework which is linked to in the above thread.
;
;   Licence: DAYLike
;     (Do As You Like with it! - No Warranties!)
;     A credit to myself, whilst nice, is not absolutely necessary.
;
;*******************************************************************************************
;
;NOTES.
;------
;The function AlphaBmp2Png() will take a 32-bit gdi bitmap (such as those created by 
;CreateImage() etc.) whose pixel data may or may not record alpha transparency and save
;it in the form of a png image file.
;Unlike PB's SaveImage() command, however, AlphaBmp2Png() will also save the alpha channel data.
;
;*******************************************************************************************


XIncludeFile "gdiplus_11.pbi" ;See the requirements listed above.

;Returns zero if an error, non-zero otherwise.
  Procedure.l AlphaBmp2Png(hBmp, filename$)
    Protected result, bmp.BITMAP, gdiplusimage, i, j
    Protected *px.LONG
    If LCase(GetExtensionPart(filename$)) = "png"
      If GetObject_(hBmp, SizeOf(BITMAP), bmp.BITMAP) And bmp\bmBitsPixel = 32
        ;Initialise gdi+.
          gdiToken = Gdiplus_New() 
        If gdiToken
          ;Let's create our gdi+ bitmap.
            If GdipCreateBitmapFromScan0(bmp\bmWidth, bmp\bmHeight, 0, #PixelFormat32bppARGB, 0, @gdiplusimage) = #Ok
              ;Scan each pixel of the original image and copy the colour and alpha settings.
                For i=0 To bmp\bmHeight-1 
                  For j=0 To bmp\bmWidthBytes-1 Step 4 
                    *px = bmp\bmBits + bmp\bmWidthBytes * i + j 
                    SetPixel(gdiplusimage, j/4, i, *px\l)
                  Next
                Next
              ;Save as png.
                If Gdiplus_ImageSaveToFile(gdiplusimage, filename$, #Png_Encoder) = #Ok
                  result=1
                EndIf
              ;Tidy up.
                GdipDisposeImage(gdiplusimage)
            EndIf
          Gdiplus_Del(gdiToken) 
        EndIf
      EndIf
    EndIf
    ProcedureReturn result
  EndProcedure

Code: Select all

;Save a copy of an existing png file and preserve transparency.

XIncludeFile "AlphaBmp2Png.pbi"

  UsePNGImageDecoder()
  LoadImage(1,"source.png")               ;Change to your own png file.
  AlphaBmp2Png(ImageID(1), "test.png")

Code: Select all

;Create a normal bitmap, add alpha transparency and save (with alpha channel intact)
;as a png file.

XIncludeFile "AlphaBmp2Png.pbi"

;Create a 32 bit bitmap.
  CreateImage(1, 300, 300, 32) 
;Add a blue box with a black border and a small black box in the center.
  hdc = StartDrawing(ImageOutput(1)) 
    Box(40,40,220,220,#Blue) 
    Box(130,130,40,40,0)
  StopDrawing()
;Add some alpha transparency. We set all black pixels to transparent.
  GetObject_(ImageID(1), SizeOf(BITMAP), bmp.BITMAP) 
  For i=0 To bmp\bmHeight-1 
    For j=0 To bmp\bmWidthBytes-1 Step 4 
      *px.LONG = bmp\bmBits + bmp\bmWidthBytes * i + j 
      If *px\l&$ffffff = 0 ;Black.
        *px\l=0 ;Transparent.
      Else
        ;Set the alpha to $ff (opaque) and leave the colour.
        *px\l=$ff000000 + *px\l&$ffffff
      EndIf 
    Next 
  Next 

  AlphaBmp2Png(ImageID(1), "test.png")

Code: Select all

ProcedureDLL SaveAlphaImage(image, path$)

  Structure GdiplusStartupInput 
    GdiPlusVersion.l 
    *DebugEventCallback.DEBUG_EVENT
    SuppressBackgroundThread.l 
    SuppressExternalCodecs.l 
  EndStructure 

  Protected Unicode$=Space(Len(path$)*2+2), path_as_bstr, lib, PixelFormat32bppARGB=$26200A
  Protected bmp.BITMAP,input.GdiplusStartupInput, *token, *gdip_image_object, result

  PokeS(@Unicode$, path$, -1, #PB_Unicode) 
  path_as_bstr = SysAllocString_(@Unicode$) 

  lib = OpenLibrary(#PB_Any, "gdiplus.dll") 
  If Not lib : ProcedureReturn #False : EndIf 
  
  input\GdiPlusVersion=1 : CallFunction(lib, "GdiplusStartup", @*token, @input, #Null) 

  If *token 
    GetObject_(ImageID(image), SizeOf(BITMAP), @bmp) 
    CallFunction(lib, "GdipCreateBitmapFromScan0", bmp\bmWidth, bmp\bmHeight, bmp\bmWidthBytes, PixelFormat32bppARGB, bmp\bmBits, @*gdip_image_object)
    
    DataSection 
      clsid_png: ; clsid for png image format 
      Data.l $557cf406 
      Data.w $1a04 
      Data.w $11d3 
      Data.b $9a,$73,$00,$00,$f8,$1e,$f3,$2e 
    EndDataSection 
    
    If CallFunction(lib, "GdipSaveImageToFile", *gdip_image_object, path_as_bstr, ?clsid_png, 0) = #S_OK 
      result = #True ; Success
    Else
      result = #False ; Save failed
    EndIf
  Else
    result = #False ; GDIPlus startup failed
  EndIf
  
  CloseLibrary(lib)
  
  ProcedureReturn result
  
EndProcedure

Code: Select all

ProcedureDLL SaveAlphaImage(image, path$)

  Structure GdiplusStartupInput
    GdiPlusVersion.l
    *DebugEventCallback.DEBUG_EVENT
    SuppressBackgroundThread.l
    SuppressExternalCodecs.l
  EndStructure

  Protected Unicode$=Space(Len(path$)*2+2), path_as_bstr, lib, PixelFormat32bppARGB=$26200A
  Protected bmp.BITMAP,input.GdiplusStartupInput, *token, *gdip_image_object, result

  PokeS(@Unicode$, path$, -1, #PB_Unicode)
  path_as_bstr = SysAllocString_(@Unicode$)

  lib = OpenLibrary(#PB_Any, "gdiplus.dll")
  If Not lib : ProcedureReturn #False : EndIf
 
  input\GdiPlusVersion=1 : CallFunction(lib, "GdiplusStartup", @*token, @input, #Null)

  If *token
    GetObject_(ImageID(image), SizeOf(BITMAP), @bmp)
    CallFunction(lib, "GdipCreateBitmapFromScan0", bmp\bmWidth, bmp\bmHeight, bmp\bmWidthBytes, PixelFormat32bppARGB, bmp\bmBits, @*gdip_image_object)
   
    DataSection
      clsid_png: ; clsid for png image format
      Data.l $557cf406
      Data.w $1a04
      Data.w $11d3
      Data.b $9a,$73,$00,$00,$f8,$1e,$f3,$2e
    EndDataSection
   
    If CallFunction(lib, "GdipSaveImageToFile", *gdip_image_object, path_as_bstr, ?clsid_png, 0) = #S_OK
      result = #True ; Success
    Else
      result = #False ; Save failed
    EndIf
  Else
    result = #False ; GDIPlus startup failed
  EndIf
 
  CloseLibrary(lib)
 
  ProcedureReturn result
 
EndProcedure

UsePNGImageDecoder()

InputFile$ = OpenFileRequester("Select a source image ...","","PNG (*.png)|*.png",0)

If InputFile$
   If LoadImage(0,InputFile$)

      ResizeImage(0,80,80)

      OutputFile$ = SaveFileRequester("Save Image as ...",GetPathPart(InputFile$),"PNG Image (*.png)|*.png",0)
            
      SaveAlphaImage(0,OutputFile$+".png")
      
   Else
      MessageRequester("Error","Invalid PNG file!",16) : End
   EndIf
Else
   End
EndIf