#include "fbgfx.bi" Type Font '' Our font buffer. Buf as FB.Image Ptr '' Font header. Hdr as uByte ptr '' Current font color. Col as uInteger '' Make our font buffer. Declare Sub Make( byVal _Col_ as uInteger = rgb(255, 255, 255) ) '' Change the font color and edit the font buffer. '' Return the new font. Declare Function myFont( byVal _Col_ as uInteger = rgb(255, 255, 255) ) as FB.Image ptr '' Create/Destroy our font. '' Set a default color to it if you like. Declare Constructor( byVal _Col_ as uInteger = rgb(255, 255, 255) ) Declare Destructor() End Type '' Create our font's buffer. Constructor Font( byVal _Col_ as uInteger = rgb(255, 255, 255) ) This.Make( _Col_ ) End Constructor '' Destroy font buffer. Destructor Font() ImageDestroy( Buf ) End Destructor '' Assign the FBgfx font into our font buffer. Sub Font.Make( byVal _Col_ as uInteger = rgb(255, 255, 255) ) '' No image buffer data. Create it. If This.Buf = 0 then '' No screen created yet. If Screenptr = 0 then Exit Sub '' Support 256 characters, 8 in width. '' Add the extra row for the font header. This.Buf = ImageCreate( 256 * 8, 9 ) '' Get the address of the font header, '' which is the same as getting our pixel address '' Except that we always will use a ubyte. This.Hdr = cast(uByte ptr, This.Buf) + Sizeof(FB.Image) '' Assign header information. This.Hdr[0] = 0 '' First supported character This.Hdr[1] = 0 '' Last supported character This.Hdr[2] = 255 Else If This.Col = _Col_ then Exit Sub End If '' Draw our font. For DoVar as Integer = 0 to 255 '' Set font width information. This.Hdr[3 + DoVar] = 8 Draw String This.Buf, (DoVar * 8, 1), chr(DoVar), _Col_ Next '' Remember our font color. This.Col = _Col_ End Sub '' Get the buffer for our font. '' Remake the font if the color's different. Function Font.myFont( byVal _Col_ as uInteger = rgb(255, 255, 255) ) as FB.Image ptr '' If our colors match, just return the current buffer. If _Col_ = Col then Return Buf End If '' Make the font with a new color. This.Make( _Col_ ) '' Return out buffer. Return This.Buf End Function '' MAIN CODE HERE! Screenres 640, 480, 32 '' Create our font. Dim as Font myFont = rgb(255, 255, 255) '' Draw a string using our custom font. Draw String (0,0), "Hello. I am the custom font.",, myFont.myFont() '' Gasp. A new color! Draw String (0,8), "Hello. I am the custom font.",, myFont.myFont(rgb(255, 0, 0)) sleep '' Speed test. Turns out it's quite slow. Scope Randomize Timer '' Our timer. Dim as Double T = Timer '' Time how long it takes to make a new font this way. For DoVar as Integer = 0 to 499 myFont.Make( rgb(rnd * 255, rnd * 255, rnd * 255) ) Next '' And we're all done. Print important data. Locate 3, 1 Print "Time to Re-Draw font 499 times: " & ( Timer - T ) Print "Time per Re-Draw: " & ( Timer - T ) / 500 sleep End Scope