Hola, kodashi21, bienvenid@!!
Primero, te comento algo: el código me resultó muy difícil de leer, debido a la forma en que lo colocaste en el post. En el editor de mensajes, tienes una herramienta que está hecha para colocar código fuente con identación incluida. Sólo tienes que seleccionar todo el código, y pulsar en esta opción: , que se encuentra entre (pegar imagen) y (HTML)
Bien, ahora, al tema:
No le encontré problemas. Lo que pasa es que a partir de 8, genera demasiadas combinaciones. La pc no se cuelga, sino que se encuentra procesando.
Haciéndole unas pocas modificaciones a tu código, podrás ver que esto es así.
Al Form, agregale un Label que se llame "lblcantidad", con un Caption inicial = "0" (cero)
Este label, irá indicando la cantidad de ítems en la ListBox llamada "vacia" (es sólo un número para ver el proceso)
Al sub Ejecutar_Click, le agregué unas líneas (resaltadas en azul)
Código:
Private Sub Ejecutar_Click()
lblCantidad = 0
If tnodos.Text = "" Then
MsgBox "Debe digitar la cantidad de nodos", , "ERROR"
tnodos.SetFocus
Else
If tnodos.Text < 4 Then
MsgBox "El numero de nodos dede ser mayor a 4 ", , "ERROR"
tnodos.Text = ""
tnodos.SetFocus
Else
If tnodos.Text > 26 Then
MsgBox "El numero de nodos dede ser menor 26", , "ERROR"
tnodos.Text = ""
tnodos.SetFocus
Else
'Comienza el algoritmo
Screen.MousePointer = 11
lrutas.Clear
vacia.Clear
cantidadnodos = Val(tnodos.Text)
permutaciones
End If
End If
End If
Screen.MousePointer = 0
End Sub
Al hacer clic en el botón, lo primero que se hará, es volver a cero el caption de lblcantidad.
"Screen.MousePointer = 11" está para que, cuando comience a crear las combinaciones, en pantalla se vea el reloj de arena.
"Screen.MousePointer = 0" vuelve a mostrar el cursor normal de Windows al finalizar los procesos
"lrutas.clear" y "vacia.clear" están para que, cada vez que se pulse el botón "Ejecutar", se eliminen todos los ítems de cada listbox, así, cada ejecución del programa, comenzará de cero.
Después, agregué las siguientes líneas, en la parte final del sub "Permutaciones" (de nuevo, lo agregado está resaltado con azul):
Código:
Do
k = k - 1
' Compara hacia atrás, si está repetido genera un nuevo _
número y lo guarda en el índice del vector _
que estaba repetido, es decir en esa posición
If lrutas.List(b) = lrutas.List(q) Then
lrutas.RemoveItem (b)
lblCantidad = Val(lblCantidad) + 1
DoEvents
GoTo nuevacombinacion
End If
Loop Until q = 0
De esta manera, cada vez que se remueva un item de lrutas (o sea, cada vez que la comparación de si lrutas.list(b) = lrutas.list(q) sea verdadera), se sumará una unidad en el valor del label lblCantidad.
La instrucción DoEvents está colocada para que vaya mostrando en pantalla el valor de lblCantidad actualizado.
Otra forma de ver que está procesando, sería que cuando parece que ya no está procesando, muevas el cursor de la barra de desplazamiento de la listbox "vacia", hacia el final de la misma, y verás que se siguen agregando ítems.
Bueno, espero que te sirva de algo mi respuesta...
.
Marcadores