Yksinkertainen miinaharava. Microsoftin versiossa käytetään kai CommandButtoneita, mutta havaitsin sen jostain syystä hidastavan kauheasti suoritusta, joten ruudukko tehdään ihan vain Linellä piirtämällä ja tarkistus hiiren koordinaattien perusteella. Jos avattu ruutu on harmaa, se tarkoittaa, ettei sen vieressä ole yhtään miinaa, vaan kaikki ympäröivät ruudut voi huoletta avata, ja ohjelma avaakin ne automaattisesti nyt, kun lisäsin rekursiivisen tarkistuksen. Oletetun miinan paikan voi merkitä hiiren oikealla näppäimellä. Merkinnän voi myös poistaa painamalla uudestaan.
Form_Loadista voi muuttaa ruudukon kokoa ja miinojen määrää. Formille ei tarvitse pistää mitään komponentteja.
Tuosta voi ladata käännetyn ohjelman: http://koodaa.mine.nu/~vohveli/miinaharava.exe
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
Juuh, ihan näppärähän tää... :)
Just kova. Laitappa vielä ääniefektit!
hiennno
Osaisin kyllä tehdä ääniefektien soittamisen, mutta itse niitä ääniä en kyllä tiedä, miten tekisin.
Voihan sitä yrittää itsekin tuohon soveltaa, jos vain hoksaa, missä kohdassa tehdään mitäkin. :)
No ei mitään ääniturhamultimediaärsytyksiä tarvikaan. PÖÖ
Päivitin koodin. Lisäsin siihen rekursiivisen tarkistuksen, joten tyhjien ruutujen vieressä olevia ruutuja ei tarvitse enää itse avata.
Ja tästä saa nyt uuden version exenä.
Meitsi kirjoitti:
Just kova. Laitappa vielä ääniefektit!
Laitappa itte, tämä on koodivinkki.
Kauan kirjoitit tuota koodia?
Aihe on jo aika vanha, joten et voi enää vastata siihen.