| FontEngine von ??? |
| Hi Folks ... hier mal meine FontEngine zur freien Verfügung. Der Code besteht aus mehreren Teilen. Zuerst der Fontscanner. Dieser Code nimmt eine Bitmap in der, ASCII-konform, alle Zeichen "gemalt" sind. Diese Bitmap muss den Regeln eines AnimImages entsprechen, also alle Zellen müssen gleich breit sein. [code:1:2dd11ec694] ;------------------------------------------------- ; Fontscanner ;------------------------------------------------- Type tOffset Field off End Type imagefile$=BTLoadFile("Font-Bitmap laden",CurrentDir(),"BMP *.bmp|*.bmp|JPEG *.jpg|*.jpg|PNG *.png|*.png|Targa *.tga|*.tga") If Len(imagefile$)>4 Print "Lade "+imagefile$ image=LoadImage(imagefile$) If image ww=ImageWidth(image) hh=ImageHeight(image) Print "" cw=Input("Wie breit ist ein Character? ") ch=Input("Wie hoch ist ein Character? ") Print "" Print "Scanne Image..." xx=0 : yy=0 : max_x=0 : pcnt=0 SetBuffer ImageBuffer(image) LockBuffer ImageBuffer(image) Repeat x=0 : y=0 : max_x=0 Repeat cc=ReadPixelFast(xx+x,yy+y) r=(cc And $FF0000)/$10000 g=(cc And $FF00)/$100 b=cc And $FF If r=255 And g=0 And b=255 ; << entspricht der Maskierungsfarbe!! Else If x>=max_x Then max_x=x EndIf x=x+1 If x=cw-1 : x=0 : y=y+1 : EndIf Until y=ch offset.tOffset=New tOffset offsetoff=max_x xx=xx+cw If xx>=ww xx=0 : yy=yy+ch EndIf Until yy=hh UnlockBuffer ImageBuffer(image) SetBuffer FrontBuffer() Cls Print "Image gescannt..." standard$=Left(imagefile$,Len(imagefile$)-3)+"fof" filename$=BTSaveFile("Fontoffsets speichern",standard$,"Fontoffset File *.fof|*.fof|Alle Dateien *.*|*.*") If Len(filename$)>4 stream=WriteFile(filename$) If stream For offset.tOffset=Each tOffset WriteByte stream,offsetoff Next CloseFile stream Print "Fertig." Print "Die Offsetdatei befindet sich in "+filename$ Print "Drücke eine Taste um das Programm zu beenden" WaitKey Else RuntimeError "Fehler beim schreiben von "+filename$ EndIf EndIf Else RuntimeError "Das angegebene Image konnte nicht geladen werden." EndIf EndIf End [/code:1:2dd11ec694] Dieses Tool verwendet die BTools von www.makegame.de/btools Der zweite Teil ist der Code zur Initialisierung des Fonts. Er liest die, mit dem Fontscanner geschriebenen, Offsets aus ... lädt die Bitmap und überträgt die Offsets in ein Array. [code:1:2dd11ec694] Dim font_offset(256) Global bitmapfont Function InitFont(fontimage$,fontoffsetfile$,char_width,char_height) bitmapfont=LoadAnimImage(fontimage$,char_width,char_height,0,256) If bitmapfont MaskImage bitmapfont,255,0,255 ;<< eigene Maskierung einsetzen stream=ReadFile(fontoffsetfile$) i=0 If stream For i=0 To 255 font_offset(i)=ReadByte(stream) Next CloseFile stream EndIf EndIf End Function [/code:1:2dd11ec694] Und nun die Routine zum zeichnen von Texten mit diesem Font [code:1:2dd11ec694] Function DrawText(x,y,txt$) lang=Len(txt$) For i=1 To lang char=Asc(Mid(txt$,i,1))-32 DrawImage bitmapfont,x,y,char If char<>0 x=x+(font_offset(char))+1 Else x=x+5 ;<< Spaceweite EndIf Next End Function [/code:1:2dd11ec694] Vielleicht kann diesen Code ja der Eine oder Andere gebrauchen. Wenn es an einem Font fehlt kann dieser hier benutzt werden. Der ist von mir und ich stelle ihn als Freeware zur Verfügung. [img:2dd11ec694]http://www.goto-xcellence.de/member/bruzard/downloads/Contrast13.bmp[/img:2dd11ec694] [EDIT] Ich habe mal das unseelige "WriteLine und ReadLine()" durch Byte-Operationen ersetzt. [/EDIT] |