Koodin toteutus objekteilla:
Code: Select all
b = LoadAnimObject("fnt.png",10,10,0,256) 'Font must have 256 frames
bitFont("osta_uusi_auto",b,-200,0)
DrawScreen : WaitKey : End
//
// This function will convert the characters of the string to
// objects, NOTE: use '_' for linebreaks...
//
Function bitFont(txt$,fnt,pX,pY)
Dim sz(Len(txt)) 'Array for text
fnd = 0 : wrd = 0 'processing words
wdt = ObjectSizeX(fnt) 'Get font width
hgt = ObjectSizeY(fnt) 'Get font height
//Start creating text
For i = 0 To Len(txt)
//Handle letters and breaks:
curC = Asc(Mid(txt,(i+1),1)) 'Get current char
If curC = Asc("_") Then 'Make a line break
fnd+1 : wrd = -1 'New position
EndIf : wrd+1
//Position text:
cY = pY-(fnd*hgt) 'Count X
cX = pX+(wrd*wdt) 'Count Y
//Make objects as we go
If curC <> Asc("_") Then
sz(i) = MakeObject() : sz(i) = CloneObject(fnt) 'Clone font
PlayObject sz(i),curC-1,curC-1 'Set correct graphic
PositionObject sz(i),cX,cY 'Position letter
ShowObject sz(i),ON 'Show letter
EndIf
Next i
EndFunction
Code: Select all
b = LoadAnimImage("fnt.png",10,10,0,256)
Repeat
bitFont("osta_uusi_auto",b,0,20)
DrawScreen : Until(EscapeKey()) : End
Function bitFont(txt$,fnt,pX,pY)
lne = 0 : wrd = 0 'processing words
wdt = ImageWidth(fnt)
hgt = ImageHeight(fnt)
Dim c(Len(txt),2)
//Start creating text
For t = 0 To Len(txt)-1 'Without -1 DrawImage breaks
//Handle letters and breaks:
curC = Asc(Mid(txt,(t+1),1)) 'Get current char
If curC = Asc("_") Then 'Make a line break
lne+1 : wrd = -1 'Set new position
EndIf : wrd+1
//Position text:
c(t,0)= pY+(lne*hgt) 'Set image X
c(t,1)= pX+(wrd*wdt) 'Set image Y
c(t,2)= curC-1 'Set Image frame
Next t
//Draw images (values in array to show all letters):
For d = 0 To Len(txt)-1 'Without -1 DrawImage breaks
If c(d,2)<>(Asc("_")-1) Then DrawImage fnt,c(d,0),c(d,1),Abs(c(d,2)) 'Show no linebreaks
Next d
EndFunction
EDIT: Muutin kuvaversion käyttämään vain yhtä arrayta.