Home
Products
Community
Manuals
Contact
Login or Signup

Code archives/Graphics/Bitmap Font

This code has been declared by its author to be Public Domain code.

Download source code

Bitmap Font by Ked(Posted 1+ years ago)
Uses BlitzMax's DrawSubImageRect, so it's faster than AnimImage. Have fun!
SuperStrict

Type TBitmapFontViewer
	Field img:TImage
	Field x:Float,y:Float
	Field w:Int,h:Int
	Field holding:Int=False
	Field holdx:Float,holdy:Float
	
	Field path:String="n/a"
	Field chardata:TBitmapCharData[96]
	
	Method Open:TBitmapFontViewer(url:Object)
		img=LoadImage(String(url)+"_img.png")
		If img=Null Return Null
		
		x=0
		y=0
		w=ImageWidth(img)
		h=ImageHeight(img)
		
		path=String(url)
		
		Return Self
	EndMethod
	
	Method CreateNew:TBitmapFontViewer(furl:Object,size:Int)
		Local imgfont:TImageFont=LoadImageFont(furl,size)
		If imgfont=Null Return Null
		SetImageFont(imgfont)
		
		x=0
		y=0
		
		path="n/a"
		
		Local spacing:Int=(size*2)
		Local dx:Int=0,dy:Int=0
		
		Cls()
		SetBlend ALPHABLEND
		
		For Local i:Int=32 To 127
			DrawText(Chr(i),dx,dy)
			
			Local c:TBitmapCharData=New TBitmapCharData
			c.ind=i
			c.x=dx
			c.y=dy
			c.w=TextWidth(Chr(i))
			c.h=TextHeight(Chr(i))
			
			chardata[(i-32)]=c
			
			dx:+spacing
			If dx=(16*spacing)
				dx=0
				dy:+spacing
			EndIf
		Next
		
		Flip()
		
		dy:+spacing
		
		w=(16*spacing)
		h=dy
		
		img=CreateImage(w,h,1,DYNAMICIMAGE|FILTEREDIMAGE)
		GrabImage(img,0,0)
		
		Return Self
	EndMethod
	
	Method Save(name:String)
		If path<>"n/a" Return
		If img=Null Return
		
		Local pix:TPixmap=img.pixmaps[0]
		SavePixmapPNG(pix,name+"_img.png")
		pix=Null
		
		Local dat:TStream=WriteStream(name+"_data.dat")
		For Local i:Int=0 To 94
			Local c:TBitmapCharData=chardata[i]
			WriteInt(dat,c.ind)
			WriteInt(dat,c.x)
			WriteInt(dat,c.y)
			WriteInt(dat,c.w)
			WriteInt(dat,c.h)
		Next
		CloseStream(dat)
		
		path=name
	EndMethod
	
	Method Update()
		Local md:Int=MouseDown(MOUSE_LEFT)
		Local mx:Int=MouseX()
		Local my:Int=MouseY()
		
		If (mx>x And my>y And mx<(x+w) And my<(y+h))=False
			If md=True md=False
		EndIf
		
		If md=True
			If holding=False
				holding=True
				holdx=MouseX()
				holdy=MouseY()
			EndIf
			
			If holding=True
				Local xdist:Float=(MouseX()-holdx)
				Local ydist:Float=(MouseY()-holdy)
				
				x:+xdist
				y:+ydist
				
				holdx:+xdist
				holdy:+ydist
			EndIf
		Else
			If holding=True
				holding=False
				holdx=0
				holdy=0
			EndIf
		EndIf
	EndMethod
	
	Method Draw()
		SetBlend ALPHABLEND
		SetScale 1,1
		SetAlpha 1.0
		SetRotation 0
		SetColor 255,255,255
		
		DrawImage img,x,y
	EndMethod
EndType

Type TBitmapCharData
	Field ind:Int
	Field x:Int
	Field y:Int
	Field w:Int
	Field h:Int
EndType

Type TBitmapFont
	Field img:TImage
	Field chardata:TBitmapCharData[96]
	
	Method Load:TBitmapFont(url:Object)
		img=LoadImage(String(url)+"_img.png")
		If img=Null Return Null
		
		Local dat:TStream=ReadStream(String(url)+"_data.dat")
		If dat=Null Return Null
		
		For Local i:Int=0 To 94
			Local c:TBitmapCharData=New TBitmapCharData
			c.ind=ReadInt(dat)
			c.x=ReadInt(dat)
			c.y=ReadInt(dat)
			c.w=ReadInt(dat)
			c.h=ReadInt(dat)
			chardata[i]=c
		Next
		CloseStream(dat)
		
		Return Self
	EndMethod
	
	Method Draw(t:String,x:Float,y:Float)
		Local dx:Float=x,dy:Float=y
		Local h:Float=GetHeight(" ")
		Local xscale:Float,yscale:Float
		Local rot:Float
		
		GetScale(xscale,yscale)
		rot=GetRotation()
		SetRotation 0
		
		For Local i:Int=0 To t.length-1
			Local ind:Int=t[i]
			If Chr(ind)="~n"
				dx=x
				dy:+(h*yscale)
			Else
				Local c:TBitmapCharData=chardata[ind-32]
				DrawSubImageRect(img,dx,dy,c.w,c.h,c.x,c.y,c.w,c.h)
				dx:+(c.w*xscale)
			EndIf
		Next
		
		SetRotation rot
	EndMethod
	
	Method GetHeight:Int(t:String)
		Local h:Int=0
		
		For Local i:Int=0 To t.length-1
			Local ind:Int=t[i]
			If Chr(ind)="~n" Continue
			
			Local c:TBitmapCharData=chardata[ind-32]
			If c.h>h h=c.h
		Next
		
		Return h
	EndMethod
	
	Method GetWidth:Int(t:String)
		Local w:Int=0
		
		For Local i:Int=0 To t.length-1
			Local ind:Int=t[i]
			If Chr(ind)="~n" Continue
			
			Local c:TBitmapCharData=chardata[ind-32]
			If c.w>w w=c.w
		Next
		
		Return w
	EndMethod
	
	Method Delete()
		chardata=Null
		img=Null
	EndMethod
EndType

Rem
'Example 1 : Create a bitmap font
Graphics 800,600

Global fview:TBitmapFontViewer=New TBitmapFontViewer.CreateNew(GetEnv_("systemroot")+"/fonts/trebuc.ttf",16)
fview.Save("TrebuchetMS16")

Repeat
	If AppTerminate() End
	If KeyHit(KEY_ESCAPE) End
	
	fview.Update()
	
	Cls
	
	fview.Draw()
	
	Flip
Forever
EndRem

Rem
'Example 2 : Use a bitmap font
Graphics 800,600

Global f:TBitmapFont=New TBitmapFont.Load("TrebuchetMS16")

Repeat
	If AppTerminate() End
	If KeyHit(KEY_ESCAPE) End
	
	Cls
	
	SetScale 1,1
	SetRotation 90
	f.Draw("Hello! This is a bitmap font routine for BlitzMax.~nI hope you enjoy it.~n~nOr else...",MouseX(),MouseY())
	
	Flip()
Forever
EndRem

Comments

rs22(Posted 1+ years ago)
Very nice. :)


Ked(Posted 1+ years ago)
Thanks! I have a bugfix but won't be able to update the above code until I can get to my computer. (I'm on my iPod right now.)


Code Archives Forum