Keskustelu: Koodit: VB6: Miinaharava

Option Explicit
Dim gLeft As Integer, gTop As Integer, gHor As Integer, gVer As Integer, gSize As Integer  'ruudukon tiedot
Dim xi As Integer, yi As Integer, vxi As Integer, vyi As Integer  'ruutu, jossa hiiri on
Dim Grid(-1 To 200, -1 To 200) As Boolean   'ruudussa miina -taulukko
Dim GridC(-1 To 200, -1 To 200) As Boolean   'ruutu avattu -taulukko
Dim ButtonDown As Boolean, GameOver As Boolean   'nappipohjassa ja peliohi -liput

Private Sub Form_Load()

Randomize
Form1.AutoRedraw = True
Form1.Width = 10000: Form1.Height = 10000   'ikkunan mitat
Form1.Caption = "Miinaharava by Hunajavohveli"
SetGrid 30, 30, InputBox("Ruutujen määrä vaakatasossa?"), InputBox("Ruutujen määrä pystytasossa?"), InputBox("Ruutujen koko pikseleinä? (oletus=25)"), InputBox("Montako miinaa?") 'Alustetaan (vasen, ylä, leveys, korkeus, ruutujen koko, miinat)

End Sub

Sub SetGrid(Left As Integer, Top As Integer, Hor As Integer, Ver As Integer, Size As Integer, Mines As Integer)
Dim i As Integer, x As Integer, y As Integer
Cls

Form1.ScaleMode = 3   'pikselit käyttöön

'vaakaviivat
For i = 0 To Hor
  Line (i * Size + Left, Top)-(i * Size + Left, Top + Ver * Size + 1)
Next i

'pystyviivat
For i = 0 To Ver
  Line (Left, i * Size + Top)-(Left + Hor * Size, i * Size + Top)
Next i

'ruudukon ominaisuudet muistiin
gLeft = Left: gTop = Top: gHor = Hor: gVer = Ver: gSize = Size

'arvotaan miinat ruudukkoon
For i = 1 To Mines
  Do
    x = Int(Rnd * gHor)
    y = Int(Rnd * gVer)
  DoEvents
  Loop Until Grid(x, y) = False   'ei saa arpoa samaan kohtaan useampaa
  Grid(x, y) = True
Next i

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If GameOver Then Exit Sub   'jos peli ohi...

If xi >= 0 And yi >= 0 And xi < gHor And yi < gVer Then   'jos hiiri alueen sisällä
  If Button = 2 Then    'jos oikea näppäin
      If GridC(xi, yi) = False Then  'jos ruutua ei ole merkitty
        LightSquare xi, yi, Form1.BackColor
        GridPrint xi, yi, "X"   'merkitään miina
        GridC(xi, yi) = True   'nyt on merkitty
      Else    'jos on merkitty
        LightSquare xi, yi, Form1.BackColor
        GridC(xi, yi) = False   'poistetaan merkintä
      End If
    Exit Sub   'poistutaan
  End If
    ButtonDown = True
    If GridC(xi, yi) = False Then LightSquare vxi, vyi, RGB(200, 0, 0)  'korostetaan ruutua
End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If GameOver Then Exit Sub   'jos peli ohi...

If vxi >= 0 And vyi >= 0 And vxi < gHor And vyi < gVer Then
If GridC(vxi, vyi) = False Then LightSquare vxi, vyi, Form1.BackColor   'poistetaan ruudun korostus
End If

'lasketaan ruutu hiiren koordinaattien perusteella
CurrentX = 50
CurrentY = 50
xi = Int((x - gLeft) / gSize)
yi = Int((y - gTop) / gSize)

'korostetaan ruutua. jossa hiiri on
If xi >= 0 And yi >= 0 And xi < gHor And yi < gVer Then
If GridC(xi, yi) = False Then
  If ButtonDown Then
    LightSquare xi, yi, RGB(200, 0, 0)
  Else
    LightSquare xi, yi, RGB(0, 0, 140)
  End If
End If
End If

