Mensajes

reconozco que me zarpe pero el chabon tb tiene lo suyo, esta desprestigiando lo que hice eso me molesta, si me kisiera ayudar lo habria hecho a lo sumo no hubiera posteado nada, pero para criticar mi codigo no le pedi opinion

Si sabes tanto loko porque no lo haces al grafo, tan power sos? en vez de hablar al pedo fijate si podes programar algo primero

Un grafo no es un graffiti es una representacion grafica de una situacion determinada como puede ser un proyecto de analisis de sistemas . Bue ojala alguien me de una mano con el codigo, no tengo que dibujar un grafo sino mostrar como funciona

[Editado por el moderador:]

Este es el codigo del formulario

Código (vb) [Seleccionar] Expandir

Option Explicit
Const Nulo = 0    '' Posicion NO Valida de la Lista
Dim L       As New Listas
Dim P       As New Pilas
Dim C       As New Colas
Dim G       As New Grafos

Private Sub cmd_apilar_Click()

    Dim X       As Variant

    Randomize

    While Not P.EstaLlena
        X = Int(Rnd(100) * 100)
        P.Apilar X
    Wend

End Sub

Private Sub cmd_eliminar_Click()

    Dim Q       As Long
    Dim X       As Variant
   
    X = CLng(InputBox("Ingresar Dato a Eliminar", "Ingresar Datos", ""))
   
    Q = L.Buscar(X)
   
    If Q <> Nulo Then
        L.Eliminar (Q)
    Else
        MsgBox "Elemento No Encontrado"
    End If

End Sub

Private Sub cmd_encolar_Click()

    Dim X       As Variant

    Randomize

    While Not C.EstaLlena
        X = Int(Rnd(100) * 100)
        C.Encolar X
    Wend

End Sub

Private Sub cmd_listar_Click()

    Dim Q       As Long
    Dim X       As Variant

    List1.Clear
    Q = L.Inicio
   
    While Q <> Nulo
        X = L.Recuperar(Q)
        List1.AddItem X
        Q = L.Siguiente(Q)
    Wend

End Sub

Private Sub cmd_mostrar_cola_Click()

    Dim X       As Variant
    Dim li      As Integer
   
    li = 0
    List1.Clear
    While Not C.EstaVacia
        X = C.Recuperar
        li = li + 1
        List1.AddItem "Pos(" & li & ") = " & X
        C.DesEncolar
    Wend

End Sub

Private Sub cmd_mostrar_pila_Click()

    Dim X       As Variant
   
    List1.Clear
    While Not P.EstaVacia
        X = P.Recuperar
        List1.AddItem X
        P.DesApilar
    Wend

End Sub

Private Sub cmd_test_Click()

    Dim X       As Variant

    Randomize
    X = Int(Rnd(100) * 100)
    If L.Agregar(X) = False Then
        MsgBox "Error al Agregar en la Lista"
    End If

End Sub

Private Sub cmdcreargrafo_Click()
    Dim V As Variant
    Dim V2 As Variant
    Dim Varco As Variant
   
    V = "A"
    G.AgregarVertice (V)
    V = "B"
    G.AgregarVertice (V)
    V = "C"
    G.AgregarVertice (V)
    V = "D"
    G.AgregarVertice (V)
   
    Varco = 1
    V = "A"
    V2 = "B"
    If G.AgregarArco(V, V2, Varco) = False Then
    End If
   
    V = "B"
    V2 = "D"
    If G.AgregarArco(V, V2, Varco) = False Then
    End If

    V = "D"
    V2 = "C"
    If G.AgregarArco(V, V2, Varco) = False Then
    End If

    List1.Clear
    List1.AddItem G.RetornarVertices
    List1.AddItem G.RetornarArcos

End Sub

Private Sub cmdrecorridoanchura_Click()

    List1.AddItem G.RecorridoAnchura("A")
   
End Sub

Private Sub cmdrecorridoprof_Click()

    List1.AddItem G.RecorridoProfundidad("A")

End Sub

Private Sub Form_Load()

    L.CrearVacia
    P.CrearVacia
    C.CrearVacia
    G.CrearVacio
   
End Sub


Y este es el del modulo de clase

Código (vb) [Seleccionar] Expandir

Option Explicit   '' Obliga a definir todos las variables
Option Base 1     '' Para obligar a que los array funcionen de 1-N

Const MIN = 1     '' Elemento Minimo del Array
Const MAX = 100   '' Elemento Maximo del Array
Const Nulo = 0    '' Posicion NO Valida de la Lista

Dim Vertices(MAX) As Variant  '' Array donde se guardan los elementos
Dim Arcos(MAX, MAX) As Integer

Public NroVertices  As Integer  '' Maneja la Cantidad de Vertices que hay al momento en el grafo. maximo MAX = 100

Public Sub CrearVacio()
    Dim i, j As Integer
   
     
    NroVertices = 0  '' Indica que NO hay vertices
   
    '' Instancio cada casillero de la Matriz en Vacio
    For i = 1 To MAX
        For j = 1 To MAX
            Arcos(i, j) = vbEmpty
        Next
    Next
End Sub

Public Function EsVacio() As Boolean
    EsVacio = IIf(NroVertices = 0, True, False)
End Function

Public Function EsLleno() As Boolean
    EsLleno = IIf(NroVertices = MAX, True, False)
