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