This is the third installment of my bitmap fonts. Like the first they are FREE to use however you wish .... enjoy
Pack 1 used 32 x 32 fonts.
Pack 2 uses 64 x 64 fonts.
Pack 3 uses 64 x 64 fonts.
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*64, y*64, 64, 64 )
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 fonts:
`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 = 64
Local FontHeight as integer = 64
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 font:
`*********************************
` 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
Click the
download button to download the PNG files with transparent backgrounds.
Glass
Ice
Metal
Military
Gooey
Snow
Pager Red
Pager Green
Pager Blue
Pager Yellow
