fb:porticula NoPaste
fonts
Uploader: | max06 |
Datum/Zeit: | 23.03.2008 13:42:03 |
DIM AS INTEGER Timer1, FPS,FCount 'Definitionen der Variablen
Dim As Byte Ptr splashimage1
Type font As Any ptr
Function loadfont(f As String) As font
Dim As Any Ptr temp
Dim As Integer bx, by
Dim As Short bb
Open f For Binary As #1
Get #1, , bb
If bb <> 19778 Then
Open cons For Output As #2
? #2, "invalid bmp file"
Sleep
Else
Get #1, 19, bx:
Get #1, , by
Close
temp = imagecreate(bx,by)
Bload(f,temp)
End If
Return temp
End Function
Function drawfont(x As Integer,y As Integer,t As String,f As font,c As Integer,c2 As Integer) As Byte
Dim As font temp
temp = f
For cy As Integer = 1 To cptr(Uinteger Ptr,temp)[3]
For cx As Integer = 0 To cptr(Uinteger Ptr,temp)[2]
If Point(cx,cy,f) <> &hff00ff Then
Pset temp,(cx,cy),c
Else
Pset temp,(cx,cy),c2
End If
Next
Next
Draw String (x,y),t,,temp
Return 0
End Function
Dim As font comic
comic = loadfont("arial1.bmp")
timer1=TIMER+1 'Start-TIMER festlegen
ScreenRes 480, 272, 32, 2, &H10
splashimage1=ImageCreate(480, 272)
BLoad("Inc\splash1.bmp", splashimage1)
Color(RGB(0,0,0),RGB(255,255,255))
Do while InKey<>Chr(27)
ScreenLock
Cls
FCount +=1 'Frames zählen
IF TIMER >= timer1 THEN 'Wenn 1 Sekunde vergangen ist
FPS=Fcount 'werden die Zählvorgänge gespeichert
FCount=0 'der Zähler zurückgesetzt
Timer1=TIMER+1 'und der TIMER neu gesetzt
EndIf
Put (0,0), splashimage1, pset
Print "Hallo"
print "FPS :";FPS
drawfont(10,10,"Hello World!",comic,&h850000,&h8500)
ScreenUnLock
Sleep 1
Loop