Alters

A buscar M!nas: programación

Buenas!

Entramos en la recta final de la parte de VB.net; en esta entrada programaremos "a saco". Al final de ésta os dejaré un link para que podáis bajaros el proyecto y probar.

Os dejaré el código sin más. Este código es la "traducción" de los algoritmos previamente explicados con pseudo-código (hay un par de modificaciones, pero son poca cosa).

Dividiré los bloques por archivos, para que se lea un poco mejor.

BuscaminaX.vb


Public Class BuscaminaX
    Public time As Integer

    Private Sub BuscaminaX_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Diff.ShowDialog()

        If Global_Var.getGen.Equals(0) Then
            Me.Close()
        Else
            BX_module.Cargar()
            BX_module.Dibujar()
            Me.Timer1.Enabled = True
        End If
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Application.DoEvents()

        Me.time += 1

        Me.ToolStripStatusLabel1.Text = "Time: " + Me.time.ToString()
        Me.ToolStripStatusLabel2.Text = "Mines: " + BX_module.minas.ToString()
    End Sub
End Class


Diff.vb

Public NotInheritable Class Diff
    Private Sub Diff_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.Button1.Enabled = False
    End Sub

    Private Sub RadioButton1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton1.CheckedChanged, RadioButton2.CheckedChanged, _
                 RadioButton3.CheckedChanged, RadioButton4.CheckedChanged, _
                 RadioButton5.CheckedChanged
        Dim en As Boolean = False

        If (Me.RadioButton1.Checked Or Me.RadioButton2.Checked) And _
        (Me.RadioButton3.Checked Or Me.RadioButton4.Checked Or Me.RadioButton5.Checked) Then
            en = True
        End If

        Me.Button1.Enabled = en
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim gen As Integer = 1
        Dim dif As Integer = 0

        If Me.RadioButton2.Checked Then
            gen = 2
        End If

        If Me.RadioButton4.Checked Then
            dif = 1
        ElseIf Me.RadioButton5.Checked Then
            dif = 2
        End If

        Global_Var.setDif(dif)
        Global_Var.setGen(gen)

        Me.Close()
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Me.Close()
    End Sub
End Class



Global_var.vb

Module Global_Var
    Private dif As Integer
    Private gen As Integer
    Private min As Integer
    Private anc As Integer
    Private alt As Integer
    Private img As Integer
    Private anB As Double
    Private alB As Double
    Private fil As Integer
    Private col As Integer
    Private pos(99) As Integer
    Private coM() As Integer
    Private imF As Image

    Public Sub setDif(ByVal pDif As Integer)
        dif = pDif
    End Sub

    Public Sub setGen(ByVal pGen As Integer)
        gen = pGen
    End Sub

    Public Sub setMin(ByVal pMin As Integer)
        min = pMin
    End Sub

    Public Sub setAnc(ByVal pAnc As Integer)
        anc = pAnc
    End Sub

    Public Sub setAlt(ByVal pAlt As Integer)
        alt = pAlt
    End Sub

    Public Sub setImg(ByVal pImg As Integer)
        img = pImg
    End Sub

    Public Sub setAnB(ByVal pAnB As Double)
        anB = pAnB
    End Sub

    Public Sub setAlB(ByVal pAlB As Double)
        alB = pAlB
    End Sub

    Public Sub setFil(ByVal pFil As Integer)
        fil = pFil
    End Sub

    Public Sub setCol(ByVal pCol As Integer)
        col = pCol
    End Sub

    Public Sub setPos(ByVal pPos() As Integer)
        pos = pPos
    End Sub

    Public Sub setCoM(ByVal pCoM() As Integer)
        coM = pCoM
    End Sub

    Public Sub setImF(ByVal pImF As Image)
        imF = pImF
    End Sub

    Public Function getDif() As Integer
        Return dif
    End Function

    Public Function getGen() As Integer
        Return gen
    End Function

    Public Function getMin() As Integer
        Return min
    End Function

    Public Function getAnc() As Integer
        Return anc
    End Function

    Public Function getAlt() As Integer
        Return alt
    End Function

    Public Function getImg() As Integer
        Return img
    End Function

    Public Function getAnB() As Double
        Return anB
    End Function

    Public Function getAlB() As Double
        Return alB
    End Function

    Public Function getFil() As Integer
        Return fil
    End Function

    Public Function getCol() As Integer
        Return col
    End Function

    Public Function getPos() As Integer()
        Return pos
    End Function

    Public Function getCoM() As Integer()
        Return coM
    End Function

    Public Function getImF() As Image
        Return imF
    End Function
