Alphachannel zu speichern, habe ich mir folgende kleine Funktion(en) geschrieben :
Code: Alles auswählen
; Author: neotoma
; PB 4.02
;
; Types of Alpha
Enumeration
#TGA_ALPHA_NONE ; No Alpha at all
#TGA_ALPHA_FULL ; complete Alpha
#TGA_ALPHA1 ; if color = 0 the Alpha (full)
#TGA_ALPHA8 ; uses the ALpha-Value from the image
#TGA_ALPHA_RAMP ; Ramp alpha a 128 (lower is transparent, higher not)
#TGA_ALPHA_BRIGHTNESS ; Uses the Brightness (better Average) as Alpha
#TGA_ALPHA_HALFTRANSPARENT ; Sets exactly 'Half-Transparent' ($7f)
EndEnumeration
; #############################################################################
; Helper-Function to get the Adress of the Image.
Procedure.l GetImagePtr(ImageNo.l)
Define *Image.l = 0
Define ImageID.l
Define ImageInfo.BITMAP
Define ImWidth.l, ImHeight.l, ImBytes.l, ImLine.l
ImageID = ImageID(ImageNo)
If GetObject_(ImageID, SizeOf(BITMAP), @ImageInfo)
ImWidth = ImageInfo\bmWidth
ImHeight = ImageInfo\bmHeight
ImBytes = ImageInfo\bmBitsPixel/8
ImLine = ImWidth*ImBytes
*Image = ImageInfo\bmBits
EndIf
ProcedureReturn *Image
EndProcedure
; #############################################################################
; Helper-Function for the TGA-Encoding.
; Here we can set what 'type' of lpha each pixel is.
;
Procedure _TGAWriter(outfile.l, *iPtr.RGBAstruct, Depth.l, mode.l)
Select Depth
Case 32: ; Mit alpha
WriteByte(outfile,*iPtr\Blue)
WriteByte(outfile,*iPtr\Green)
WriteByte(outfile,*iPtr\Red)
Select mode
Case #TGA_ALPHA1
If (*iPtr\Blue + *iPtr\Green + *iPtr\Red) > 0
WriteByte(outfile,255)
Else
WriteByte(outfile,0)
EndIf
Case #TGA_ALPHA8
WriteByte(outfile,*iPtr\Alpha)
Case #TGA_ALPHA_RAMP
If (*iPtr\Blue + *iPtr\Green + *iPtr\Red)/3 > 128
WriteByte(outfile,255)
Else
WriteByte(outfile,0)
EndIf
Case #TGA_ALPHA_BRIGHTNESS
WriteByte(outfile,(*iPtr\Blue + *iPtr\Green + *iPtr\Red)/3)
Case #TGA_ALPHA_HALFTRANSPARENT
WriteByte(outfile,127)
Case #TGA_ALPHA_NONE
WriteByte(outfile,0)
Case #TGA_ALPHA_FULL
WriteByte(outfile,255)
Default
WriteByte(outfile,0)
EndSelect
ProcedureReturn *iPtr+4;
EndSelect
EndProcedure
; #############################################################################
; Encoding a image as TGA-File.
; At the Moment it is only possible to create 32 Bit-Transparent Fonts.
; *Attention: It NEED a 32-Bit Image as Input. This is not checked here !
Procedure EncodeTGA(Outputfile$,ImageNo)
Define *iPtr.RGBAstruct
Define of.l,j.l,i.l
*iPtr = GetImagePtr(ImageNo)
;Wir gehen von 32 Bits aus !!!
of.l = CreateFile(#PB_Any,Outputfile$)
If of
WriteByte(of,0) ;idlength
WriteByte(of,0) ;;colormaptype
WriteByte(of,2) ;imagetype 2=rgb
WriteWord(of,0) ;colormapindex
WriteWord(of,0) ;colormapnumentries
WriteByte(of,0) ;colormapsize
WriteWord(of,0) ; xorigin
WriteWord(of,0) ; yorigin
;Write Header
WriteWord(of,ImageWidth(ImageNo))
WriteWord(of,ImageHeight(ImageNo))
WriteByte(of,32)
WriteByte(of,8)
For j= 0 To ImageHeight(ImageNo) - 1 ; j = 0 corresponds to bottom of image
For i = 0 To ImageWidth(ImageNo) - 1
;For Irrlicht 1.2, the first pixel has to be half-transparent ($7f) when
;using ALpha-Channel.
If j=ImageHeight(ImageNo) - 1 And i=0
*iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_HALFTRANSPARENT)
Else
If (*iPtr\Red=-1 And *iPtr\Green=0 And *iPtr\Blue = 0)
;Red Pixels has to be non-Transparent
*iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_FULL)
ElseIf (*iPtr\Red=-1 And *iPtr\Green=-1 And *iPtr\Blue = 0)
;Yellow Pixels has to be non-Transparent
*iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_FULL)
Else
;Otherwise calculate the Alpha from the brightness / Average
*iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_BRIGHTNESS)
EndIf
EndIf
Next
Next
CloseFile(of)
ProcedureReturn #True
Else
MessageRequester("Error", "Not A Valid Bitmap Or Could Not Be Decoded In Memory",#PB_MessageRequester_Ok)
EndIf
ProcedureReturn #False
EndProcedure
