PureBoard

Code: Alles auswählen

EnableExplicit

Procedure CreateAlphaFromTRNSChunk(ImageNr,ImageFile.s,*ImageAdress=0)
	Protected *ImageMemPos, FileNum, ReceivedBytes, Transcol.l, *TransColP.RGBQUAD, ImageCopy.l, x, y

	; This Procedure creates the Alpha-Channel for a loaded PNG-Image where the Transpaent-Information
	; is stored in a tRNS-Chunk instead of in the sRGB-Information.
	;
	; Parameters:
	; ImageNR      -> Number of the PureBasic-Image (not the ImageID)
	; ImageFile.s  -> If the Image was loaded from a file, place the Filename here - otherwise leave this blank (= "")
	; *ImageAdress -> If you've catched the Image from Memory, put the Label-Adress in here and leave ImageFile.s blank (= "")
	;
	; How it works:
	; The Procedure checks the first 50 Bytes of the File or the Memory-Position to check out
	; - if it is a PGN File
	; - if it has got the tRNS Chunk
	;   - if not, it will return without any Changes
	; - it reads the transparent Color from the tRNS Chunk
	; - creats a copy of the original Image
	; - frees the old original Image and recreates a 32bit Alpha-Image with the same ImageNr.
	; - copies the old RGB-Information back to the new created 32-bit Image
	; - creates the Alpha-Channel from the Transparent Color which was read from the tRNS-Chunk
	; - cleans up Memory and frees Backup-Image
	;
	; ReturnValue:
	; It returns the ImageID of the new (or old, if not changed) Image
	; Because it does NOT CHANGE the ImageNr. used by PB, there is no need to check the Result if you use PBs ImageNr.
	; If you've used the ImageID (API-ImageID) of the Image before, you should use the ImageID which will be returned
	;
	; Examples of Usage:
	;
	; Using PBs ImageNumber and loading Image from File:
	; - MyImage = LoadImage(#PB_Any, "C:\Temp\SpeakerOn.png")
	; - Dummy = CreateAlphaFromTRNSChunk(MyImage,"C:\Temp\SpeakerOn.png")
	; 
	; Using API ImageIDs and catching the Image from Memory:
	; - ImageID = CatchImage(0, ?Image0)
	; - ImageID = CreateAlphaFromTRNSChunk(0,"",?Image0)

	If Len(ImageFile)
		*ImageMemPos = AllocateMemory(50)
		If Not *ImageMemPos : ProcedureReturn ImageID(ImageNr) : EndIf
		Filenum	= ReadFile(#PB_Any,ImageFile)
		If Not Filenum : FreeMemory(*ImageMemPos) : ProcedureReturn ImageID(ImageNr) : EndIf
		ReceivedBytes = ReadData(FileNum, *ImageMemPos, 50)
		CloseFile(FileNum)
		If ReceivedBytes < 49 : FreeMemory(*ImageMemPos) : ProcedureReturn ImageID(ImageNr) : EndIf
		*ImageAdress = *ImageMemPos
	ElseIf Not *ImageAdress
		ProcedureReturn ImageID(ImageNr)
	EndIf
	If UCase(PeekS(*ImageAdress+1,3,#PB_Ascii)) = "PNG"
		If UCase(PeekS(*ImageAdress+37,4,#PB_Ascii)) = "TRNS"
			*TransColP = @Transcol
 			*TransColP\rgbBlue = PeekB(*ImageAdress+42)
 			*TransColP\rgbGreen = PeekB(*ImageAdress+44)
 			*TransColP\rgbRed = PeekB(*ImageAdress+46)
 			ImageCopy = CopyImage(ImageNr,#PB_Any)
			FreeImage(ImageNr)
			CreateImage(ImageNr,ImageWidth(ImageCopy), ImageHeight(ImageCopy),32)
			If StartDrawing(ImageOutput(ImageNr))
				DrawImage(ImageID(ImageCopy),0,0)
				DrawingMode(#PB_2DDrawing_AlphaChannel)
				Box(0, 0, ImageWidth(ImageCopy), ImageHeight(ImageCopy), $FF000000)
				; Setzen der Transparenten Punkte durch LANGSAME Point/Plot-Befehle
 				For x = 0 To ImageWidth(ImageCopy)-1
	 				For y = 0 To ImageHeight(ImageCopy)-1
 						If (Point(x,y) & $FFFFFF) = Transcol
 							Plot(x,y,0)
 						EndIf
 					Next y
 				Next x
				StopDrawing()
			EndIf
			FreeImage(ImageCopy)
		EndIf
	EndIf
	If *ImageMemPos : FreeMemory(*ImageMemPos) : EndIf
	ProcedureReturn ImageID(ImageNr)
EndProcedure

#ImageFileName = "C:\Temp\SpeakerOn.png"  ; change this to fit your Image-File

UsePNGImageDecoder()
Global Image0=CatchImage(0, ?Image0)
Global Image1=CatchImage(1, ?Image0)
Global Image2=LoadImage(2, #ImageFileName)

Image1 = CreateAlphaFromTRNSChunk(1,"",?Image0)
CreateAlphaFromTRNSChunk(2,#ImageFileName)

DataSection
Image0:
  IncludeBinary #ImageFileName
EndDataSection

If OpenWindow(0, 100,100,280,100, "Transparenz-Test",#PB_Window_SystemMenu | #PB_Window_TitleBar )
     ImageGadget(0, 40, 20, 40, 35, Image0)
     ImageGadget(1, 120, 20, 40, 35, Image1)
     ImageGadget(2, 200, 20, 40, 35, ImageID(2))
            
   Repeat 
      Define Event=WaitWindowEvent() 
   Until Event=#PB_Event_CloseWindow 
EndIf