End Module


BX_module.vb

Imports System.IO

Module BX_module
    Public minas As Integer
    Private cuadros As Integer

    Public Sub Cargar()
        Dim min As Integer = 10
        Dim fil As Integer = 9
        Dim col As Integer = 9
        Dim anc As Integer
        Dim alt As Integer
        Dim img As Integer
        Dim anB As Double
        Dim alB As Double
        Dim pos(99) As Integer
        Dim res() As Integer
        Dim imF As Image
        Dim Random As New Random()

        img = Random.Next(0, 12)

        If Global_Var.getGen = 2 Then
            img += 12
        End If

        imF = Image.FromFile(Application.StartupPath.ToString + "\BX_IMG\BX_" + img.ToString + ".jpg")

        anc = imF.Width
        alt = imF.Height

        If Global_Var.getDif = 1 Then
            min = 40
            fil = 16
            col = 16
        ElseIf Global_Var.getDif = 2 Then
            min = 99
            fil = 16
            col = 30
        End If

        anB = anc / col
        alB = alt / fil
        pos = LlenarMinas(fil * col, min)
        res = ComprobarMinas(fil * col, col, pos, min)
        minas = min
        cuadros = (fil * col) - min

        Global_Var.setMin(min)
        Global_Var.setFil(fil)
        Global_Var.setCol(col)
        Global_Var.setAnc(anc)
        Global_Var.setAlt(alt)
        Global_Var.setImg(img)
        Global_Var.setAnB(anB)
        Global_Var.setAlB(alB)
        Global_Var.setPos(pos)
        Global_Var.setImF(imF)
        Global_Var.setCoM(res)
    End Sub

    Private Function LlenarMinas(ByVal max As Integer, ByVal min As Integer) As Integer()
        Dim pos(99) As Integer
        Dim num As Integer
        Dim pass As Boolean
        Dim Random As New Random()

        For i = 0 To min - 1
            pass = True
            num = Random.Next(0, max + 1)

            For j = 0 To pos.Length - 1
                If pos(j) = num Then
                    pass = False
                End If
            Next

            If pass Then
                pos(i) = num
            Else
                i -= 1
            End If
        Next

        Return pos
    End Function

    Private Function ComprobarMinas(ByVal max As Integer, ByVal col As Integer, ByVal pos() As Integer, ByVal min As Integer) As Integer()
        Dim ret(max) As Integer

        For i = 0 To max - 1
            Dim num As Integer

            For j = 0 To min - 1
                If i Mod col = 0 Then
                    If pos(j) = i - col Or pos(j) = i - (col - 1) Or _
                       pos(j) = i + 1 Or _
                       pos(j) = i + col Or pos(j) = i + (col + 1) Then
                        num += 1
                    ElseIf pos(j) = i Then
                        num = 10
                        Exit For
                    End If
                ElseIf i Mod col = col - 1 Then
                    If pos(j) = i - (col + 1) Or pos(j) = i - col Or _
                       pos(j) = i - 1 Or _
                       pos(j) = i + (col - 1) Or pos(j) = i + col Then
                        num += 1
                    ElseIf pos(j) = i Then
                        num = 10
                        Exit For
                    End If
                Else
                    If pos(j) = i - (col + 1) Or pos(j) = i - col Or pos(j) = i - (col - 1) Or _
                       pos(j) = i - 1 Or pos(j) = i + 1 Or _
                       pos(j) = i + (col - 1) Or pos(j) = i + col Or pos(j) = i + (col + 1) Then
                        num += 1
                    ElseIf pos(j) = i Then
                        num = 10
                        Exit For
                    End If
                End If
            Next

            ret(i) = num
            num = 0
        Next

        Return ret
    End Function

    Public Sub Dibujar()
        Dim max As Integer = Global_Var.getFil() * Global_Var.getCol()
        Dim t As Double = 0
        Dim l As Double = 0
        Dim h As Double = Global_Var.getAlB
        Dim w As Double = Global_Var.getAnB
        Dim c As Integer = Global_Var.getCol
        Dim f As Integer = Global_Var.getFil
        Dim o As Label
        Dim p As Button
        Dim con(max * 2) As Control

        For i = 0 To max - 1
            o = New Label()
            p = New Button()

            o.Top = t
            o.Left = l
            o.Height = h
            o.Width = w
            o.Name = "L" + i.ToString
            o.Visible = True
            o.BackColor = Color.Transparent
            o.Font = New Font("Times new Roman", 10, FontStyle.Regular, GraphicsUnit.Pixel)

            p.Top = t
            p.Left = l
            p.Height = h
            p.Width = w
            p.Name = "B" + i.ToString
            p.Visible = True

            AddHandler p.MouseDown, AddressOf p_click
            AddHandler o.MouseEnter, AddressOf o_mouseEnter
            AddHandler o.MouseLeave, AddressOf o_mouseLeave

            con(i) = p
            con(i + max) = o

            If i Mod c = c - 1 Then
                l = 0
                t += h
            Else
                l += w
            End If
        Next

        BuscaminaX.Controls.AddRange(con)

        BuscaminaX.Height = Global_Var.getAlt() + 57
        BuscaminaX.Width = Global_Var.getAnc() + 13
        BuscaminaX.MaximumSize = BuscaminaX.Size
        BuscaminaX.MinimumSize = BuscaminaX.Size
        BuscaminaX.BackgroundImage = Global_Var.getImF()
        BuscaminaX.ToolStripStatusLabel1.Text = Global_Var.getMin.ToString
    End Sub

    Private Sub p_click(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        If e.Button = MouseButtons.Left Then
            cuadros -= 1

            If cuadros = 0 Then
                MsgBox("Has ganado")
                BuscaminaX.Controls.Clear()
            End If

            sender.Visible = False

            If Global_Var.getCoM()(sender.name.SubString(1)) = 10 Then
                MsgBox("PUM!")
                Fail.ShowDialog()
            End If
        ElseIf e.Button = MouseButtons.Right Then
            If sender.text.Equals("X") Then
                sender.text = ""
                sender.backColor = Color.WhiteSmoke
                minas += 1
            Else
                sender.Text = "X"
                sender.backColor = Color.Red
                minas -= 1
            End If

            BuscaminaX.ToolStripStatusLabel1.Text = "Time: " + BuscaminaX.time.ToString()
            BuscaminaX.ToolStripStatusLabel2.Text = "Mines: " + minas.ToString()
        End If
    End Sub

    Private Sub o_mouseEnter(ByVal sender As Object, ByVal e As System.EventArgs)
        sender.BackColor = Color.White
        sender.text = Global_Var.getCoM()(sender.name.SubString(1))
    End Sub

    Private Sub o_mouseLeave(ByVal sender As Object, ByVal e As System.EventArgs)
        sender.text = ""
        sender.backcolor = Color.Transparent
    End Sub
End Module

Con esto queda plasmado todo el código respectivo al proyecto de VB.net

Os dejo un link de descarga para el proyecto completo. Recordad leer el "LEEME.TXT", y si compartís el paquete recordad ser buenos y citar el post original (este) y/o su autor orignial (yo).

http://www.mediafire.com/?8y7d8old8blrxh2

La próxima serie de entradas se basarán en una serie de ampliaciones del proyecto, usando MSAccess (por ahora...).

Saludos, y

¡Hasta la próxima!

No hay comentarios:

Publicar un comentario