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 codeSancho.Mazorka :¬¬
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)
Sancho.Mazorka :¬¬
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.
(http://cyberwolf520.blogia.com/upload/grafo.JPG)
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
Cita de: matoreggae en 17 Julio 2007, 13:55 PM
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
Citary no olviden el reggae es belleza
Cuanta razon tienes :xD :xD
Cita de: ActiveSheet en 19 Julio 2007, 04:10 AM
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
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