BMP Fonts easy selber machen mit den TrueTypes die man hat !

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Markus2

Betreff: BMP Fonts easy selber machen mit den TrueTypes die man hat !

 BeitragDi, Feb 03, 2004 23:43
Antworten mit Zitat
Benutzer-Profile anzeigen
So,
mein (fast)neues Werk um sich schnell BMP Fonts selber zu machen
mit den TrueType Fonts die man zur verfügung hat
mit farbverlauf und Outline und diesmal so das NICHT alle Zeichen
in eine Reihe stehen(Win2000 ist doof) sondern schön in mehrere
Reihen aufgeteilt werden nach eigener maximal breite die jetzt
default mäßig auf 1024 steht .

user posted image

Viel Spaß 8)

Das eigentliche Prog. in einen Ordner werfen und starten ,
dann hat man 2 Dateien , eine Font Datei als Bitmap und eine
Beschreibungdatei xywh (siehe 2ten Source)
Am Farbverlauf dürft ihr selber spielen Shocked
Code: [AUSKLAPPEN]


; Font Creator 2 (C) 2004 bei M.Rauch

; MR 03.01.2004

Graphics 800,600,16,2

;Font Namen siehe Corel Draw !

;Haettenschweiler 19
;Futura Black BT 24
;Georgia 19
;Sage 24

Local Font$="Haettenschweiler" ;"Sage"
Local FontY=24

mfont=LoadFont(Font$,FontY,0) 

SetFont mfont

Local i,x,y,w,h,xmax#,ymax#,x1,y1,fh

Type bmpFontType
 Field x,y,w,h
End Type

Dim bmpFont.bmpFontType (255)

For i=0 To  255
 bmpFont.bmpFontType(i)=New bmpFontType
Next

x=0
y=0
xmax=0
ymax=0
w=0
h=FontHeight()+2
For i=0 To 255
 w=StringWidth(Chr(i))+2
 bmpFont(i)\x=x
 bmpFont(i)\y=y
 bmpFont(i)\w=w
 bmpFont(i)\h=h

 x=x+w
 If x+w>1024-1 Then ; 2048-1 Then
  xmax=mMax(xmax,x)
  x=0
  y=y+h
 EndIf

Next
xmax=mMax(xmax,x+w)
ymax=mMax(ymax,y+h)

DebugLog xmax +" "+ Int(xmax/32.0)*32
DebugLog ymax +" "+ Int(ymax/32.0)*32

If xmax > Int(xmax/32.0)*32 Then xmax=Int(xmax/32.0)*32+32 ;hinzufügen
If ymax > Int(ymax/32.0)*32 Then ymax=Int(ymax/32.0)*32+32

If xmax < Int(xmax/32.0)*32 Then xmax=Int(xmax/32.0)*32 ;auffüllen
If ymax < Int(ymax/32.0)*32 Then ymax=Int(ymax/32.0)*32

DebugLog "Font Image " + xmax + " x " + ymax

;----------------------------------------------------- Beschreibung speichern

fh=WriteFile(Font$+Str(fonty)+".xywh")

WriteLine fh,"MR BMPFont description format 256 x Int xywh : Fontname="+Font$

For i=0 To 255

 WriteInt fh,bmpFont(i)\x
 WriteInt fh,bmpFont(i)\y

 WriteInt fh,bmpFont(i)\w
 WriteInt fh,bmpFont(i)\h
 
Next

CloseFile fh

;----------------------------------------------------- Zeigen

Global bmpfont_img=CreateImage(xmax,ymax)
Global f1=CreateImage(xmax,ymax)
Global f2=CreateImage(xmax,ymax)

SetBuffer ImageBuffer(bmpfont_img)

ClsColor 255,0,255
Cls

For i=0 To 255

 Color 0,0,0

 For x1=-1 To 1
  For y1=-1 To 1
   Text bmpFont(i)\x+1+x1,bmpFont(i)\y+1+y1,Chr(i)
  Next
 Next

 Color 255,255,255
 Text bmpFont(i)\x+1,bmpFont(i)\y+1,Chr(i)
 
Next

;SetBuffer FrontBuffer()
;DrawImage bmpFont_img,0,0
;WaitKey
;End

;---------------------------------------------------------
; Farbverlauf :-)))
;---------------------------------------------------------

MaskImage bmpFont_img,255,255,255

SetBuffer ImageBuffer(f1)

Local r#,g#,b#
Local yl=0

Local f#=bmpFont(0)\h / (255.0/10.0)

DebugLog "f=" +f

For y=1 To ImageHeight(f1)

 If yl=0 Then
  r=255
  g=20
  b=32
 EndIf

 Color r,g,b
 Line 0,y-1,ImageWidth(f1)-1,y-1
 ;r=r+5*f
 g=g+10*f
 b=b-5*f
 If r<0 Then r=0
 If g<0 Then g=0
 If b<0 Then b=0
 If r>255 Then r=255
 If g>255 Then g=255
 If b>255 Then b=255

 yl=yl+1
 If yl=bmpFont(0)\h Then yl=0

Next

DrawImage bmpFont_img,0,0

MaskImage f1,255,0,255

SetBuffer ImageBuffer(bmpFont_img)

DrawImage f1,0,0

;---------------------------------------------------------

SaveBuffer ImageBuffer(bmpFont_img),Font$+Str(fonty)+".bmp"

;---------------------------------------------------------

SetBuffer FrontBuffer()

