Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Dazugehörige MyGrafik.bi
| Uploader: |  MB Interactive Labs |
| Datum/Zeit: | 06.06.2010 18:00:35 |
'Spritengie um grafiken für Figuren und Landschaften anzeigen zu lassen.
'Copyright by MB Interactive Labs.
#Include "fbgfx.bi"
FUNCTION min(i AS INTEGER, j AS INTEGER) AS INTEGER
IF (i<j) THEN min=i ELSE min=j
END FUNCTION
'-----------------------------------------------------
FUNCTION max(i AS INTEGER, j AS INTEGER) AS INTEGER
IF (i>j) THEN max=i ELSE max=j
END Function
'n paar Variablen
CONST NAN=-999999
CONST xscreensize=800
CONST yscreensize=600
CONST FALSE=0
CONST TRUE=-1
CONST pi=22/7
'Type von ein Sprite definieren.
TYPE tsprite
img AS ANY PTR
bg AS ANY PTR
x AS INTEGER
y AS INTEGER
xsize AS INTEGER
ysize As INTEGER
x1bg AS INTEGER
y1bg AS INTEGER
x2bg AS INTEGER
y2bg AS INTEGER
NAME0 AS STRING*80
bgsaved AS INTEGER
END Type
'Type für BMP laden und anzeigen
Type tBMP
img AS ANY PTR
bg AS ANY Ptr
x AS INTEGER
y AS INTEGER
xsize AS INTEGER
ysize As INTEGER
x1bg AS INTEGER
y1bg AS INTEGER
x2bg AS INTEGER
y2bg AS INTEGER
NAME0 AS STRING*80
bgsaved AS INTEGER
End Type
'Spritegrafikbefehle
Declare SUB Init_Sprite(sprite AS tsprite)
Declare SUB Load_Sprite(sprite AS tsprite, fname AS STRING)
Declare SUB Save_get_bg(sprite AS tsprite)
Declare SUB Move_Sprite(sprite AS tsprite, xnew AS INTEGER, ynew AS INTEGER)
Declare SUB Close_Sprite(sprite AS tsprite)
'funktionen für BMP mit und ohne Transfarbe
Declare Sub Init_BMP(mybmp As tBMP)
Declare Sub Load_BMP(mybmp As tBMP, sName As String)
Declare Sub Save_BMP(sName As String, iX As Integer, iY As Integer) 'Screenshotfunktion
Declare Sub View_BMP(mybmp As tBMP)
Declare Sub View_BMP_Trans(mybmp As tBMP, iTrans As Integer)
Declare Sub Close_BMP(mybmp As tBMP) 'Bild löschen
Sub Init_Sprite(sprite As tsprite)
sprite.img=0
sprite.bg=0
'Koordinaten sollten auf NAN stehen, wenn das Sprite gerade nicht
'gesetzt ist.
sprite.x=NAN:sprite.y=NAN
sprite.xsize=0:sprite.ysize=0
sprite.x1bg=NAN:sprite.x2bg=NAN:sprite.y1bg=NAN:sprite.y2BG=NAN
sprite.bgsaved=NAN
End Sub
SUB Load_Sprite(sprite AS tsprite, fname AS STRING)
CONST bmpheadsize=54
CONST pos_xsize=&H12
CONST pos_ysize=&H16
DIM s AS STRING
'Pruefe, ob der Dateiname die Endung ".bmp" hat.
DIM s1 AS STRING=RIGHT$(fname,4)
IF (s1<>".bmp") THEN
PRINT("Error in loadsprite(): suffix of fname must be .bmp")
SLEEP
END
END IF
'Lies vorab den Header des bmp-Files ein, um die
'x- und y-Groesse festzustellen.
OPEN fname FOR BINARY AS #1
'Header lesen
s=INPUT$(bmpheadsize,1)
IF (LEN(s)=0) THEN
PRINT "Error in loadsprite(): File not found: ";fname
SLEEP
END
END IF
'Lies x- und y-Breite aus
sprite.xsize=ASC(mid$(s,pos_xsize+1,1))+ASC(mid$(s,pos_xsize+2,1))*256
sprite.ysize=ASC(mid$(s,pos_ysize+1,1))+ASC(mid$(s,pos_ysize+2,1))*256
CLOSE #1
'Lies hier die eigentlichen Daten in einen zuvor reservierten
'Speicherbereich ein
sprite.img = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
sprite.bg = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
BLOAD fname,sprite.img
sprite.NAME0=fname
END SUB
SUB Save_get_bg(sprite AS tsprite)
'Speichere den Background so, dass das Sprite sich auch teilweise
'ausserhalb des Screens befinden kann.
'Dazu muss an GET der Ausschnitt weitergegeben werden, der
'sich noch im Screen befindet.
DIM x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER
DIM visible AS INTEGER
'Stelle zunaechst den Ausschnitt des Sprites fest, der sich innerhalb
'des Bildschirms befindet.
x1=min(max(sprite.x,0),xscreensize-1)
y1=min(max(sprite.y,0),yscreensize-1)
x2=min(max(sprite.x+sprite.xsize-1,0),xscreensize-1)
y2=min(max(sprite.y+sprite.ysize-1,0),yscreensize-1)
'Befindet sich das Sprite komplett ausserhalb des Screens?
visible=(sprite.x+sprite.xsize-1>=0 AND sprite.y+sprite.ysize-1>=0)
visible=visible AND (sprite.x<=xscreensize-1) AND (sprite.y<=yscreensize-1)
'Speichere nun ab
IF (NOT visible) THEN
sprite.bgsaved=0 'Zeigt an, ob ein Hintergrund gespeichert ist
ELSE
GET (x1,y1)-(x2,y2),sprite.bg
sprite.bgsaved=1
END IF
sprite.x1bg=x1:sprite.x2BG=x2:sprite.y1bg=y1:sprite.y2bg=y2
END Sub
SUB Move_Sprite(sprite AS tsprite, xnew AS INTEGER, ynew AS INTEGER)
'Bewegt das Sprite zur Position xnew/ynew
'xnew und ynew werden ggf. so korrigiert, dass das ganze Sprite
'auf den Bildschirm passt.
'Ist das Sprite an einer alten Stelle?
IF (sprite.x<>NAN) THEN
'Ist ein Background bzgl. der alten Position gespeichert?
IF (sprite.bg>0 AND sprite.bgsaved=1) THEN
'Restauriere Background
PUT (sprite.x1bg,sprite.y1bg),sprite.bg,PSET
ELSE
'Sprite befindet sich komplett ausserhalb des Screens
END IF
END IF
'Speichere Hintergrund ab
sprite.x=xnew:sprite.y=ynew
Save_get_bg(sprite)
'Setze Sprite an neuer Stelle
PUT (sprite.x,sprite.y),sprite.img,TRANS
End Sub
SUB Close_Sprite(sprite AS tsprite)
IMAGEDESTROY sprite.img
IF (sprite.bg>0) THEN IMAGEDESTROY sprite.bg
END Sub
'**************************************************************************************
'**************************************************************************************
Sub Init_BMP(mybmp As tBMP)
mybmp.img=0
mybmp.bg=0
'Koordinaten sollten auf NAN stehen, wenn das Sprite gerade nicht
'gesetzt ist.
mybmp.x=NAN:mybmp.y=NAN
mybmp.xsize=0:mybmp.ysize=0
mybmp.x1bg=NAN:mybmp.x2bg=NAN:mybmp.y1bg=NAN:mybmp.y2BG=NAN
mybmp.bgsaved=NAN
End Sub
Sub Load_BMP(mybmp As tBMP, sName As String)
Const bmpheadsize=54
Const pos_xsize=&H12
Const pos_ysize=&H16
Dim s AS String
'Pruefe, ob der Dateiname die Endung ".bmp" hat.
Dim s1 AS STRING=RIGHT$(sName,4)
If (s1<>".bmp") THEN
Print("Error in loadsprite(): suffix of fname must be .bmp")
Sleep
End
End IF
'Lies vorab den Header des bmp-Files ein, um die
'x- und y-Groesse festzustellen.
Open sName FOR BINARY AS #1
'Header lesen
s=INPUT$(bmpheadsize,1)
If (LEN(s)=0) THEN
Print "Error in loadsprite(): File not found: ";sName
Sleep
End
End IF
'Lies x- und y-Breite aus
mybmp.xsize=ASC(mid$(s,pos_xsize+1,1))+ASC(mid$(s,pos_xsize+2,1))*256
mybmp.ysize=ASC(mid$(s,pos_ysize+1,1))+ASC(mid$(s,pos_ysize+2,1))*256
Close #1
'Lies hier die eigentlichen Daten in einen zuvor reservierten
'Speicherbereich ein
mybmp.img = IMAGECREATE(mybmp.xsize+10, mybmp.ysize+10)
mybmp.bg = IMAGECREATE(mybmp.xsize+10, mybmp.ysize+10)
BLoad sName,mybmp.img
mybmp.NAME0=sName
End Sub
Sub View_BMP(mybmp As tBMP)
'Anzeigen der Datei auf dem bildschirm
Put (mybmp.x,mybmp.y),mybmp.img,PSet
End Sub
Sub View_BMP_Trans(mybmp As tBMP, iTrans As Integer)
'Anzeigen der Datei auf dem bildschirm als Trans
Put (mybmp.x,mybmp.y),mybmp.img,Alpha,iTrans
End Sub
Sub Close_BMP(mybmp As tBMP)
ImageDestroy mybmp.img
If (mybmp.bg>0) THEN IMAGEDESTROY mybmp.bg
End Sub