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