'muistiin edellinen kohta
vxi = xi
vyi = yi

End Sub

Sub LightSquare(x As Integer, y As Integer, col As Long)

'ruudun korostus
If x >= 0 And y >= 0 And x < gHor And y < gVer Then
Line (x * gSize + gLeft + 1, y * gSize + gTop + 1)-(x * gSize + gLeft + gSize - 1, y * gSize + gTop + gSize - 1), col, BF
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If GameOver Then Exit Sub   'jos peli ohi...

If ButtonDown Then
  ButtonDown = False
If xi >= 0 And yi >= 0 And xi < gHor And yi < gVer Then  'jos alueen sisällä, avataan ruutu
  If Grid(xi, yi) = True Then ShowMines: Exit Sub  'jos ruudussa miina...
  CheckSquare xi, yi
End If
End If

End Sub

Sub GridPrint(x As Integer, y As Integer, Char As String)

Form1.ScaleMode = 4
Form1.CurrentX = x * 2.25 / 18 * gSize + gLeft / 8 + 0.7 / 18 * gSize
Form1.CurrentY = y * 1.125 / 18 * gSize + gTop / 16 + 0.2 / 18 * gSize
Form1.FontSize = 8 / 18 * gSize
Form1.FontBold = True
Form1.ForeColor = QBColor(Val(Char))

If Char = "0" Then    'jos ei miinoja ympärillä
  Form1.ScaleMode = 3
  LightSquare x, y, RGB(128, 128, 128)   'tummennetaan
Else
  Print Char    'näytetään numero
  Form1.ScaleMode = 3
End If

End Sub

Function Around(x As Integer, y As Integer)
Dim Am As Integer
'palauttaa ruudun ympärillä olevien miinojen määrän

If Grid(x - 1, y - 1) Then Am = Am + 1
If Grid(x, y - 1) Then Am = Am + 1
If Grid(x + 1, y - 1) Then Am = Am + 1
If Grid(x - 1, y) Then Am = Am + 1
If Grid(x + 1, y) Then Am = Am + 1
If Grid(x - 1, y + 1) Then Am = Am + 1
If Grid(x, y + 1) Then Am = Am + 1
If Grid(x + 1, y + 1) Then Am = Am + 1
Around = Am

End Function

Sub ShowMines()
Dim i As Integer, j As Integer
'näytetään miinat

Form1.ScaleMode = 4
Form1.FontSize = 8 / 18 * gSize
Form1.FontBold = True
Form1.ForeColor = 0

For j = 0 To gVer - 1
For i = 0 To gHor - 1
  Form1.CurrentX = i * 2.25 / 18 * gSize + gLeft / 8 + 0.7 / 18 * gSize
  Form1.CurrentY = j * 1.125 / 18 * gSize + gTop / 16 + 0.2 / 18 * gSize
  If Grid(i, j) Then Print "X"
Next i
Next j
GameOver = True

End Sub

Sub CheckSquare(x As Integer, y As Integer)

If Not (x >= 0 And y >= 0 And x < gHor And y < gVer) Then Exit Sub

GridC(x, y) = True      'merkitään ruutu avatuksi
LightSquare x, y, Form1.BackColor
GridPrint x, y, Around(x, y)   'tulostetaan ruudun numero
If Around(x, y) = 0 And GridC(x, y) Then
  If GridC(x - 1, y - 1) = False Then CheckSquare x - 1, y - 1
  If GridC(x, y - 1) = False Then CheckSquare x, y - 1
  If GridC(x + 1, y - 1) = False Then CheckSquare x + 1, y - 1
  If GridC(x + 1, y) = False Then CheckSquare x + 1, y
  If GridC(x + 1, y + 1) = False Then CheckSquare x + 1, y + 1
  If GridC(x, y + 1) = False Then CheckSquare x, y + 1
  If GridC(x - 1, y + 1) = False Then CheckSquare x - 1, y + 1
  If GridC(x - 1, y) = False Then CheckSquare x - 1, y
End If

End Sub