Task: Minesweeper game








VB: 
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


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)
                
                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
                    
                    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
                    
                    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
                    
                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
                            
                            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
                            
                            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
                        
                        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
                            
                            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
                                
                                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
                
            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
    
    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



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: 
        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