Type AAFont
	Field start,ende
	Field aadata
	Field widths[255]
	Field width
	Field height
End Type


Function SaveAAFont(fnt,filename$)
	f.AAFont = Object.AAFont(fnt)
	fi = WriteFile(filename)
	WriteByte fi,f\start
	WriteByte fi,f\ende
	WriteInt fi,f\width
	WriteInt fi,f\height
	For i = 0 To f\ende - f\start
		WriteInt fi, f\widths[i]
	Next
	WriteInt fi, BankSize(f\aadata)
	WriteBytes(f\aadata,fi,0,BankSize(f\aadata))
	CloseFile fi
End Function

Function LoadAAFont(filename$)
	f.AAFont = New AAFont
	fi = ReadFile(filename)
	f\start = ReadByte(fi)
	f\ende = ReadByte(fi)
	f\width = ReadInt(fi)
	f\height = ReadInt(fi)
	For i = 0 To f\ende - f\start
		f\widths[i] = ReadInt(fi)
	Next
	l = ReadInt(fi)
	f\aadata = CreateBank(l)
	ReadBytes f\aadata, fi, 0, BankSize(f\aadata)
	Return Handle(f)
End Function

Function CreateAAFont(name$,h,bold=False,italic=False,underline=False,samplesize=2,start=0,ende=255)
	
	gbuf = GraphicsBuffer()
	
	f.AAFont = New AAFont
	f\start = start : f\ende = ende
	f\height=h
	
	tempfnt = LoadFont(name,h,bold,False,underline)
	SetFont tempfnt
	For i = 0 To ende-start
		f\widths[i] = StringWidth(Chr(i))
	Next
	f\width = FontWidth()
	
	FreeFont tempfnt
	
	f\AAData = CreateBank(h*f\width*(ende-start+1))
	
	pmul# = (255 / samplesize^2)
	tempfnt = LoadFont(name,h*samplesize,bold,italic,underline)
	SetFont tempfnt
	Color 0,0,255
	AAS = CreateImage(FontWidth() + FontWidth() Mod samplesize,h*samplesize)
	iw = ImageWidth(AAS) : ih = ImageHeight(AAS)
	SetBuffer ImageBuffer(AAS)
	For i = 0 To ende-start
		Text 0,0,Chr(i)
		actpos = i*f\width*h
		LockBuffer
		For y = 0 To h-1
		For x = 0 To f\width-1
			count = 0
			For iy = y*samplesize To y*samplesize+samplesize-1
			For ix = x*samplesize To x*samplesize+samplesize-1
				If (ReadPixelFast(ix,iy) And $FFFFFF) <> 0 Then
					count = count + 1
				End If
			Next
			Next
			percent = pmul * count
			PokeByte f\AAData, actpos + y*f\width + x, percent
		Next
		Next
		UnlockBuffer
		Color 0,0,0
		Rect 0,0,iw,ih
		Color 0,0,255
	Next
	
	FreeImage AAS
	

	SetBuffer gbuf
	
	Return Handle(f)
	
End Function

Function AAStringWidth(s$)
	f.AAfont = First AAFont
	For i = 1 To Len(s)
		If (Asc(Mid(s,i,1)) >= f\start) And (Asc(Mid(s,i,1)) <= f\ende) Then
			w = w + f\widths[Asc(Mid(s,i,1))-f\start]
		End If
	Next
End Function
Function AAStringHeight(s$)
	f.AAFont = First AAFont
	Return f\height
End Function

Function AAFontWidth()
	f.AAFont = First AAFont
	Return f\width
End Function
Function AAFontHeight()
	f.AAFont = First AAFont
	Return f\height
End Function

Function FreeAAFont(fnt)
	f.AAFont = Object.AAFont(fnt)
	FreeBank f\AAData
	Delete f
End Function

Function SetAAFont(fnt)
	f.AAFont = Object.AAFont(fnt)
	Insert f Before First AAFont
End Function

Function AAText(tx,ty,txt$,cx=False,cy=False)
	f.AAfont = First AAfont
	
	If cy Then
		ty = ty - f\height*0.5
	End If
	If cx Then
		For i = 1 To Len(txt)
			If (Asc(Mid(txt,i,1)) >= f\start) And (Asc(Mid(txt,i,1)) <= f\ende) Then
				w = w + f\widths[Asc(Mid(txt,i,1))-f\start]
			End If
		Next
		DebugLog w
		tx = tx - w*0.5
	End If
	
	chh = f\height
	cr = ColorRed()
	cg = ColorGreen()
	cb = ColorBlue()
	clr = cr*$10000 + cg*$100 + cb
	gw = GraphicsWidth() : gh = GraphicsHeight()
	
	LockBuffer
	
	For i = 1 To Len(txt)
		If (Asc(Mid(txt,i,1)) >= f\start) And (Asc(Mid(txt,i,1)) <= f\ende) Then
			chw = f\widths[ch]
			pos = ch * f\width * f\height
			For y = 0 To chh-1
			For x = 0 To chw+1 ; Warum +1? Ich kapiers nicht, aber es scheint so zu stimmen
				If ((tx+x) < gw) And ((tx+x)>=0) And ((ty+y)<gh) And ((ty+y)>=0) Then
					
					perc = PeekByte(f\AAData,(Asc(Mid(txt,i))-f\start)*f\width*f\height + y*f\width + x)
					
					If perc = 255 Then
						WritePixelFast tx+x,ty+y,clr
					ElseIf perc <> 0 Then
						src = ReadPixelFast(tx+x,ty+y)
						
						RB1=src And $FF00FF : RB2=clr And $FF00FF
						G1=src And $FF00 : G2=clr And $FF00
						
						RB=(((perc*(RB2-RB1))Shr 8)+RB1) And $FF00FF
						G=(((perc*(G2-G1))Shr 8)+G1) And $FF00
						
						dest = (RB Or G)
						
						WritePixelFast tx+x,ty+y,dest
					End If
				End If
			
				pos = pos + 1	
			Next
			Next
			tx = tx + f\widths[Asc(Mid(txt,i,1))-f\start]
		End If
	Next
	
	
	UnlockBuffer
	
End Function

; DEMO
Graphics 640,480

fnt = createaafont("Tahoma",40,True)

Print "Berechnung fertig"
WaitKey
Cls

SetAAFont fnt

Color 255,255,255

AAText 20,20,"Text"

WaitKey