More Graphics

[Deleted]

Hello Guilect,

can you these two routines into your Graphics system bring ?

as Graphics.SetAnimate()
Graphics.Animate()

Here are the two routines:

Sub SetAnimate(iHnd,rows,cols,num,width,height)
Graphics.SetRows iHnd,rows
Graphics.SetCols iHnd,cols
Graphics.SetTotalFrames iHnd,num
Graphics.SetFrameWidth iHnd,width
Graphics.SetFrameHeight iHnd,height
Graphics.SetAnimated iHnd, True
End Sub

Sub Animate(iHnd,frame,x,y)
Graphics.SetCurrentFrame iHnd,frame
Graphics.Setxy iHnd,x,y
Graphics.SetImage iHnd
End Sub

And here is an Layereditor that also contains the two routines.
Download the GFX from here:
www.zshare.net/download/122682999306d7bf/

'Listing:
Option Explicit
Public ax,bx,cx,dx,zx,Lev,MapF,Lay,Sav,Esc,zSm,vSm
Public Rast,Ras,iRas,Tile,Char,Magc,Face,Hase,Mess
Dim xMap1,xMap2,xMap3,xMap4,xMap5,xMap6
Dim Map1(300),Map2(300),Map3(300)
Dim Map4(300),Map5(300),Map6(300)

Sub Main()
Graphics.Initialize 640,480,False,16
Key.Initialize
Sound.Initialize
Mouse.Initialize
Rast = Graphics.LoadImage("Gfx/Raster.png")
iRas = Graphics.LoadImage("Gfx/ImageRas.png")
Hase = Graphics.LoadImage("Gfx/Hase.png")
Tile = Graphics.LoadImage("Gfx/Tiles.png"):SetAnimate Tile,15,16,240,16,16
Char = Graphics.LoadImage("Gfx/Chars.png"):SetAnimate char,1,43,43,16,16
Magc = Sound.LoadWav("Gfx/Pickup.wav")
Mouse.Show
For ax =0 To 299
Map1(ax) = Chr(0):Map2(ax) = Chr(0)
Map3(ax) = Chr(0):Map4(ax) = Chr(0)
Map5(ax) = Chr(0):Map6(ax) = Chr(0)
Next
Lev =1:MapF =1:zx =0
Lay =1:Ras =1:Mess =""
Call LoadMaps
Do
Graphics.Clear
Call MousePos
Call BuildingTiles
Call ImageRaster
Call SetTile
call BuildingMaps
Call MainRaster
Call GetTile
Call PickTile
Call ChooseLayer
Call Loading
Call Saveing
Call ClearMaps
Call Information
Call Creator
Call FillLayer
Call Message
Call GoHome
Graphics.Display
Graphics.SetFPS 60
Loop Until Esc =1 Or Key.Pressed(vk_WindowX)
Key.Terminate
Sound.Terminate
Graphics.Terminate
Mouse.Terminate
End Sub

Call Main

Sub SetAnimate(image,rows,cols,num,wide,high)
Graphics.SetRows image,rows
Graphics.SetCols image,cols
Graphics.SetTotalFrames image,num
Graphics.SetFrameWidth image,wide
Graphics.SetFrameHeight image,high
Graphics.SetAnimated image, True
End Sub

Sub Animate(image,frame,x,y)
Graphics.SetCurrentFrame image,frame
Graphics.Setxy image,x,y
Graphics.SetImage image
End Sub

Sub Text(txt,x1,y1)
Dim lx,sx,rx
lx = Len(txt)
For sx =1 To lx
rx = Asc(Mid(txt,sx,1))
iF rx >=48 And rx <=90 Then
rx = rx -48
Animate char,rx+1,x1,y1
x1 = x1 + 16
End iF
Next
End Sub

Sub MakeMaps()
For cx =0 To 14
For dx =0 To 19
bx = cx *20 + dx
Map1(bx) = Mid(xMap1,bx+1,1)
Map2(bx) = Mid(xMap2,bx+1,1)
Map3(bx) = Mid(xMap3,bx+1,1)
Map4(bx) = Mid(xMap4,bx+1,1)
Map5(bx) = Mid(xMap5,bx+1,1)
Next:Next
End Sub

Sub LoadMaps()
iF System.FileExists("Maps/Map" & Lev & "-1" & ".bin") = False Then Exit Sub
xMap1 = System.FileRead("Maps/Map" & Lev & "-1" & ".bin")
xMap2 = System.FileRead("Maps/Map" & Lev & "-2" & ".bin")
xMap3 = System.FileRead("Maps/Map" & Lev & "-3" & ".bin")
xMap4 = System.FileRead("Maps/Map" & Lev & "-4" & ".bin")
xMap5 = System.FileRead("Maps/Map" & Lev & "-5" & ".bin")
MakeMaps
End Sub

