![]() |
Ayuda Urgente Porfavor Sobre Hacer Un Sudoku!!solo Tengo 5 Dias Hola ha todos tengo que hacer un sudoku en visual basic tengo 5 :neurotico dias por hacerlo y lo tengo comenzado pero no se lo que falla,por favor haver si alguien que lo sepa me puede ayudar se lo voy a agradecer mucho:si: ,bueno el programa se trata de un sudoku que solo tiene de tener un boton y cuando pulses el boton se creen sudokus completados 9x9, pues lo que se trata es cuando pulses el boton te salga otro nuevo, aqui os dejo el codigo fuente haver si me podeis ayudar: Dim Matriz(1 To 9, 1 To 9, 1 To 9) As Boolean Private Sub Cmd_CrearNuevo_Click() For i = 0 To 80 Txt_Numero(i).Text = "" Next i End Sub Private Sub Txt_Numero_KeyPress(Index As Integer, KeyAscii As Integer) If (Val(Chr(KeyAscii)) < 1 Or Val(Chr(KeyAscii)) > 9) And KeyAscii <> 8 Then KeyAscii = 0 End If End Sub Private Sub Txt_Numero_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyLeft If Index > 0 Then EnfocarCaja Txt_Numero(Index - 1) Case vbKeyRight If Index < Txt_Numero.UBound Then EnfocarCaja Txt_Numero(Index + 1) Case vbKeyUp If Index > 8 Then EnfocarCaja Txt_Numero(Index - 9) End If Case vbKeyDown If Index < Txt_Numero.UBound - 9 Then EnfocarCaja Txt_Numero(Index + 9) End If Case vbKeyEscape End End Select End Sub Sub EnfocarCaja(Caja As TextBox) Caja.SetFocus Caja.SelStart = 0 Caja.SelLength = 1 End Sub sub ArmarMatriz() Resetear For i = 0 To 80 y = Int(i / 9) + 1 x = (i - (y - 1) * 9) + 1 If Txt_Numero(i) <> "" Then z = Val(Txt_Numero(i)) ProcesarTachado x, y, z End If Next i End Sub Sub Resetear() For x = 1 To 9 For y = 1 To 9 For z = 1 To 9 Matriz(x, y, z) = True Next z Next y Next x End Sub Sub EncontrarResueltos() Dim Encontro As Boolean, ValorEncontrado As Integer Encontro = False For x = 1 To 9 For y = 1 To 9 For z = 1 To 9 If Matriz(x, y, z) Then If Encontro Then Encontro = False Exit For Else Encontro = True ValorEncontrado = z End If End If Next z If Encontro Then Txt_Numero((y - 1) * 9 + x - 1).Text = CStr(ValorEncontrado) ProcesarTachado x, y, ValorEncontrado End If Encontro = False Next y Next x End Sub Sub BuscarUnicos() For i = 1 To 9 For z = 1 To 9 x = BuscarFila(i, z) If x > 0 Then y = i Txt_Numero((y - 1) * 9 + x - 1).Text = z ProcesarTachado x, y, z End If y = BuscarColumna(i, z) If y > 0 Then x = i Txt_Numero((y - 1) * 9 + x - 1).Text = z ProcesarTachado x, y, z End If For x = 1 To 6 Step 3 For y = 1 To 6 Step 3 xy = BuscarSubMatriz(x, y, z) If xy <> "" Then separar = Split(xy, "-") X2 = Val(separar(0)) Y2 = Val(separar(1)) Txt_Numero((Y2 - 1) * 9 + X2 - 1).Text = z ProcesarTachado X2, Y2, z End If Next y Next x Next z Next i End Sub Function BuscarFila(y, z) BuscarFila = False Dim EsUnico As Boolean EsUnico = False For x = 1 To 9 If Matriz(x, y, z) Then If EsUnico Then BuscarFila = 0 Exit Function Else EsUnico = True BuscarFila = x End If End If Next x End Function Function BuscarColumna(x, z) BuscarColumna = False Dim EsUnico As Boolean EsUnico = False For y = 1 To 9 If Matriz(x, y, z) Then If EsUnico Then BuscarColumna = 0 Exit Function Else EsUnico = True BuscarColumna = y End If End If Next y End Function Function BuscarSubMatriz(ByVal i, ByVal j, ByVal z) As String Dim EsUnico As Boolean EsUnico = False For x = i To i + 2 For y = j To j + 2 If Matriz(x, y, z) Then If EsUnico Then BuscarSubMatriz = "" Exit Function Else EsUnico = True BuscarSubMatriz = CStr(x) & "-" & CStr(y) End If End If Next y Next x End Function Sub ProcesarTachado(x, y, z) TacharCasilla x, y, z TacharColumna x, z TacharFila y, z TacharSubMatriz x, y, z FijarNumero x, y, z End Sub Sub TacharCasilla(x, y, valor) For z = 1 To 9 If valor <> z Then Matriz(x, y, z) = False Next z End Sub Sub TacharColumna(x, z) For y = 1 To 9 Matriz(x, y, z) = False Next y End Sub Sub TacharFila(y, z) For x = 1 To 9 Matriz(x, y, z) = False Next x End Sub Sub TacharSubMatriz(ByVal x, ByVal y, ByVal z) Dim XDesde As Integer, YDesde As Integer YDesde = (Int((y - 1) / 3) * 3) + 1 XDesde = (Int((x - 1) / 3) * 3) + 1 For x = XDesde To XDesde + 2 For y = YDesde To YDesde + 2 Matriz(x, y, z) = False Next y Next x End Sub Sub FijarNumero(x, y, z) Matriz(x, y, z) = True End Sub Function FinSudoku() As Boolean FinSudoku = True For i = 0 To Txt_Numero.UBound If Txt_Numero(i).Text = "" Then FinSudoku = False Exit Function End If Next i End Function |
| La zona horaria es GMT -6. Ahora son las 10:38. |
Desarrollado por vBulletin® Versión 3.8.7
Derechos de Autor ©2000 - 2026, Jelsoft Enterprises Ltd.