PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

[4 bit - 8 bit] Multi Color Transparent PNG (Windows)

https://www.purebasic.fr/english/viewtopic.php?t=60446

Page 1 of 1

[4 bit - 8 bit] Multi Color Transparent PNG (Windows)

Posted: Fri Sep 05, 2014 3:55 pm
by RASHAD
Hi all
- 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
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited