I have been playing with bitmap fonts recently and have decided to give some away to the community.
The background colours in the display images I have chosen to show off the font. If you click the Download button you will get all the images as PNG files with alpha backgrounds.
Enjoy
Bitmap Font Pack 2 now available!
Bitmap Font Pack 3 now available!
Black & White / White & Black
Gold / Silver
Fire / Blood
LED red / LED green
LED blue / VideoPhreak
Orange with Shadow / Party Time
Rocks / Planks
Load Bitmap and cut images - keeping transparency:
`*********************************
` LOAD BITMAP FONT
`*********************************
Function LoadBMfont(FileName as string,FontImageNumber)
load image FileName,FontImageNumber,1
Font = 32
For y = 0 to 9
for x = 0 to 9
GetImage( FontImageNumber, Font + FontImageNumber, x*32, y*32, 32, 32 )
inc Font
next x
next y
` Delete Image FontImageNumber
endfunction
`*********************************
` GET IMAGE WITH TRANSPARENCY
`*********************************
function GetImage(Image1,NewImage,Xstart,Ystart,Xsize as dword,Ysize as dword)
`Find unused memblocks
Memblock1 = 1
repeat
inc Memblock1
until memblock exist(Memblock1) = 0
NewMemblock = 2
repeat
inc NewMemblock
until memblock exist(NewMemblock) = 0
`Set up variables
Local Width as Dword
Local Height as Dword
Local Depth as Dword
Local Red as Byte
Local Green as Byte
Local Blue as Byte
Local Alpha as Byte
`Do it!
make memblock from image Memblock1,Image1
Width = memblock dword(Memblock1,0)
Height = memblock dword(Memblock1,4)
Depth = memblock dword(Memblock1,8)
make memblock NewMemblock,(Width*Height)+12
Write memblock Dword NewMemblock,0,Xsize
Write memblock Dword NewMemblock,4,Ysize
Write memblock Dword NewMemblock,8,Depth
Position = (Width * (Ystart)*4) + (Xstart*4) + 12
NewPosition = 12
for y = 1 to Ysize
for x = 1 to Xsize
Blue = memblock byte(Memblock1,Position)
Green = memblock byte(Memblock1,Position+1)
Red = memblock byte(Memblock1,Position+2)
Alpha = memblock byte(Memblock1, Position+3)
write memblock byte NewMemblock,NewPosition,Blue
write memblock byte NewMemblock,NewPosition+1,Green
write memblock byte NewMemblock,NewPosition+2,Red
write memblock byte NewMemblock,NewPosition+3,Alpha
inc Position,4
Inc NewPosition,4
next x
inc Position , (width*4) - (Xsize*4)
next y
make image from memblock NewImage,NewMemblock
delete memblock Memblock1
delete memblock NewMemblock
endfunction
Trim the transparent edges away from the font:
`Put the 2 DIM commands at the top of you code
Dim BMleft(127)
Dim BMwidth(127)
'*********************************
` TRIM BITMAP FONT
`*********************************
Function TrimBMFont(FontNo)
Local BlankColumn as boolean
Local Alpha as byte
Local Chr as integer
Local FontWidth as integer = 32
Local FontHeight as integer = 32
For Chr = 33 to 126
Make Memblock From Image 1 , FontNo + Chr
for x = 1 to FontWidth
BlankColumn = Yes
for y = 1 to FontHeight - 1
if BMleft(Chr) = 0
Position = (y * FontWidth * 4) + (x * 4) + 15
Alpha = memblock byte(1 , Position)
if Alpha > 0
BlankColumn = No
y = FontHeight - 1
endif
endif
next y
if BlankColumn = No
BMleft(Chr) = x
x = FontWidth
endif
next x
for x = FontWidth - 1 to 1 step - 1
BlankColumn = Yes
for y = 1 to FontHeight - 1
if BMwidth(Chr) = 0
Position = (y * FontWidth * 4) + (x * 4) + 15
Alpha = memblock byte(1 , Position)
if Alpha > 0
BlankColumn = No
y = FontHeight
endif
endif
next y
if BlankColumn = No
BMwidth(Chr) = x - BMleft(Chr)
x = 1
endif
next x
delete memblock 1
next Chr
BMleft(32) = 0
BMwidth(32) = FontWidth / 2
endfunction
Display the fonts:
`*********************************
` DISPLAY BITMAP FONT
`*********************************
Function BMFont(X,Y,S as string,ImageNo,SpriteNo,Kern)
for k = 1 to len(S)
Chr = asc(mid$(S,k))
if k > 1
sprite SpriteNo + k ,NewX - BMleft(Chr) ,Y ,ImageNo + Chr
NewX = (NewX) + BMwidth(Chr) + Kern
else
sprite SpriteNo + k ,X - BMleft(Chr) ,Y ,ImageNo + Chr
NewX = X + BMwidth(Chr) + Kern
endif
next k
endfunction