abajo en contraran el link de descarga, por otro lado el rar cuenta con un activex el chamaleon para crear botones personalizados en visual basic
1-Agregamos 81 textbox
2- Agregamos 2 ChameleonBtn1
Option Explicit
Dim matrix(8, 8) As Integer
Private Sub ChameleonBtn1_Click()
Randomize
Dim vector(9), x, y, r, a, z As Integer
For x = 0 To 8
vector(x) = x + 1
Next x
x = x - 1
y = 0
Do While x > -1
r = Int((x - 0 + 1) * Rnd + 0)
matrix(0, y) = vector(r)
For a = r To x
vector(a) = vector(a + 1)
Next a
x = x - 1
y = y + 1
Loop
'1
matrix(1, 0) = matrix(0, 3)
matrix(1, 1) = matrix(0, 4)
matrix(1, 2) = matrix(0, 5)
'2
matrix(2, 0) = matrix(0, 6)
matrix(2, 1) = matrix(0, 7)
matrix(2, 2) = matrix(0, 8)
'3
matrix(1, 3) = matrix(0, 6)
matrix(1, 4) = matrix(0, 7)
matrix(1, 5) = matrix(0, 8)
'4
matrix(2, 3) = matrix(0, 0)
matrix(2, 4) = matrix(0, 1)
matrix(2, 5) = matrix(0, 2)
'5
matrix(1, 6) = matrix(0, 0)
matrix(1, 7) = matrix(0, 1)
matrix(1, 8) = matrix(0, 2)
'6
matrix(2, 6) = matrix(0, 3)
matrix(2, 7) = matrix(0, 4)
matrix(2, 8) = matrix(0, 5)
'7
matrix(3, 0) = matrix(0, 1)
matrix(3, 1) = matrix(0, 2)
matrix(3, 2) = matrix(1, 0)
'8
matrix(4, 0) = matrix(1, 1)
matrix(4, 1) = matrix(1, 2)
matrix(4, 2) = matrix(2, 0)
'9
matrix(5, 0) = matrix(2, 1)
matrix(5, 1) = matrix(2, 2)
matrix(5, 2) = matrix(0, 0)
'10
matrix(3, 3) = matrix(4, 0)
matrix(3, 4) = matrix(4, 1)
matrix(3, 5) = matrix(4, 2)
'11
matrix(4, 3) = matrix(5, 0)
matrix(4, 4) = matrix(5, 1)
matrix(4, 5) = matrix(5, 2)
'12
matrix(5, 3) = matrix(3, 0)
matrix(5, 4) = matrix(3, 1)
matrix(5, 5) = matrix(3, 2)
'13
matrix(3, 6) = matrix(5, 0)
matrix(3, 7) = matrix(5, 1)
matrix(3, 8) = matrix(5, 2)
'14
matrix(4, 6) = matrix(3, 0)
matrix(4, 7) = matrix(3, 1)
matrix(4, 8) = matrix(3, 2)
'15
matrix(5, 6) = matrix(4, 0)
matrix(5, 7) = matrix(4, 1)
matrix(5, 8) = matrix(4, 2)
'16
matrix(6, 0) = matrix(3, 1)
matrix(6, 1) = matrix(3, 2)
matrix(6, 2) = matrix(4, 0)
'17
matrix(7, 0) = matrix(4, 1)
matrix(7, 1) = matrix(4, 2)
matrix(7, 2) = matrix(5, 0)
'18
matrix(8, 0) = matrix(5, 1)
matrix(8, 1) = matrix(5, 2)
matrix(8, 2) = matrix(3, 0)
'19
matrix(6, 3) = matrix(7, 0)
matrix(6, 4) = matrix(7, 1)
matrix(6, 5) = matrix(7, 2)
'20
matrix(7, 3) = matrix(8, 0)
matrix(7, 4) = matrix(8, 1)
matrix(7, 5) = matrix(8, 2)
'21
matrix(8, 3) = matrix(6, 0)
matrix(8, 4) = matrix(6, 1)
matrix(8, 5) = matrix(6, 2)
'22
matrix(6, 6) = matrix(8, 0)
matrix(6, 7) = matrix(8, 1)
matrix(6, 8) = matrix(8, 2)
'23
matrix(7, 6) = matrix(6, 0)
matrix(7, 7) = matrix(6, 1)
matrix(7, 8) = matrix(6, 2)
'24
matrix(8, 6) = matrix(7, 0)
matrix(8, 7) = matrix(7, 1)
matrix(8, 8) = matrix(7, 2)
z = 0
For x = 0 To 8
For y = 0 To 8
r = Int((1 - 0 + 1) * Rnd + 0)
If r = 0 Then
celda(z) = ""
Else
celda(z) = matrix(x, y)
End If
z = z + 1
Next y
Next x
End Sub
Private Sub ChameleonBtn2_Click()
Dim c, x, y, z As Integer
c = 0
z = 0
For x = 0 To 8
For y = 0 To 8
If celda(z) <> "" Then
If celda(z) = matrix(x, y) Then
c = c + 1
End If
End If
z = z + 1
Next y
Next x
If c = 81 Then
MsgBox "Sudoku Correctamente", , "Felisidades"
Else
MsgBox "Sudoku Incorrecto...", , ""
End If
End Sub
Private Sub Form_Load()
Dim x As Integer
For x = 0 To 80
celda(x) = ""
celda(x).MaxLength = 1
Next x
End Sub
Descargar el codigo: http://www.mediafire.com/download/kyh32x4l2n60ox6/Sudoku.rar
Saludos Flamer
No hay comentarios.:
Publicar un comentario