Sub SaveMaps()
xMap1 ="":xMap2 ="":xMap3 ="":xMap4 ="":xMap5 =""
For cx =0 To 14
For dx =0 To 19
bx = cx *20 + dx
xMap1 = xMap1 + Map1(bx)
xMap2 = xMap2 + Map2(bx)
xMap3 = xMap3 + Map3(bx)
xMap4 = xMap4 + Map4(bx)
xMap5 = xMap5 + Map5(bx)
Next:Next
System.FileWrite "Maps/Map" & Lev & "-1" & ".bin",xMap1
System.FileWrite "Maps/Map" & Lev & "-2" & ".bin",xMap2
System.FileWrite "Maps/Map" & Lev & "-3" & ".bin",xMap3
System.FileWrite "Maps/Map" & Lev & "-4" & ".bin",xMap4
System.FileWrite "Maps/Map" & Lev & "-5" & ".bin",xMap5
End Sub

Sub MousePos()
Text "xPOS@" & cStr(Int(Mouse.x /16)) & "@@ypos@" & cStr(Int(Mouse.y /16)),0,460
End Sub

MainRaster()
iF Ras =1 Then
Graphics.SetXY Rast,0,0
Graphics.SetImage Rast
End iF
iF Key.Pressed(vk_space) And Ras =1 Then
Ras =0
Elseif Key.Pressed(vk_r) And Ras =0 Then
Ras =1
End iF
End Sub

Sub ImageRaster()
Graphics.SetXY iRas,352,0
Graphics.SetImage iRas
Graphics.SetBox 0,0,319,239,&HFFFFFFFF
End Sub

Sub BuildingMaps()
For cx = 0 To 14
For dx = 0 To 19
bx = cx *20 + dx
iF Map1(bx) > Chr(0) Then
ax = Asc(Map1(bx))
Animate Tile,(ax+1),dx *16,cx *16
End iF
iF Map2(bx) > Chr(0) Then
ax = Asc(Map2(bx))
Animate Tile,ax+1,dx *16,cx *16
End iF
iF Map3(bx) > Chr(0) Then
ax = Asc(Map3(bx))
Animate Tile,ax+1,dx *16,cx *16
End iF
iF Map4(bx) > Chr(0) Then
ax = Asc(Map4(bx))
Animate Tile,ax+1,dx *16,cx *16
End iF
iF Map5(bx) > Chr(0) Then
ax = Asc(Map5(bx))
Animate Tile,ax+1,dx *16,cx *16
End iF
Next: Next
End Sub

Sub BuildingTiles()
For cx =0 To 14
For dx =0 To 15
bx = cx *16 + dx
Animate Tile,bx+1,dx*16 +352,cx *16
Next:Next
End Sub

Sub GetTile()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
iF Mouse.LeftButton And dx >=22 And dx <=37 And cx >=0 And cx <=14 Then
zx = (cx *16 + dx) -22
End iF
Animate Tile,zx+1,464,256
Text "TILE@" & cStr(zx),416,240
End Sub

Sub SetTile()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
bx = cx *20 + dx
iF Mouse.LeftButton And dx >=0 And dx <=19 And cx >=0 And cx <=14 Then
Animate Tile,zx+1,dx*16,cx*16
iF MapF =1 Then
Map1(bx) = Chr(zx):Sav =0
ElseiF MapF =2 Then
Map2(bx) = Chr(zx):Sav =0
ElseiF MapF =3 Then
Map3(bx) = Chr(zx):Sav =0
ElseiF MapF =4 Then
Map4(bx) = Chr(zx):Sav =0
ElseiF MapF =5 Then
Map5(bx) = Chr(zx):Sav =0
End iF
End iF
End Sub

Sub PickTile()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
bx = cx *20 + dx
iF Mouse.RightButton And dx >=0 And dx <=19 And cx >=0 And cx <=14 And MapF =1 Then
zx = Asc(Map1(bx))
ElseiF Mouse.RightButton And dx >=0 And dx <=19 And cx >=0 And cx <=14 And MapF =2 Then
zx = Asc(Map2(bx))
ElseiF Mouse.RightButton And dx >=0 And dx <=19 And cx >=0 And cx <=14 And MapF =3 Then
zx = Asc(Map3(bx))
ElseiF Mouse.RightButton And dx >=0 And dx <=19 And cx >=0 And cx <=14 And MapF =4 Then
zx = Asc(Map4(bx))
ElseiF Mouse.RightButton And dx >=0 And dx <=19 And cx >=0 And cx <=14 And MapF =5 Then
zx = Asc(Map5(bx))
End iF
End Sub