ClsColor 50,100,50
Cls

MaskImage bmpFont_img,255,0,255

DrawImageRect bmpFont_img,0,0,0,0,GraphicsWidth(),GraphicsHeight()/2 ;zur hälfte zeigen reicht ja wohl

bmpText 32,GraphicsHeight()/2,"0123456789 Hallo du wie geht es dir ??? ÄÖÜ äöü für -" ;Test Text ausgeben :-)

WaitKey

End

;########################################

Function mMax#(a#, b#)
 
 ;MR 22.06.2003
 
 If a > b Then
  Return a
 Else
  Return b
 End If
 
End Function

;#################################

Function bmpText (x,y,t$,centerx=0,centery=0)

 If bmpfont_img=0 Then Return 0
 If Len(t$)=0 Then Return 0

 If centerx Then x=x-bmpTextWidth(t$)/2
 If centery Then y=y-bmpFont(0)\h/2

 Local i,p

 For i=1 To Len(t$)
  p=Asc(Mid(t$,i,1))
  DrawImageRect bmpFont_img,x,y,bmpFont(p)\x,bmpFont(p)\y,bmpFont(p)\w,bmpFont(p)\h 
  x=x+bmpFont(p)\w ;add FontSpace here +2 or so
 Next
 
 Return True

End Function

;##################################

Function bmpTextWidth(t$)

 If Len(t$)=0 Then Return 0

 Local i,p,x=0

 For i=1 To Len(t$)
  p=Asc(Mid(t$,i,1))
  x=x+bmpFont(p)\w ;add FontSpace here +2 or so
 Next
 
 Return x

End Function

;#######################################

Function bmpTextHeight()
 
 Return bmpFont(0)\h

End Function

;##########################################



Das hier ins Spiel oder wo ihr den Font braucht einbauen Exclamation

bmpText ist kompatibel zu Text Idea

Code: [AUSKLAPPEN]


;---------------------------------------------------------------------------------------------------

.BMPFONT2

Local BMPFontName$="Fnt\Font24"

Type bmpFontType
 Field x,y,w,h
End Type

Dim bmpFont.bmpFontType (255)

Local i

For i=0 To  255
 bmpFont.bmpFontType(i)=New bmpFontType
Next

Global bmpfont_img=LoadImage(BMPFontName$+".bmp")
MaskImage bmpfont_img,248,0,248 ;Wenn in 16 Bit gespeichert
;MaskImage bmpfont_img,255,0,255 ;Wenn in 24 oder 32 Bit gespeichert

Local fh

fh=ReadFile(BMPFontName$+".xywh")

If fh Then

DebugLog "Load "+ReadLine(fh)

For i=0 To 255

 bmpFont(i)\x=ReadInt(fh)
 bmpFont(i)\y=ReadInt(fh)
 bmpFont(i)\w=ReadInt(fh)
 bmpFont(i)\h=ReadInt(fh)

Next

CloseFile fh

EndIf

;---------------------------------------------------------------------------------------------------

;############################

.BMPFont2Func

Function bmpText (x,y,t$,centerx=0,centery=0)

 If bmpfont_img=0 Then Return 0
 If Len(t$)=0 Then Return 0

 If centerx Then x=x-bmpTextWidth(t$)/2
 If centery Then y=y-bmpFont(0)\h/2

 Local i,p

 For i=1 To Len(t$)
  p=Asc(Mid(t$,i,1))
  DrawImageRect bmpFont_img,x,y,bmpFont(p)\x,bmpFont(p)\y,bmpFont(p)\w,bmpFont(p)\h 
  x=x+bmpFont(p)\w ;add FontSpace here +2 or so
 Next
 
 Return True

End Function

;#################################

Function bmpTextWidth(t$)

 If Len(t$)=0 Then Return 0

 Local i,p,x=0

 For i=1 To Len(t$)
  p=Asc(Mid(t$,i,1))
  x=x+bmpFont(p)\w ;add FontSpace here +2 or so
 Next
 
 Return x

End Function

;#####################################

Function bmpTextHeight()
 
 Return bmpFont(0)\h

End Function

Ctuchik

 BeitragDo, Feb 05, 2004 19:59
Antworten mit Zitat
Benutzer-Profile anzeigen
Wirklich nützlich, das kann ich gut gebrauchen, jetzt muss ich mir die Funktion nicht mehr selber schreiben!
Ich hab noch ne Frage: Kann man das modifizieren, dass der Text keine feste Farbe hat, sondern im Spiel beliebig eingefärbt wird? Es müssen dann auch keine Farbverläufe mehr sein, aber verschiedene Farben wären ganz nützlich!
Ich hab das gestern versucht mit ReadPixelFast und WritePixelFast umzusetzen, aber es kam mir trotzdem etwas langsam vor!

mfG Ctuchik

Markus2

 BeitragSa, Feb 07, 2004 20:41
Antworten mit Zitat
Benutzer-Profile anzeigen
Ctuchik hat Folgendes geschrieben:
... Kann man das modifizieren, dass der Text keine feste Farbe hat, sondern im Spiel beliebig eingefärbt wird? Es müssen dann auch keine Farbverläufe mehr sein, aber verschiedene Farben wären ganz nützlich!



Mach dir am besten mehrere Fonts und die ladest du dann ein .
Wenn es der gleiche ist brauchste nur der Text Funktion noch
nen Parameter geben und aus bmpfont_img ein Array machen .

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group