 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
darkinsanity
aka sts
Anmeldungsdatum: 01.11.2006
Beiträge: 456
|
 Verfasst am: 29.02.2008, 11:34 Titel: Windows Fonts in Freebasic |
 |
|
Hi,
ich will Windows Fonts (Arial und so) in FB nutzen. Da bin ich über FreeType gestolpert. Problem: Das Ding kann nur einzelne Zeichen ausgeben. Ich habs in ne FOR Schleife gepackt, aber da krieg ich Anzeige-Fehler wegen der unterschiedlichen Größe der erstellten Bitmaps. Hat jemand ne Routine die einwandfrei geht?
Im vorraus schon mal danke |
|
| Nach oben |
|
 |
oldirty
Anmeldungsdatum: 04.08.2005
Beiträge: 65
|
|
| Nach oben |
|
|
stevie1401
Anmeldungsdatum: 04.07.2006
Beiträge: 133
|
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 29.03.2008, 13:00 Titel: |
|
|
Hi,
die von oldirty vorgeschlagene Lib mainz bekomme ich nicht ans laufen, kann an meinem Win ME liegen?
Unter FBGFX Font Render by Mysoft habe ich eine Routine gefunden die sehr gut funktioniert.
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 29.03.2008, 13:27 Titel: |
|
|
Unser lieblingstroll (  ) hat auch mal einen Code zum Benutzen der Windows-Schriftarten unter OGL geliefert, siehe hier. Der Code ist zwar nicht der beste (Shared-Variablen, die nur in einer Sub gebraucht werden, etc.), aber funktioniert zumindest mit OpenGL.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
max06
Anmeldungsdatum: 05.12.2004
Beiträge: 390
Wohnort: Augsburg
|
| Verfasst am: 29.03.2008, 23:53 Titel: |
|
|
Glücklicher weise hab ich mich letzte Woche mit dem selben Thema beschäftigt... die perfekte Lösung findet man im Examples-Ordner:
\examples\libraries\freetype\ft_print.bas
| Code: | ''
'' FreeType2 library test, by jofers (spam[at]betterwebber.com)
''
#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)
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 320, 240, 32
Dim ArialFont As Integer
ArialFont = GetFont("../SDL/data/Vera.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
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
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
' 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
' Draw each character
Slot = FontFT->Glyph
PenX = x
PenY = y
For i = 0 To Len(Text) - 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) > 320 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
' Set pixels
DrawGlyph FontFT, PenX + FontFT->Glyph->Bitmap_Left, PenY - FontFT->Glyph->Bitmap_Top, Clr
PenX += Slot->Advance.x Shr 6
Next i
End Function
sub DrawGlyph(ByVal FontFT As FT_Face, ByVal x As Integer, ByVal y As Integer, ByVal Clr As UInteger)
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 = 320 - BitmapFT.Width
DestPtr = Cast(UInteger Ptr, ScreenPtr) + (y * 320) + 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
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 |
Funktioniert perfekt, nutze ich seit dem auch  |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