Sub ChooseLayer()
Text "LAYER@1;" & cStr(Lev),0,272
Text "LAYER@2;" & cStr(Lev),0,288
Text "LAYER@3;" & cStr(Lev),0,304
Text "LAYER@4;" & cStr(Lev),0,320
Text "LAYER@5;" & cStr(Lev),0,336
Text "RASTER ",0,368
iF MapF =1 Then
Text "ON",160,272
ElseiF MapF =2 Then
Text "ON",160,288
ElseiF MapF =3 Then
Text "ON",160,304
ElseiF MapF =4 Then
Text "ON",160,320
ElseiF MapF =5 Then
Text "ON",160,336
End iF
iF Ras =1 Then Text "ON ",112,368
iF Ras =0 Then Text "OFF",112,368
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
iF Mouse.LeftButton And dx >=0 And dx <=4 And cx =17 Then MapF =1
iF Mouse.LeftButton And dx >=0 And dx <=4 And cx =18 Then MapF =2
iF Mouse.LeftButton And dx >=0 And dx <=4 And cx =19 Then MapF =3
iF Mouse.LeftButton And dx >=0 And dx <=4 And cx =20 Then MapF =4
iF Mouse.LeftButton And dx >=0 And dx <=4 And cx =21 Then MapF =5
iF Mouse.LeftButton And dx >=0 And dx <=5 And cx =23 Then Ras =1
iF Mouse.RightButton And dx >=0 And dx <=5 And cx =23 Then Ras =0
End Sub

Sub Loading()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
Text "LOAD@@map@" & cStr(Lev),224,288
iF Mouse.LeftButton And dx >=14 And dx <=22 And cx =18 And Lev <100 Then
Lev = Lev +1
LoadMaps
System.Pause 200
End iF
iF Mouse.RightButton And dx >=14 And dx <=22 And cx =18 And Lev > 1 Then
Lev = Lev -1
LoadMaps:Sav =0
System.Pause 200
End iF
End Sub

Sub Saveing()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
Text "SAVE@@map@" & cStr(Lev),224,272
iF Mouse.LeftButton And dx >=14 And dx <=22 And cx =17 And Sav =0 Then
Text "OKAY",416,272
SaveMaps:Sav =1
System.Pause 200
End iF
End Sub

Sub ClearMaps()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
Text "CLEAR@MAP@" & cStr(Lev),224,320
Text "@okay",416,320
iF Mouse.LeftButton And dx >=27 And dx <=30 And cx =20 Then
For ax =0 To 299
Map1(ax) =chr(0)
Map2(ax) =chr(0)
Map3(ax) =Chr(0)
Map4(ax) =Chr(0)
Map5(ax) =Chr(0)
Next
End iF
End Sub

Sub GoHome()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
Text "EXIT@HERE",224,336
iF Mouse.LeftButton And dx >=14 And dx <=22 And cx =21 Then
iF Sav =0 Then
Mess = "YOUR@WORK@IS@NOT@SAVED>"
Exit Sub
End iF
Esc =1
End iF
End Sub

Sub Message()
iF Len(Mess) > 0 And Sav =0 Then
Text Mess,224,400
End iF
End Sub

Sub Information()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
Text "INFORMATI",224,352
iF Mouse.LeftButton And dx >=14 And dx <=22 And cx =22 Then
ax =0
For bx =0 To 299
iF MapF =1 And Map1(bx) = chr(zx) Then
ax = ax +1
ElseiF MapF =2 And Map2(bx) = chr(zx) Then
ax = ax +1
ElseiF MapF =3 And Map3(bx) = chr(zx) Then
ax = ax +1
ElseiF MapF =4 And Map4(bx) = chr(zx) Then
ax = ax +1
ElseiF MapF =5 And Map5(bx) = chr(zx) Then
ax = ax +1
End iF
Next
Animate Tile,zx+1,384,352
Text "@:@" & cStr(ax),400,352
End iF
End Sub

Sub Creator()
Text "P=@wirbelauer@@2008",320,464
Animate Hase,1,288,336
End Sub

Sub FillLayer()
cx = Int(Mouse.y) \16
dx = Int(Mouse.x) \16
Text "FILLLAYER@" & cStr(MapF),224,368
Text "OKAY",432,368
iF Mouse.LeftButton And dx >=27 And dx <=30 And cx =23 Then
For ax =0 To 299
iF MapF =1 And Map1(ax) = chr(0) Then Map1(ax) =chr(zx)
iF MapF =2 And Map2(ax) = chr(0) Then Map2(ax) =chr(zx)
iF MapF =3 And Map3(ax) = chr(0) Then Map3(ax) =chr(zx)
iF MapF =4 And Map4(ax) = chr(0) Then Map4(ax) =chr(zx)
iF MapF =5 And Map5(ax) = chr(0) Then Map5(ax) =chr(zx)
Next
End iF
End Sub


' Declaration:
' The file Tiles always has a size of 256x240
' Everything must lie in the folder GFX.
' The field is on the left and the Tiles are on the right.
' Click with the left mouse button on a Tile.
' Then click with the left mouse button to the field.
' One can peck a Tile from the field with the right mouse button.
' You can load a Map with the right or left mouse button.
' Click to this on Load Map.
' Storing goes just the same.
' Click with the left mouse button on layers for the choice.

' FillLayer:
' Clicking with the left mouse button on one "layer".
' Then click on FillLayer.

' best wishes
' Peter

[Guilect]

Nice tile map editor Peter.

I wish I had as much free time to program games as you appear to have.

Your requests have been noted.