anun1

viernes, 30 de octubre de 2015

Codigo Fuente Del Sudoku En Visual Basic 6

Hola amigos aqui les traigo el codigo fuente de mi sudoku hecho en VB6
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