Foro de elhacker.net

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

se un poco más explicito, muestranos tu code...

Atentamente,


Juan Manuel Lombana
Medellín - Colombia

Este es el codigo del formulario

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

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.

Yo ni se que es un grafo  :xD

NOTA: Usa las etiquetas de code

Por lo que yo conozco como "Grafo" es un Graffitis, sino sabes lo que es eso, son dibujos callejeros echos en paredes:
http://net.jexiste.fr/originaux/tags/016.jpg
http://arteleku2007.wikispaces.com/space/showimage/arteleku-graffitis2006.jpg

Pues eso es, y yo lo que creo que el chico quiere hacer es dibujar en un Picture box algo o nose :S
Aun asi suerte!

Salu2

Ranslsad

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

Toma aca dentro esta lo que vos necesitas:
http://rapidshare.com/users/HZAZL1 (http://rapidshare.com/users/HZAZL1) (MiniPaint.rar)

http://es.wikipedia.org/wiki/Grafo
http://es.wikipedia.org/wiki/Teor%C3%ADa_de_los_grafos

Que dice:

Informalmente, un grafo es un conjunto de objetos llamados vértices o nodos unidos por enlaces llamados aristas. En un grafo propiamente dicho (no dirigido, ver su definición más abajo), una arista desde el nodo A al nodo B se la considera la misma que la del nodo B al nodo A. En un grafo dirigido (aquel en el cual las aristas indican un sentido), estos dos sentidos se cuentan como aristas distintas o aristas dirigidas.


Sólo aporto la información porque en primer lugar nunca me he metido con grafos, sólo con árboles (profundidad y amplitud) pero con grafos no, no sé si estén fáciles o no, simplemente no me he animado.

Y en segundo lugar... ¡qué flojera ver ese código! ¿Será por la falta de etiquedas [ code ]?

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

Ves a gente como esta yo la mandaria a la ***** porque son de un desagradecido que no tiene nombre.
Cierren este tema y dejen a este chico que se las arregle solito.

Salu2

Ranslsad

hey si viejo... a qui estan para ayudarte y tu insultas y agredes a la gente.... como quieres conseguir algo, mira no es tan complejo hay unas ciertas ocx y dll que los grafican, tu unicamente crearias los arrrays y las entidades y listo!!!... pero arreglatelas tu solo.

Atentamente,


Juan Manuel Lombana
Medellín - Colombia

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

We tranquis esta preocupado sepan disculparlo es mi amigo porfavor ayudenlo y no cierren el tema.
Gracias amigos

matoreggae, mas tranquilo machin eres compa del Huemulito me cai bien pero no te pases no te expicacas bien ademas de que es un trabajo complicado aca el Sancho.Mazorka te dejo algo que te puede servir

http://rapidshare.com/users/HZAZL1 (MiniPaint.rar)

Gracias red por contestarle amigaso

gracias amigos por la ayuda y gracias a mi amigazo huemulito que es un capo bue un saludo grande y no olviden el reggae es belleza jaja

Si es belleza por que tu nick es "matoreggae"

Bastante Ironico no te parece

Un ejemplo seria como yo,

odio el futbol y digo que mi nick es amorfutbol, ja

Cuanta razon tienes  :xD :xD


Y tu tb jajaja

Es ejemplo xD

We me alegro que te allan podido ayudar los foreros colegas que saven de este tema ya que yo 0 VB

Ya el tema de los grafos se fue al jorak pero lo de mato es mi nombre cuak x eso mato reggae xq amo el reggae a ver si pensamos un pokito no? chan

en realidad no me sirvio de mucho xq no tengo que dibujar sino crear una matriz donde figuren nodos y vertices, fecha temprana y tardia y camino critco todo cargado por un usuario tiene que haber un boton de agregar nodo uno para arco, para calcular fecha temprana y tardia, para eliminar nodos y arcos, etc; tengo que usar un msflexgrid para mostrar la matriz

mmm supongo que quieres crear algo asi como lo que esta en esta página verdad??

http://aplicaciones4.sct.gob.mx/sibuac_internet/ControllerUI?action=cmdEscogeRuta

pones un punto de partida y uno de llegada y te traza el camino