Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
weicher text mit freetype
| Uploader: |  flo |
| Datum/Zeit: | 10.07.2008 17:41:07 |
'' Original program:
'' FreeType2 library test, by jofers (spam[at]betterwebber.com)
''
'Ich (flo) hab "nur" das weiche einblenden dazugefügt, (dafür musste ich nen neuen parameter zur DrawGlyph-SUB hinzufügen (myalpha))
'außerdem macht er ne neue zeile wenn \n im string erscheint wird.
#include "fbgfx.bi"
#include "freetype2/freetype.bi"
' Alpha blending
#define FT_MASK_RB_32 &h00FF00FF
#define FT_MASK_G_32 &h0000FF00
' DataStructure to make it easy
Type FT_Var
ErrorMsg As FT_Error
Library As FT_Library
PixelSize As Integer
End Type
Dim Shared FT_Var As FT_Var
Declare sub DrawGlyph(ByVal FontFT As FT_Face, ByVal x As Integer, ByVal y As Integer, ByVal Clr As UInteger,myalpha as ubyte)
Declare Function PrintFT(ByVal x As Integer, ByVal y As Integer, ByVal Text As String, ByVal Font As Integer, ByVal Size As Integer = 14, ByVal Clr As UInteger = Rgb(255, 255, 255)) as integer
Declare Function GetFont(ByVal FontName As String) As Integer
' Initialize FreeType
' -------------------
FT_Var.ErrorMsg = FT_Init_FreeType(@FT_Var.Library)
If FT_Var.ErrorMsg Then
Print "Could not load library"
End
End If
' Your program
' ------------
ScreenRes 800, 240, 32
Dim ArialFont As Integer
ArialFont = GetFont ("/usr/local/share/freebasic/examples/libraries/SDL/data/Vera.ttf") 'GetFont("/home/flo/Downloads/epilog/epilog.TTF")
If ArialFont = 0 Then Print "couldn't find it": Sleep: End
dim as integer x,y
For x = 0 to 320
for y = 0 to 239
pset (x, y), x xor y
next y
next x
dim as string text
'Randomize timer
'For X = 1 To 20
' PrintFT Rnd * 200, Rnd * 180 + 20, "Hello World!", ArialFont, Rnd * 22 + 10, Rgb(Rnd * 255, Rnd * 255, Rnd * 255)
'Next X
text=!"schau mal, diese toooooooooolle textausgabe\nschaut doch gut aus. \noder?"
PrintFT 10,100,text,arialfont,23,rgb(255,255,0)
Sleep
' Load a font
' -----------
Function GetFont(ByVal FontName As String) As Integer
Dim Face As FT_Face
Dim ErrorMsg As FT_Error
ErrorMsg = FT_New_Face(FT_Var.Library, FontName, 0, @Face )
If ErrorMsg Then Return 0
Return CInt(Face)
End Function
' Print Text
' ----------
Function PrintFT(ByVal x As Integer, ByVal y As Integer, ByVal Text As String, ByVal Font As Integer, ByVal Size As Integer = 14, ByVal Clr As UInteger = Rgb(255, 255, 255)) as integer
Dim ErrorMsg As FT_Error
Dim FontFT As FT_Face
Dim GlyphIndex As FT_UInt
Dim Slot As FT_GlyphSlot
Dim PenX As Integer
Dim PenY As Integer
Dim i As Integer
dim temph as integer
const as integer plus=5
' Get rid of any alpha channel in AlphaClr
Clr = Clr Shl 8 Shr 8
'Convert font handle
FontFT = Cast(FT_Face, Font)
' Set font size
ErrorMsg = FT_Set_Pixel_Sizes(FontFT, Size, Size)
FT_Var.PixelSize = Size
If ErrorMsg Then Return 0
dim as integer transp (0 to len(text)-1)
dim as integer tr
dim as fb.image ptr BG
temph=size
for i=0 to len(text)-1
transp(i)=-i*50
if mid(text,i+1,1)=!"\n" then temph=temph+size+plus
next
BG=imagecreate (800,temph)
get (0,y-size)-(799,y-size+temph-1),BG
' Draw each character
Slot = FontFT->Glyph
do while inkey=""
PenX = x
PenY = y
screenlock
put (0,y-size),BG,pset
For i = 0 To Len(Text) - 1
if mid(text,i+1,1)=!"\n" then penx=x:peny+=size+plus:i+=1
' Load character index
GlyphIndex = FT_Get_Char_Index(FontFT, Text[i])
' Load character glyph
ErrorMsg = FT_Load_Glyph(FontFT, GlyphIndex, FT_LOAD_DEFAULT)
If ErrorMsg Then Return 0
' Render glyph
ErrorMsg = FT_Render_Glyph(FontFT->Glyph, FT_RENDER_MODE_NORMAL)
If ErrorMsg Then Return 0
' Check clipping
If (PenX + FontFT->Glyph->Bitmap_Left + FontFT->Glyph->Bitmap.Width) > 800 Then Exit For
If (PenY - FontFT->Glyph->Bitmap_Top + FontFT->Glyph->Bitmap.Rows) > 240 Then Exit For
If (PenX + FontFT->Glyph->Bitmap_Left) < 0 Then Exit For
If (PenY - FontFT->Glyph->Bitmap_Top) < 0 Then Exit For
if transp(i)<0 then tr=0 else if transp(i)>255 then tr=255 else tr=transp(i)
transp(i)+=10
'tr=255
' Set pixels
DrawGlyph FontFT, PenX + FontFT->Glyph->Bitmap_Left, PenY - FontFT->Glyph->Bitmap_Top, Clr,tr
PenX += Slot->Advance.x Shr 6
Next i
screenunlock
sleep 10
loop
End Function
sub DrawGlyph(ByVal FontFT As FT_Face, ByVal x As Integer, ByVal y As Integer, ByVal Clr As UInteger,myalpha as ubyte)
Dim BitmapFT As FT_Bitmap
Dim BitmapPtr As UByte Ptr
Dim DestPtr As UInteger Ptr
Dim BitmapHgt As Integer
Dim BitmapWid As Integer
Dim BitmapPitch As Integer
Dim Src_RB As UInteger
Dim Src_G As UInteger
Dim Dst_RB As UInteger
Dim Dst_G As UInteger
Dim Dst_Color As UInteger
Dim Alpha As Integer
BitmapFT = FontFT->Glyph->Bitmap
BitmapPtr = BitmapFT.Buffer
BitmapWid = BitmapFT.Width
BitmapHgt = BitmapFT.Rows
BitmapPitch = 800 - BitmapFT.Width
DestPtr = Cast(UInteger Ptr, ScreenPtr) + (y * 800) + x
Do While BitmapHgt
Do While BitmapWid
' Thanks, GfxLib
Src_RB = Clr And FT_MASK_RB_32
Src_G = Clr And FT_MASK_G_32
Dst_Color = *DestPtr
Alpha = *BitmapPtr
alpha=alpha*(myalpha/255)
Dst_RB = Dst_Color And FT_MASK_RB_32
Dst_G = Dst_Color And FT_MASK_G_32
Src_RB = ((Src_RB - Dst_RB) * Alpha) Shr 8
Src_G = ((Src_G - Dst_G) * Alpha) Shr 8
*DestPtr = ((Dst_RB + Src_RB) And FT_MASK_RB_32) Or ((Dst_G + Src_G) And FT_MASK_G_32)
DestPtr += 1
BitmapPtr += 1
BitmapWid -= 1
Loop
BitmapWid = BitmapFT.Width
BitmapHgt -= 1
DestPtr += BitmapPitch
Loop
End sub