BMP Fonts easy selber machen mit den TrueTypes die man hat !
Übersicht BlitzBasic Codearchiv
Markus2Betreff: BMP Fonts easy selber machen mit den TrueTypes die man hat ! |
Di, Feb 03, 2004 23:43 Antworten mit Zitat |
|
---|---|---|
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 . 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 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 bmpText ist kompatibel zu Text 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 |
Do, Feb 05, 2004 19:59 Antworten mit Zitat |
|
---|---|---|
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 |
Sa, Feb 07, 2004 20:41 Antworten mit Zitat |
|
---|---|---|
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 . |
||
Übersicht BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group