version 6.50 2 Form2 FormHighScore Form1 238 268 2 Door.dll HardwareDesktop.dll 2 Hardware.dll Door.dll 2 hk:HardKeys ofrm:Object 0 Sub designer addform(Form2,"Tile Creator","",220,220,220)@ addform(FormHighScore,"","",220,220,220)@ addform(Form1,"Form1","",220,220,220)@ addlabel(form1,LabelHighScore,80,245,80,25,"0",0,0,0,255,255,0,True,True,15)@ addbutton(form1,ButtonReset,160,240,80,30,"Reset",128,0,255,255,255,255,False,False,11)@ addbutton(form1,ButtonDrop,80,240,80,30,"Drop",64,0,128,255,255,255,True,False,11)@ addbutton(form1,ButtonRight,160,205,80,35,"->",64,0,128,255,255,255,False,False,11)@ addbutton(form1,ButtonLeft,0,205,80,35,"<-",64,0,128,255,255,255,False,False,11)@ addtimer(form1,Timer1,100,185,1000)@ addbutton(form1,ButtonRotate,80,205,80,35,"Rotate",128,0,255,255,255,255,False,False,11)@ addbutton(form1,ButtonTileCreator,0,240,80,30,"Creator",128,0,255,255,255,255,False,False,11)@ End Sub @EndOfDesignText@ Sub Globals 'RobTris - 1.0 'Tetris-Clone - Nov.2008 By Token Highscore = 0 GridSize = 20 PrimitiveSize = 20 MaxX = 239 MaxY = 319 GameFieldMaxX = 11 GameFieldMaxY = 12 FigureNumberOfElements = 0 NumberOfTiles = 5 MaxTileSize = 5 BackGroundColor = cBlack TileColor = cGreen TilePosX = 5 TilePosY = 0 GameSpeed = 0 DefaultGameSpeed = 750 GameOver = False Dim Tile(NumberOfTiles,MaxTileSize,MaxTileSize) Dim ActiveTile(MaxTileSize,MaxTileSize) Dim GameField(20,20) Dim TileTemp(MaxTileSize,MaxTileSize) Dim TileColors(20) End Sub Sub App_Start hk.new1("form1",True,True,True) GameSpeed = DefaultGameSpeed Timer1.Enabled = True Form1.Color = BackGroundColor Form1.Show ofrm.New1(False) ofrm.FromControl("Form1") ofrm.SetProperty("KeyPreview",True) form1.Focus MakeTileCreatorButtons DefineTiles InitTileColors MakeTileActive(Rnd(0,NumberOfTiles)) InitGameField DrawGameField TilePosX = Rnd(0,GameFieldMaxX-4) TilePosY = 0 DrawTile(TilePosX,TilePosY,False) Form1.Focus End Sub Sub InitGamefield For x = 0 To GameFieldMaxX For y = 0 To GameFieldMaxY GameField(x,y) = 0 Next y Next x End Sub Sub DrawGrid(Size) For x = 0 To MaxX Step Size form1.Line(x,0,x+1,MaxY,cBlack) Next x For y = 0 To MaxY Step Size form1.Line(0,y,MaxX,y+1,cBlack) Next y End Sub Sub DrawPrimitive(x,y,PrimitiveColor) xOffset = 0 : yOffset = 0 x = x * GridSize - GridSize : y = y * GridSize - GridSize If PrimitiveColor <> BackGroundColor Then xOffset = 1 : yOffset = 1 End If form1.Line(x+xOffset,y+yOffset,x + GridSize-xOffset,y + GridSize-yOffset,PrimitiveColor,BF) End Sub Sub MakeTileCreatorButtons i = 0 For x = 25 To 175 Step 35 For y = 10 To 150 Step 35 i = i + 1 AddButton("Form2","Button"&i,x,y,35,35,"") AddEvent("Button"&i,click,"TileCreatorButtonClick") Next y Next x End Sub Sub ButtonTileCreator_Click form2.Show End Sub Sub TileCreatorButtonClick If Control(Sender.name,Button).color = cWhite Then Control(Sender.name,Button).color = cRed Else Control(Sender.name,Button).color = cWhite End If End Sub Sub DefineTiles ' Die einzelnen Tetris-Figuren werden deklariert ' ' ' **** ' ' i = 0 Tile(i,0,0) = 0 : Tile(i,1,0) = 0 : Tile(i,2,0) = 0 : Tile(i,3,0) = 0 : Tile(i,4,0) = 0 Tile(i,0,1) = 0 : Tile(i,1,1) = 0 : Tile(i,2,1) = 0 : Tile(i,3,1) = 0 : Tile(i,4,1) = 0 Tile(i,0,2) = 0 : Tile(i,1,2) = 1 : Tile(i,2,2) = 2 : Tile(i,3,2) = 4 : Tile(i,4,2) = 6 Tile(i,0,3) = 0 : Tile(i,1,3) = 0 : Tile(i,2,3) = 0 : Tile(i,3,3) = 0 : Tile(i,4,3) = 0 Tile(i,0,4) = 0 : Tile(i,1,4) = 0 : Tile(i,2,4) = 0 : Tile(i,3,4) = 0 : Tile(i,4,4) = 0 ' ' * ' *** ' ' i = 1 Tile(i,0,0) = 0 : Tile(i,1,0) = 0 : Tile(i,2,0) = 0 : Tile(i,3,0) = 0 : Tile(i,4,0) = 0 Tile(i,0,1) = 0 : Tile(i,1,1) = 0 : Tile(i,2,1) = 7 : Tile(i,3,1) = 0 : Tile(i,4,1) = 0 Tile(i,0,2) = 0 : Tile(i,1,2) = 11 : Tile(i,2,2) = 9 : Tile(i,3,2) = 3 : Tile(i,4,2) = 0 Tile(i,0,3) = 0 : Tile(i,1,3) = 0 : Tile(i,2,3) = 0 : Tile(i,3,3) = 0 : Tile(i,4,3) = 0 Tile(i,0,4) = 0 : Tile(i,1,4) = 0 : Tile(i,2,4) = 0 : Tile(i,3,4) = 0 : Tile(i,4,4) = 0 ' ' * ' *** ' ' i = 2 Tile(i,0,0) = 0 : Tile(i,1,0) = 0 : Tile(i,2,0) = 0 : Tile(i,3,0) = 0 : Tile(i,4,0) = 0 Tile(i,0,1) = 0 : Tile(i,1,1) = 0 : Tile(i,2,1) = 0 : Tile(i,3,1) = 9 : Tile(i,4,1) = 0 Tile(i,0,2) = 0 : Tile(i,1,2) = 4 : Tile(i,2,2) = 13 : Tile(i,3,2) = 3 : Tile(i,4,2) = 0 Tile(i,0,3) = 0 : Tile(i,1,3) = 0 : Tile(i,2,3) = 0 : Tile(i,3,3) = 0 : Tile(i,4,3) = 0 Tile(i,0,4) = 0 : Tile(i,1,4) = 0 : Tile(i,2,4) = 0 : Tile(i,3,4) = 0 : Tile(i,4,4) = 0 ' ' ** ' ** ' ' i = 3 Tile(i,0,0) = 0 : Tile(i,1,0) = 0 : Tile(i,2,0) = 0 : Tile(i,3,0) = 0 : Tile(i,4,0) = 0 Tile(i,0,1) = 0 : Tile(i,1,1) = 0 : Tile(i,2,1) = 1 : Tile(i,3,1) = 8 : Tile(i,4,1) = 0 Tile(i,0,2) = 0 : Tile(i,1,2) = 12 : Tile(i,2,2) = 3 : Tile(i,3,2) = 0 : Tile(i,4,2) = 0 Tile(i,0,3) = 0 : Tile(i,1,3) = 0 : Tile(i,2,3) = 0 : Tile(i,3,3) = 0 : Tile(i,4,3) = 0 Tile(i,0,4) = 0 : Tile(i,1,4) = 0 : Tile(i,2,4) = 0 : Tile(i,3,4) = 0 : Tile(i,4,4) = 0 ' ' ** ' ** ' ' i = 4 Tile(i,0,0) = 0 : Tile(i,1,0) = 0 : Tile(i,2,0) = 0 : Tile(i,3,0) = 0 : Tile(i,4,0) = 0 Tile(i,0,1) = 0 : Tile(i,1,1) = 5 : Tile(i,2,1) = 14 : Tile(i,3,1) = 0 : Tile(i,4,1) = 0 Tile(i,0,2) = 0 : Tile(i,1,2) = 9 : Tile(i,2,2) = 10 : Tile(i,3,2) = 0 : Tile(i,4,2) = 0 Tile(i,0,3) = 0 : Tile(i,1,3) = 0 : Tile(i,2,3) = 0 : Tile(i,3,3) = 0 : Tile(i,4,3) = 0 Tile(i,0,4) = 0 : Tile(i,1,4) = 0 : Tile(i,2,4) = 0 : Tile(i,3,4) = 0 : Tile(i,4,4) = 0 End Sub Sub DrawTile(xStart,yStart,Erase) PrimitiveCount = 0 For x = xStart To xStart + (MaxTileSize - 1) For y = yStart To yStart + (MaxTileSize - 1) If ActiveTile(x-xStart,y-yStart) <> 0 Then If Not(Erase) Then DrawPrimitive(x,y,TileColors(ActiveTile(x-xStart,y-yStart))) Else DrawPrimitive(x,y,BackGroundColor) End If End If PrimitiveCount = PrimitiveCount + 1 Next y Next x End Sub Sub MakeTileActive(TileNumber) For x = 0 To MaxTileSize - 1 For y = 0 To MaxTileSize - 1 ActiveTile(x,y) = Tile(TileNumber,x,y) Next y Next x End Sub Sub RotateTile CollisionFlag = False For x = 0 To MaxTileSize - 1 For y = 0 To MaxTileSize - 1 TileTemp(x,y) = ActiveTile(x,y) Next y Next x For i = 1 To 4 t = ActiveTile(0,0) ActiveTile(0,0) = ActiveTile(1,0) ActiveTile(1,0) = ActiveTile(2,0) ActiveTile(2,0) = ActiveTile(3,0) ActiveTile(3,0) = ActiveTile(4,0) ActiveTile(4,0) = ActiveTile(4,1) ActiveTile(4,1) = ActiveTile(4,2) ActiveTile(4,2) = Activetile(4,3) ActiveTile(4,3) = ActiveTile(4,4) ActiveTile(4,4) = ActiveTile(3,4) ActiveTile(3,4) = ActiveTile(2,4) ActiveTile(2,4) = ActiveTile(1,4) ActiveTile(1,4) = ActiveTile(0,4) ActiveTile(0,4) = ActiveTile(0,3) ActiveTile(0,3) = ActiveTile(0,2) ActiveTile(0,2) = ActiveTile(0,1) ActiveTile(0,1) = t Next i For i = 1 To 2 t = ActiveTile(1,1) ActiveTile(1,1) = ActiveTile(2,1) ActiveTile(2,1) = ActiveTile(3,1) ActiveTile(3,1) = ActiveTile(3,2) ActiveTile(3,2) = ActiveTile(3,3) ActiveTile(3,3) = ActiveTile(2,3) ActiveTile(2,3) = ActiveTile(1,3) ActiveTile(1,3) = ActiveTile(1,2) ActiveTile(1,2) = t Next i For x = TilePosX To TilePosX + (MaxTileSize - 1) For y = TilePosY To TilePosY + (MaxTileSize - 1) If GameField(x,y) <> 0 AND ActiveTile(x-TilePosX,y-TilePosy) <> 0 Then CollisionFlag = True End If t = ActiveTile(x-TilePosX,y-TilePosY) Next y Next x If CollisionFlag Then For x = 0 To MaxTileSize - 1 For y = 0 To MaxTileSize - 1 ActiveTile(x,y) = TileTemp(x,y) Next y Next x End If End Sub Sub ButtonRotate_Click DrawTile(TilePosX,TilePosY,True) RotateTile DrawTile(TilePosX,TilePosY,False) End Sub Sub DrawGameField For x = 0 To GameFieldMaxX For y = 0 To GameFieldMaxY If GameField(x,y) <> 0 Then DrawPrimitive(x,y,TileColors(GameField(x,y))) Else DrawPrimitive(x,y,BackGroundColor) End If Next y Next x End Sub Sub Timer1_Tick f = False CollisionFlag = False For x = TilePosX To TilePosX + (MaxTileSize - 1) For y = TilePosY To TilePosY + (MaxTileSize - 1) If y < GameFieldMaxY AND x > 0 Then If GameField(x,y+1) <> 0 AND ActiveTile(x-TilePosX,y-TilePosy) <> 0 Then CollisionFlag = True End If End If If y = GameFieldMaxY AND ActiveTile(x-TilePosX,y-TilePosY) <> 0 Then CollisionFlag = True End If Next y Next x If Not(CollisionFlag) Then DrawTile(TilePosX,TilePosY,True) TilePosY = TilePosY + 1 DrawTile(TilePosX,TilePosY,False) End If DrawGameField DrawTile(TilePosX,TilePosY,False) If CollisionFlag Then TileNumberOfElements = 0 For x = TilePosX To TilePosX + (MaxTileSize-1) For y = TilePosY To TilePosY + (MaxTileSize-1) If ActiveTile(x-TilePosX,y-TilePosY) <> 0 Then TileNumberOfElements = TileNumberOfElements + 1 GameField(x,y) = ActiveTile(x-TilePosX,y-TilePosY) If y < 2 AND Not(GameOver) Then GameOver = True timer1.Enabled = False r = Msgbox("Play again?","Game over",cMsgboxYesNo,cMsgboxHand) If r = cYes Then f = True GameOver = False Else AppClose End If End If End If Next y Next x TilePosX = Rnd(0,GameFieldMaxX-2) TilePosY = 0 MakeTileActive(Rnd(0,5)) DrawTile(TilePosX,TilePosY,False) DrawGameField Timer1.Interval = GameSpeed FindCompleteLine HighScore = HighScore + TileNumberOfElements * 10 LabelHighScore.Text = HighScore End If If f Then ButtonReset_Click End If End Sub Sub ButtonLeft_Click CollisionFlag = False For x = TilePosX To TilePosX + (MaxTileSize -1 ) For y = TilePosY To TilePosY + (MaxTileSize - 1) If x = 1 AND ActiveTile(x-TilePosX,y-TilePosY) <> 0 Then CollisionFlag = True Else If x > 1 Then If GameField(x-1,y) <> 0 AND ActiveTile(x-TilePosX,y-TilePosY) <> 0 Then CollisionFlag = True End If End If Next y Next x If Not(CollisionFlag) Then DrawTile(TilePosX,TilePosY,True) TilePosX = TilePosX - 1 DrawTile(TilePosX,TilePosY,False) End If End Sub Sub ButtonRight_Click CollisionFlag = False For x = TilePosX To TilePosX + (MaxTileSize - 1) For y = TilePosY To TilePosY + (MaxTileSize - 1) If x = GameFieldMaxX AND ActiveTile(x-TilePosX,y-TilePosY) <> 0 Then CollisionFlag = True Else If x < GameFieldMaxX Then If GameField(x+1,y) <> 0 AND ActiveTile(x-TilePosX,y-TilePosY) <> 0 Then CollisionFlag = True End If End If Next y Next x If Not(CollisionFlag) Then DrawTile(TilePosX,TilePosY,True) TilePosX = TilePosX + 1 DrawTile(TilePosX,TilePosY,False) End If End Sub Sub ButtonDrop_Click Timer1.Interval = 100 End Sub Sub FindCompleteLine For y = 0 To GameFieldMaxY TileCounter = 0 For x = 0 To GameFieldMaxX If GameField(x,y) <> 0 Then TileCounter = TileCounter + 1 End If Next x If TileCounter = GameFieldMaxX Then RemoveLine(y) HighScore = HighScore + 100 LabelHighScore.Text = HighScore End If Next y 'removeline(gamefieldmaxy) End Sub Sub RemoveLine(LineNumber) For y = LineNumber To 1 Step -1 For x = 0 To GameFieldMaxX GameField(x,y) = GameField(x,y-1) Next x Next y DrawGameField End Sub Sub ButtonReset_Click InitGameField MakeTileActive(Rnd(0,NumberOfTiles)) DrawGameField TilePosX = Rnd(0,GameFieldMaxX-4) TilePosY = 0 DrawTile(TilePosX,TilePosY,False) GameOver = False Timer1.Enabled = True End Sub Sub Form1_KeyPress (specialKey) If specialKey = cLeftKey Then ButtonLeft_Click End If If specialKey = cRightKey Then ButtonRight_Click End If If specialKey = cDownKey Then ButtonDrop_Click End If If specialKey = cUpKey Then ButtonRotate_Click End If End Sub Sub hk_HardKeyPressed Select hk.KeyPressed Case hk.KeyLeft ButtonLeft_Click Case hk.KeyRight ButtonRight_Click Case hk.KeyUp ButtonRotate_Click Case hk.KeyDown ButtonDrop_Click End Select End Sub Sub InitTileColors TileColors(0) = cBeige TileColors(1) = cBeige TileColors(2) = cBlue TileColors(3) = cBrown TileColors(4) = cCyan TileColors(5) = cGold TileColors(6) = cGreen TileColors(7) = cGray TileColors(8) = cOrange TileColors(9) = cPink TileColors(10) = cPurple TileColors(11) = cRed TileColors(12) = cSilver TileColors(13) = cWhite TileColors(14) = cYellow End Sub