PureBoard

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

Code: Alles auswählen

Structure RGBAstruct
r.c
b.c
g.c
a.c
EndStructure