Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
256
Task/Minesweeper-game/FreeBASIC/minesweeper-game.basic
Normal file
256
Task/Minesweeper-game/FreeBASIC/minesweeper-game.basic
Normal file
|
|
@ -0,0 +1,256 @@
|
|||
'--- Declaration of global variables ---
|
||||
Type mina
|
||||
Dim mina As Byte
|
||||
Dim flag As Byte
|
||||
Dim ok As Byte
|
||||
Dim numero As Byte
|
||||
End Type
|
||||
|
||||
Dim Shared As Integer size = 16, NX = 20, NY = 20
|
||||
Dim Shared As Double mina = 0.10
|
||||
|
||||
Dim Shared tablero(NX+1,NY+1) As mina
|
||||
Dim Shared As Integer GameOver, ddx, ddy, kolor, nbDESCANSO
|
||||
Dim Shared As Double temps
|
||||
Dim As String tecla
|
||||
|
||||
'--- SUBroutines and FUNCtions ---
|
||||
Sub VerTodo
|
||||
Dim As Integer x, y
|
||||
For x = 1 To NX
|
||||
For y = 1 To NY
|
||||
With tablero(x,y)
|
||||
If .mina = 1 Or .flag > 0 Then .ok = 1
|
||||
End With
|
||||
Next y
|
||||
Next x
|
||||
End Sub
|
||||
|
||||
Sub ShowGrid
|
||||
Dim As Integer x, y
|
||||
Line(ddx-1,ddy-1)-(1+ddx+size*NX,1+ddy+size*NY),&hFF0000,B
|
||||
For x = 1 To NX
|
||||
For y = 1 To NY
|
||||
With tablero(x,y)
|
||||
'Si la casilla no se hace click
|
||||
If .ok = 0 Then
|
||||
Line(ddx+x*size,ddy+y*size)-(ddx+(x-1)*size,ddy+(y-1)*size),&h888888,BF
|
||||
Line(ddx+x*size,ddy+y*size)-(ddx+(x-1)*size,ddy+(y-1)*size),&h444444,B
|
||||
'bandera verde
|
||||
If .flag = 1 Then
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h00FF00,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h0
|
||||
End If
|
||||
'bandera azul
|
||||
If .flag = 2 Then
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h0000FF,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h0
|
||||
End If
|
||||
'Si se hace clic
|
||||
Else
|
||||
If .mina = 0 Then
|
||||
If .numero > 0 Then
|
||||
Select Case .numero
|
||||
Case 1: kolor = &h3333FF
|
||||
Case 2: kolor = &h33FF33
|
||||
Case 3: kolor = &hFF3333
|
||||
Case 4: kolor = &hFFFF33
|
||||
Case 5: kolor = &h33FFFF
|
||||
Case 6: kolor = &hFF33FF
|
||||
Case 7: kolor = &h999999
|
||||
Case 8: kolor = &hFFFFFF
|
||||
End Select
|
||||
Draw String(ddx+x*size-size/1.5,ddy+y*size-size/1.5),Str(.numero),kolor
|
||||
End If
|
||||
If GameOver = 1 Then
|
||||
'Si no hay Mina y una bandera verde >> rojo completo
|
||||
If .flag = 1 Then
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h330000,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h555555
|
||||
End If
|
||||
'Si no hay Mina y una bandera azul >> azul oscuro
|
||||
If .flag = 2 Then
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h000033,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h555555
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
'Si hay una Mina sin bandera >> rojo
|
||||
If .flag = 0 Then
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&hFF0000,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&hFFFF00
|
||||
Else
|
||||
'Si hay una Mina con bandera verde >>> verde
|
||||
If .flag = 1 Then
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h00FF00,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&hFFFF00
|
||||
End If
|
||||
If .flag = 2 Then
|
||||
'Si hay una Mina con bandera azul >>>> verde oscuro
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&h003300,,,,F
|
||||
Circle (ddx+x*size-size/2,ddy+y*size-size/2),size/4,&hFFFF00
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
Next y
|
||||
Next x
|
||||
End Sub
|
||||
|
||||
Sub Calcul
|
||||
Dim As Integer x, y
|
||||
For x = 1 To NX
|
||||
For y = 1 To NY
|
||||
tablero(x,y).numero = _
|
||||
Iif(tablero(x+1,y).mina=1,1,0) + Iif(tablero(x-1,y).mina=1,1,0) + _
|
||||
Iif(tablero(x,y+1).mina=1,1,0) + Iif(tablero(x,y-1).mina=1,1,0) + _
|
||||
Iif(tablero(x+1,y-1).mina=1,1,0) + Iif(tablero(x+1,y+1).mina=1,1,0) + _
|
||||
Iif(tablero(x-1,y-1).mina=1,1,0) + Iif(tablero(x-1,y+1).mina=1,1,0)
|
||||
Next y
|
||||
Next x
|
||||
End Sub
|
||||
|
||||
Sub Inicio
|
||||
size = 20
|
||||
If NX > 720/size Then size = 720/NX
|
||||
If NY > 520/size Then size = 520/NY
|
||||
|
||||
Redim tablero(NX+1,NY+1) As mina
|
||||
Dim As Integer x, y
|
||||
For x = 1 To NX
|
||||
For y = 1 To NY
|
||||
With tablero(x,y)
|
||||
.mina = Iif(Rnd > (1-mina), 1, 0)
|
||||
.ok = 0
|
||||
.flag = 0
|
||||
.numero = 0
|
||||
End With
|
||||
Next y
|
||||
Next x
|
||||
ddx = (((800/size)-NX)/2)*size
|
||||
ddy = (((600/size)-NY)/2)*size
|
||||
Calcul
|
||||
End Sub
|
||||
|
||||
Function isGameOver As Integer
|
||||
Dim As Integer x, y, nbMINA, nbOK, nbAZUL, nbVERT
|
||||
For x = 1 To NX
|
||||
For y = 1 To NY
|
||||
If tablero(x,y).ok = 1 And tablero(X,y).mina = 1 Then
|
||||
Return -1
|
||||
End If
|
||||
If tablero(x,y).ok = 0 And tablero(x,y).flag = 1 And tablero(X,y).mina = 1 Then
|
||||
nbOK += 1
|
||||
End If
|
||||
If tablero(X,y).mina = 1 Then
|
||||
nbMINA + =1
|
||||
End If
|
||||
If tablero(X,y).flag = 2 Then
|
||||
nbAZUL += 1
|
||||
'End If
|
||||
Elseif tablero(X,y).flag = 1 Then
|
||||
nbVERT += 1
|
||||
End If
|
||||
Next y
|
||||
Next x
|
||||
|
||||
If nbMINA = nbOK And nbAZUL = 0 Then Return 1
|
||||
nbDESCANSO = nbMINA - nbVERT
|
||||
End Function
|
||||
|
||||
Sub ClicRecursivo(ZX As Integer, ZY As Integer)
|
||||
If tablero(ZX,ZY).ok = 1 Then Exit Sub
|
||||
If tablero(ZX,ZY).flag > 0 Then Exit Sub
|
||||
'CLICK
|
||||
tablero(ZX,ZY).ok = 1
|
||||
|
||||
If tablero(ZX,ZY).mina = 1 Then Exit Sub
|
||||
If tablero(ZX,ZY).numero > 0 Then Exit Sub
|
||||
|
||||
If ZX > 0 And ZX <= NX And ZY > 0 And ZY <= NY Then
|
||||
ClicRecursivo(ZX+1,ZY)
|
||||
ClicRecursivo(ZX-1,ZY)
|
||||
ClicRecursivo(ZX,ZY+1)
|
||||
ClicRecursivo(ZX,ZY-1)
|
||||
ClicRecursivo(ZX+1,ZY+1)
|
||||
ClicRecursivo(ZX+1,ZY-1)
|
||||
ClicRecursivo(ZX-1,ZY+1)
|
||||
ClicRecursivo(ZX-1,ZY-1)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
'--- Main Program ---
|
||||
Screenres 800,600,24
|
||||
Windowtitle"Minesweeper game"
|
||||
Randomize Timer
|
||||
Cls
|
||||
Dim As Integer mx, my, mb, fmb, ZX, ZY, r, tt
|
||||
Dim As Double t
|
||||
Inicio
|
||||
GameOver = 1
|
||||
Do
|
||||
tecla = Inkey
|
||||
If GameOver = 1 Then
|
||||
Select Case Ucase(tecla)
|
||||
Case Chr(Asc("X"))
|
||||
NX += 5
|
||||
If NX > 80 Then NX = 10
|
||||
Inicio
|
||||
Case Chr(Asc("Y"))
|
||||
NY += 5
|
||||
If NY > 60 Then NY = 10
|
||||
Inicio
|
||||
Case Chr(Asc("M"))
|
||||
mina += 0.01
|
||||
If mina > 0.26 Then mina = 0.05
|
||||
Inicio
|
||||
Case Chr(Asc("S"))
|
||||
Inicio
|
||||
GameOver = 0
|
||||
temps = Timer
|
||||
End Select
|
||||
End If
|
||||
|
||||
Getmouse mx,my,,mb
|
||||
mx -= ddx-size
|
||||
my -= ddy-size
|
||||
ZX = (MX-size/2)/size
|
||||
ZY = (MY-size/2)/size
|
||||
|
||||
If GameOver = 0 And zx > 0 And zx <= nx And zy > 0 And zy <= ny Then
|
||||
If MB=1 And fmb=0 Then ClicRecursivo(ZX,ZY)
|
||||
If MB=2 And fmb=0 Then
|
||||
tablero(ZX,ZY).flag += 1
|
||||
If tablero(ZX,ZY).flag > 2 Then tablero(ZX,ZY).flag = 0
|
||||
End If
|
||||
fmb = mb
|
||||
End If
|
||||
|
||||
r = isGameOver
|
||||
If r = -1 And GameOver = 0 Then
|
||||
VerTodo
|
||||
GameOver = 1
|
||||
End If
|
||||
If r = 1 And GameOver = 0 Then GameOver = 1
|
||||
If GameOver = 0 Then tt = Timer-temps
|
||||
|
||||
Screenlock
|
||||
Cls
|
||||
ShowGrid
|
||||
If GameOver = 0 Then
|
||||
Draw String (210,4), "X:" & NX & " Y:" & NY & " MINA:" & Int(mina*100) & "% TIMER : " & Int(TT) & " S REMAINING:" & nbDESCANSO,&hFFFF00
|
||||
Else
|
||||
Draw String (260,4), "PRESS: 'S' TO START X,Y,M TO SIZE" ,&hFFFF00
|
||||
Draw String (330,17), "X:" & NX & " Y:" & NY & " MINA:" & Int(mina*100) & "%" ,&hFFFF00
|
||||
If r = 1 Then
|
||||
t += 0.01
|
||||
If t > 1000 Then t = 0
|
||||
Draw String (320,280+Cos(t)*100),"!! CONGRATULATION !!",&hFFFF00
|
||||
End If
|
||||
End If
|
||||
Screenunlock
|
||||
Loop Until tecla = Chr(27)
|
||||
Bsave "Minesweeper.bmp",0
|
||||
End
|
||||
Loading…
Add table
Add a link
Reference in a new issue