257 lines
8.5 KiB
Plaintext
257 lines
8.5 KiB
Plaintext
'--- 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
|