End Function

Public Function BuscarVertice(V As Variant) As Integer
    Dim i As Integer
   
    BuscarVertice = Nulo
    For i = 1 To NroVertices
        If Vertices(i) = V Then
            BuscarVertice = i
            Exit For
        End If
    Next
End Function

Public Function AgregarVertice(V As Variant) As Boolean
   
    If BuscarVertice(V) <> Nulo Then
        AgregarVertice = False
    Else
        NroVertices = NroVertices + 1
        Vertices(NroVertices) = V
        AgregarVertice = True
    End If

End Function

Public Function AgregarArco(V1, V2 As Variant, Varco As Variant, Optional ArcoBidireccional As Boolean = True) As Boolean
    Dim i, j As Integer
   
    AgregarArco = False
    If V1 <> V2 Then
        i = BuscarVertice(V1)
        j = BuscarVertice(V2)
        If (i <> Nulo) And (j <> Nulo) Then
            Arcos(i, j) = Varco
            If ArcoBidireccional = True Then
                Arcos(j, i) = Varco
            End If
            AgregarArco = True
        End If
    End If
End Function

Public Function EliminarArco(V1, V2 As Variant, Optional ArcoBidireccional As Boolean = True) As Boolean
    Dim i, j As Integer
   
    EliminarArco = False
    If V1 <> V2 Then
        i = BuscarVertice(V1)
        j = BuscarVertice(V2)
        If (i <> Nulo) And (j <> Nulo) Then
            Arcos(i, j) = vbEmpty
            If ArcoBidireccional = True Then
                Arcos(j, i) = vbEmpty
            End If
            EliminarArco = True
        End If
    End If
End Function

Public Function EliminarVertice(V As Variant) As Boolean
    Dim i, j, k As Integer
   
    EliminarVertice = False
    i = BuscarVertice(V)
    If V <> Nulo Then
        '' Primero Saco la Columna de la Matriz
        For j = 1 To NroVertices
            For k = i To NroVertices - 1
                Arcos(j, k) = Arcos(j, k + 1)
            Next
        Next
        '' Segundo saco la Fila de la matriz
        For j = i To NroVertices - 1
            For k = 1 To NroVertices - 1
                Arcos(j, k) = Arcos(j + 1, k)
            Next
        Next
        '' Saco el Vertice del vector de vertices
        For j = i To NroVertices - 1
            Vertices(j) = Vertices(j + 1)
        Next
        '' Por ultimo descuento 1 en la variable nrovertices
        NroVertices = NroVertices - 1
       
        EliminarVertice = True
    End If
End Function

Public Function RetornarVertices() As String
    Dim ll_i As Integer
    Dim S As String
   
    RetornarVertices = ""
    For ll_i = 1 To NroVertices
        S = S & Vertices(ll_i) & ", "
    Next
    RetornarVertices = S
End Function

Public Function RetornarArcos() As String
    Dim ll_i As Integer
    Dim ll_j As Integer
    Dim S As String
   
    RetornarArcos = ""
    For ll_i = 1 To NroVertices
        For ll_j = 1 To NroVertices
            S = S & Arcos(ll_i, ll_j) & ", "
        Next
        S = S & " | "
    Next
    RetornarArcos = S
End Function

Public Function RecorridoProfundidad(V As Variant) As String

    Dim ll_i As Integer
    Dim ll_j As Integer
    Dim P As New Pilas
    Dim L As New Listas
    Dim S As String
   
    ll_i = BuscarVertice(V)
    If ll_i = Nulo Then
        RecorridoProfundidad = ""
        Exit Function
    End If
   
    '' Si esta el Vertice se comienza el recorrido en profundidad
    P.CrearVacia
    P.Apilar (ll_i)
    L.CrearVacia
    While Not P.EstaVacia
        ll_i = P.Recuperar
        L.Agregar (ll_i)
        S = S & Vertices(ll_i)
        P.DesApilar
        For ll_j = 1 To NroVertices
            If Arcos(ll_i, ll_j) <> vbEmpty Then
                If L.Buscar(ll_j) = Nulo Then
                    P.Apilar (ll_j)
                End If
            End If
        Next
    Wend

    RecorridoProfundidad = S
End Function

Public Function RecorridoAnchura(V As Variant) As String

    Dim ll_i As Integer
    Dim ll_j As Integer
    Dim C As New Colas
    Dim L As New Listas
    Dim S As String
   
    ll_i = BuscarVertice(V)
    If ll_i = Nulo Then
        RecorridoAnchura = ""
        Exit Function
    End If
   
    '' Si esta el Vertice se comienza el recorrido en profundidad
    C.CrearVacia
    C.Encolar (ll_i)
    L.CrearVacia
    While Not C.EstaVacia
        ll_i = C.Recuperar
        L.Agregar (ll_i)
        S = S & Vertices(ll_i)
        C.DesEncolar
        For ll_j = 1 To NroVertices
            If Arcos(ll_i, ll_j) <> vbEmpty Then
                If L.Buscar(ll_j) = Nulo Then
                    C.Encolar (ll_j)
                End If
            End If
        Next
    Wend

    RecorridoAnchura = S
End Function


Editado por el moderador:

Utiliza las etiquetas code.

necesito crear un grafo en visual y no tengo ni idea tengo algo de codigo hecho