00001     '***************************************************************  

00002     '* *  

00003     '* GRAFOS http://ttt.upv.es/~arodrigu/grafos/ *  

00004     '* *  

00005     '* Software para la construcción y análisis de grafos *  

00006     '* *  

00007     '* *  

00008     '* (cc) 2003..2005 Alejandro Rodríguez Villalobos *  

00009     '* *  

00010     '* Creative Commons License *  

00011     '* Reconocimiento-NoComercial-CompartirIgual 2.1 *  

00012     '* http://ttt.upv.es/~arodrigu/grafos/http://creativecommons.org/licenses/by-nc-sa/3.0/deed.es*  

       »       *  

00013     '* *  

00014     '***************************************************************  

00015      

00016     'Advertencia: este programa está protegido por las leyes de derechos de autor  

00017     'y otros tratados internacionales. Grafos es un software libre y gratuito. Se  

00018     'distribuye bajo las condiciones:Reconocimiento-NoComercial-CompartirIgual 2.1.  

00019     '(Creative Commons License). La comercialización sin consentimiento del autor  

00020     'de este programa o cualquier parte del mismo, está penada por la ley con  

00021     'severas sanciones civiles y penales, y será objeto de todas las acciones  

00022     'judiciales que correspondan." & vbcrlf & "Grafos incluye la librería lp_solve  

00023     '5.x Copyright 1991, 2005 Free Software Foundation, Inc. bajo licencia LGPL.  

00024      

00025      

00026      

00027     'Importa espacio de nombres de lp_solve5  

00028     Imports Grafos . lpsolve51 

00029      

00030      

00031     'Para las funciones de apertura/escritura de ficheros  

00032     Imports System . IO 

00033     Imports System . Xml 

00034     'Imports System.Runtime.Serialization.Formatters.Soap  

00035     'Imports System.Runtime.Serialization.Formatters.Binary  

00036      

00037      

00038     'pruebas con otro solver  

00039     'Imports Grafos.QSopt1  

00040      

00041      

00042     Public Class Form1 

00043         Inherits System . Windows . Forms . Form 

00044         'declaración global para lp_solve 5  

00045         'Private lpsolve As lpsolve51  

00046      

00047     # Region " Código generado por el Diseñador de Windows Forms " 

00048      



00049         Public Sub New () 

00050             MyBase . New () 

00051      

00052             'El Diseñador de Windows Forms requiere esta llamada.  

00053             InitializeComponent () 

00054      

00055             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00056      

00057      

00058      

00059             'Inicialización del Solver lp_solver 5  

00060             'lpsolve = New lpsolve51  

00061      

00062             System . Diagnostics . Debug . WriteLine ( CurDir ()) 

00063             'lpsolve.Init(".")  

00064      

00065      

00066      

00067      

00068      

00069      

00070      

00071      

00072         End Sub 

00073      

00074         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00075         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00076             If disposing Then 

00077                 If Not ( components Is Nothing ) Then 

00078                     components . Dispose () 

00079                 End If 

00080             End If 

00081             MyBase . Dispose ( disposing ) 

00082         End Sub 

00083      

00084         'Requerido por el Diseñador de Windows Forms  

00085         Private components As System . ComponentModel . IContainer 

00086      

00087         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00088         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00089         'No lo modifique con el editor de código.  

00090         Friend WithEvents MainMenu1 As System . Windows . Forms . MainMenu 

00091         Friend WithEvents MenuItem1 As System . Windows . Forms . MenuItem 

00092         Friend WithEvents mnuEdicion As System . Windows . Forms . MenuItem 

00093         Friend WithEvents mnuFormato As System . Windows . Forms . MenuItem 

00094         Friend WithEvents mnuAnalisis As System . Windows . Forms . MenuItem 

00095         Friend WithEvents MenuItem5 As System . Windows . Forms . MenuItem 

00096         Friend WithEvents mnuArchivoNuevo As System . Windows . Forms . MenuItem 

00097         Friend WithEvents mnuArchivoAbrir As System . Windows . Forms . MenuItem 

00098         Friend WithEvents MenuItem8 As System . Windows . Forms . MenuItem 

00099         Friend WithEvents mnuArchivoGuardar As System . Windows . Forms . MenuItem 

00100         Friend WithEvents mnuArchivoGuardarComo As System . Windows . Forms . MenuItem 

00101         Friend WithEvents MenuItem11 As System . Windows . Forms . MenuItem 

00102         Friend WithEvents mnuArchivoSalir As System . Windows . Forms . MenuItem 

00103         Friend WithEvents mnuEdicionGrafica As System . Windows . Forms . MenuItem 

00104         Friend WithEvents mnuFormatoOpciones As System . Windows . Forms . MenuItem 

00105         Friend WithEvents PictureBox1 As System . Windows . Forms . PictureBox 

00106         Friend WithEvents PanelX As System . Windows . Forms . StatusBarPanel 

00107         Friend WithEvents PanelY As System . Windows . Forms . StatusBarPanel 

00108         Friend WithEvents StatusBar As System . Windows . Forms . StatusBar 

00109         Friend WithEvents Panel1 As System . Windows . Forms . Panel 

00110         Friend WithEvents mnuFormatoRejilla As System . Windows . Forms . MenuItem 

00111         Friend WithEvents mnuFormatoIman As System . Windows . Forms . MenuItem 

00112         Friend WithEvents MenuItem19 As System . Windows . Forms . MenuItem 

00113         Friend WithEvents mnuAyudaAcercade As System . Windows . Forms . MenuItem 

00114         Friend WithEvents mnuArchivoImprimir As System . Windows . Forms . MenuItem 

00115         Friend WithEvents mnuEdicion2 As System . Windows . Forms . MenuItem 

00116         Friend WithEvents PrintDialog1 As System . Windows . Forms . PrintDialog 

00117         Friend WithEvents PrintPreviewDialog1 As System . Windows . Forms .  

       »           PrintPreviewDialog 

00118         Friend WithEvents mnuArchivoConfigurarPag As System . Windows . Forms . MenuItem 

00119         Friend WithEvents PrintDocument1 As System . Drawing . Printing . PrintDocument 

00120         Friend WithEvents PageSetupDialog1 As System . Windows . Forms . PageSetupDialog 

00121         Friend WithEvents mnuArchivoConfigurarImp As System . Windows . Forms . MenuItem 

00122         Friend WithEvents SobreObj As System . Windows . Forms . StatusBarPanel 

00123         Friend WithEvents Nd1 As System . Windows . Forms . StatusBarPanel 

00124         Friend WithEvents Nd2 As System . Windows . Forms . StatusBarPanel 

00125         Friend WithEvents mnuPopUp As System . Windows . Forms . ContextMenu 

00126         Friend WithEvents mnuAñadirNodo As System . Windows . Forms . MenuItem 

00127         Friend WithEvents mnuEditarNodo As System . Windows . Forms . MenuItem 

00128         Friend WithEvents mnuBorrarNodo As System . Windows . Forms . MenuItem 

00129         Friend WithEvents mnuEdicion4 As System . Windows . Forms . MenuItem 

00130         Friend WithEvents mnuAñadirArco As System . Windows . Forms . MenuItem 

00131         Friend WithEvents mnuEdicion8 As System . Windows . Forms . MenuItem 

00132         Friend WithEvents mnuZoomMas As System . Windows . Forms . MenuItem 

00133         Friend WithEvents mnuZoomMenos As System . Windows . Forms . MenuItem 

00134         Friend WithEvents mnuZoomAjustar As System . Windows . Forms . MenuItem 

00135         Friend WithEvents mnuEditarArco As System . Windows . Forms . MenuItem 

00136         Friend WithEvents mnuBorrarArco As System . Windows . Forms . MenuItem 

00137         Friend WithEvents z As System . Windows . Forms . StatusBarPanel 

00138         Friend WithEvents mnuArchivoCopiarImg As System . Windows . Forms . MenuItem 

00139         Friend WithEvents mnuArchivoExportarImg As System . Windows . Forms . MenuItem 

00140         Friend WithEvents TextBox1 As System . Windows . Forms . TextBox 

00141         Friend WithEvents mnuEdicionTabular As System . Windows . Forms . MenuItem 

00142         Friend WithEvents mnuPopTabla As System . Windows . Forms . ContextMenu 

00143         Friend WithEvents mnuTablaBorrarNodo As System . Windows . Forms . MenuItem 

00144         Friend WithEvents mnuTablaAñadirNodo As System . Windows . Forms . MenuItem 

00145         Friend WithEvents mnuTablaTotalNodos As System . Windows . Forms . MenuItem 

00146         Friend WithEvents MenuItem2 As System . Windows . Forms . MenuItem 

00147         Friend WithEvents hfgTabla As AxMSFlexGridLib . AxMSFlexGrid 

00148         Friend WithEvents MenuItem6 As System . Windows . Forms . MenuItem 

00149         Friend WithEvents mnuFormatoCircular As System . Windows . Forms . MenuItem 

00150         Friend WithEvents mnuFormatoAleatorio As System . Windows . Forms . MenuItem 

00151         Friend WithEvents mnuFormatoTablero As System . Windows . Forms . MenuItem 

00152         Friend WithEvents MenuItem3 As System . Windows . Forms . MenuItem 

00153         Friend WithEvents mnuTablaCopiarTabla As System . Windows . Forms . MenuItem 

00154         Friend WithEvents mnuAlinearNodos As System . Windows . Forms . MenuItem 

00155         Friend WithEvents mnuAlinearNodosH As System . Windows . Forms . MenuItem 

00156         Friend WithEvents mnuAlinearNodosV As System . Windows . Forms . MenuItem 

00157         Friend WithEvents mnuAnalisisDijkstra As System . Windows . Forms . MenuItem 

00158         Friend WithEvents mnuAnalisisDijkstraMax As System . Windows . Forms . MenuItem 

00159         Friend WithEvents mnuAnalisisDijkstraCC As System . Windows . Forms . MenuItem 

00160         Friend WithEvents mnuAnalisisDijkstraCM As System . Windows . Forms . MenuItem 

00161         Friend WithEvents MenuItem4 As System . Windows . Forms . MenuItem 

00162         Friend WithEvents MenuItem7 As System . Windows . Forms . MenuItem 

00163         Friend WithEvents mnuAnalisisBellmanFordCmin As System . Windows . Forms . MenuItem 

00164         Friend WithEvents mnuAnalisisBellmanFordCmax As System . Windows . Forms . MenuItem 

00165         Friend WithEvents MenuItem9 As System . Windows . Forms . MenuItem 

00166         Friend WithEvents mnuAnalisisKruskalmin As System . Windows . Forms . MenuItem 

00167         Friend WithEvents mnuAnalisisKruskalmax As System . Windows . Forms . MenuItem 

00168         Friend WithEvents mnuFormatoFlujo As System . Windows . Forms . MenuItem 

00169         Friend WithEvents MenuItem10 As System . Windows . Forms . MenuItem 

00170         Friend WithEvents mnuAnalisisPrimMin As System . Windows . Forms . MenuItem 

00171         Friend WithEvents mnuAnalisisPrimMax As System . Windows . Forms . MenuItem 

00172         Friend WithEvents MenuItem12 As System . Windows . Forms . MenuItem 

00173         Friend WithEvents mnuFormatoAjustar As System . Windows . Forms . MenuItem 

00174         Friend WithEvents mnuFormatoCentrar As System . Windows . Forms . MenuItem 

00175         Friend WithEvents MenuItem15 As System . Windows . Forms . MenuItem 

00176         Friend WithEvents mnuAnalisisFordFulkersonMax As System . Windows . Forms .  

       »           MenuItem 

00177         Friend WithEvents MenuItem13 As System . Windows . Forms . MenuItem 

00178         Friend WithEvents mnuAnalisisFloydWarshallmin As System . Windows . Forms .  

       »           MenuItem 

00179         Friend WithEvents MenuItem14 As System . Windows . Forms . MenuItem 

00180         Friend WithEvents mnuAnalisis_Transbordo As System . Windows . Forms . MenuItem 

00181         'Friend WithEvents mnuAnalisis_Transporte As System.Windows.Forms.MenuItem  

00182         Friend WithEvents mnuAnalisis_TSP As System . Windows . Forms . MenuItem 

00183         Friend WithEvents mnuFormatoOrganico As System . Windows . Forms . MenuItem 

00184         Friend WithEvents mnuFormatoImantar As System . Windows . Forms . MenuItem 

00185         Friend WithEvents mnuArchivoImportarDatos As System . Windows . Forms . MenuItem 

00186         Friend WithEvents mnuArchivoExportarDatos As System . Windows . Forms . MenuItem 

00187         Friend WithEvents MenuItem20 As System . Windows . Forms . MenuItem 

00188         Friend WithEvents mnuArchivoNuevoAleatorio As System . Windows . Forms . MenuItem 

00189         Friend WithEvents filestatusbar As System . Windows . Forms . StatusBarPanel 

00190         Friend WithEvents mnuFormatoAutoRadio As System . Windows . Forms . MenuItem 

00191         Friend WithEvents mnuFormatoAutoTrazo As System . Windows . Forms . MenuItem 

00192         Friend WithEvents MenuItem18 As System . Windows . Forms . MenuItem 

00193         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00194             Dim resources As System . Resources . ResourceManager = New System . Resources  

       »               . ResourceManager ( GetType ( Form1 )) 

00195             Me . MainMenu1 = New System . Windows . Forms . MainMenu 

00196             Me . MenuItem1 = New System . Windows . Forms . MenuItem 

00197             Me . mnuArchivoNuevo = New System . Windows . Forms . MenuItem 

00198             Me . mnuArchivoNuevoAleatorio = New System . Windows . Forms . MenuItem 

00199             Me . mnuArchivoAbrir = New System . Windows . Forms . MenuItem 

00200             Me . mnuArchivoImportarDatos = New System . Windows . Forms . MenuItem 

00201             Me . MenuItem8 = New System . Windows . Forms . MenuItem 

00202             Me . mnuArchivoGuardar = New System . Windows . Forms . MenuItem 

00203             Me . mnuArchivoGuardarComo = New System . Windows . Forms . MenuItem 

00204             Me . mnuArchivoExportarDatos = New System . Windows . Forms . MenuItem 

00205             Me . MenuItem20 = New System . Windows . Forms . MenuItem 

00206             Me . mnuArchivoCopiarImg = New System . Windows . Forms . MenuItem 

00207             Me . mnuArchivoExportarImg = New System . Windows . Forms . MenuItem 

00208             Me . mnuEdicion2 = New System . Windows . Forms . MenuItem 

00209             Me . mnuArchivoConfigurarImp = New System . Windows . Forms . MenuItem 

00210             Me . mnuArchivoConfigurarPag = New System . Windows . Forms . MenuItem 

00211             Me . mnuArchivoImprimir = New System . Windows . Forms . MenuItem 

00212             Me . MenuItem11 = New System . Windows . Forms . MenuItem 

00213             Me . mnuArchivoSalir = New System . Windows . Forms . MenuItem 

00214             Me . mnuEdicion = New System . Windows . Forms . MenuItem 

00215             Me . mnuEdicionGrafica = New System . Windows . Forms . MenuItem 

00216             Me . mnuEdicionTabular = New System . Windows . Forms . MenuItem 

00217             Me . mnuFormato = New System . Windows . Forms . MenuItem 

00218             Me . mnuFormatoOpciones = New System . Windows . Forms . MenuItem 

00219             Me . MenuItem19 = New System . Windows . Forms . MenuItem 

00220             Me . mnuFormatoRejilla = New System . Windows . Forms . MenuItem 

00221             Me . mnuFormatoIman = New System . Windows . Forms . MenuItem 

00222             Me . MenuItem15 = New System . Windows . Forms . MenuItem 

00223             Me . mnuFormatoCentrar = New System . Windows . Forms . MenuItem 

00224             Me . mnuFormatoAjustar = New System . Windows . Forms . MenuItem 

00225             Me . mnuFormatoImantar = New System . Windows . Forms . MenuItem 

00226             Me . MenuItem18 = New System . Windows . Forms . MenuItem 

00227             Me . mnuFormatoAutoRadio = New System . Windows . Forms . MenuItem 

00228             Me . mnuFormatoAutoTrazo = New System . Windows . Forms . MenuItem 

00229             Me . MenuItem6 = New System . Windows . Forms . MenuItem 

00230             Me . mnuFormatoAleatorio = New System . Windows . Forms . MenuItem 

00231             Me . mnuFormatoCircular = New System . Windows . Forms . MenuItem 

00232             Me . mnuFormatoTablero = New System . Windows . Forms . MenuItem 

00233             Me . mnuFormatoFlujo = New System . Windows . Forms . MenuItem 

00234             Me . mnuFormatoOrganico = New System . Windows . Forms . MenuItem 

00235             Me . mnuAnalisis = New System . Windows . Forms . MenuItem 

00236             Me . mnuAnalisisDijkstra = New System . Windows . Forms . MenuItem 

00237             Me . mnuAnalisisDijkstraMax = New System . Windows . Forms . MenuItem 

00238             Me . MenuItem4 = New System . Windows . Forms . MenuItem 

00239             Me . mnuAnalisisDijkstraCM = New System . Windows . Forms . MenuItem 

00240             Me . mnuAnalisisDijkstraCC = New System . Windows . Forms . MenuItem 

00241             Me . MenuItem7 = New System . Windows . Forms . MenuItem 

00242             Me . mnuAnalisisBellmanFordCmin = New System . Windows . Forms . MenuItem 

00243             Me . mnuAnalisisBellmanFordCmax = New System . Windows . Forms . MenuItem 

00244             Me . MenuItem13 = New System . Windows . Forms . MenuItem 

00245             Me . mnuAnalisisFloydWarshallmin = New System . Windows . Forms . MenuItem 

00246             Me . MenuItem9 = New System . Windows . Forms . MenuItem 

00247             Me . mnuAnalisisKruskalmin = New System . Windows . Forms . MenuItem 

00248             Me . mnuAnalisisKruskalmax = New System . Windows . Forms . MenuItem 

00249             Me . MenuItem10 = New System . Windows . Forms . MenuItem 

00250             Me . mnuAnalisisPrimMin = New System . Windows . Forms . MenuItem 

00251             Me . mnuAnalisisPrimMax = New System . Windows . Forms . MenuItem 

00252             Me . MenuItem12 = New System . Windows . Forms . MenuItem 

00253             Me . mnuAnalisisFordFulkersonMax = New System . Windows . Forms . MenuItem 

00254             Me . MenuItem14 = New System . Windows . Forms . MenuItem 

00255             Me . mnuAnalisis_Transbordo = New System . Windows . Forms . MenuItem 

00256             Me . mnuAnalisis_TSP = New System . Windows . Forms . MenuItem 

00257             Me . MenuItem5 = New System . Windows . Forms . MenuItem 

00258             Me . mnuAyudaAcercade = New System . Windows . Forms . MenuItem 

00259             Me . StatusBar = New System . Windows . Forms . StatusBar 

00260             Me . PanelX = New System . Windows . Forms . StatusBarPanel 

00261             Me . PanelY = New System . Windows . Forms . StatusBarPanel 

00262             Me . SobreObj = New System . Windows . Forms . StatusBarPanel 

00263             Me . Nd1 = New System . Windows . Forms . StatusBarPanel 

00264             Me . Nd2 = New System . Windows . Forms . StatusBarPanel 

00265             Me . z = New System . Windows . Forms . StatusBarPanel 

00266             Me . filestatusbar = New System . Windows . Forms . StatusBarPanel 

00267             Me . PictureBox1 = New System . Windows . Forms . PictureBox 

00268             Me . mnuPopUp = New System . Windows . Forms . ContextMenu 

00269             Me . mnuAñadirNodo = New System . Windows . Forms . MenuItem 

00270             Me . mnuEditarNodo = New System . Windows . Forms . MenuItem 

00271             Me . mnuBorrarNodo = New System . Windows . Forms . MenuItem 

00272             Me . mnuAlinearNodos = New System . Windows . Forms . MenuItem 

00273             Me . mnuAlinearNodosH = New System . Windows . Forms . MenuItem 

00274             Me . mnuAlinearNodosV = New System . Windows . Forms . MenuItem 

00275             Me . mnuEdicion4 = New System . Windows . Forms . MenuItem 

00276             Me . mnuAñadirArco = New System . Windows . Forms . MenuItem 

00277             Me . mnuEditarArco = New System . Windows . Forms . MenuItem 

00278             Me . mnuBorrarArco = New System . Windows . Forms . MenuItem 

00279             Me . mnuEdicion8 = New System . Windows . Forms . MenuItem 

00280             Me . mnuZoomMas = New System . Windows . Forms . MenuItem 

00281             Me . mnuZoomMenos = New System . Windows . Forms . MenuItem 

00282             Me . mnuZoomAjustar = New System . Windows . Forms . MenuItem 

00283             Me . Panel1 = New System . Windows . Forms . Panel 

00284             Me . TextBox1 = New System . Windows . Forms . TextBox 

00285             Me . mnuPopTabla = New System . Windows . Forms . ContextMenu 

00286             Me . mnuTablaAñadirNodo = New System . Windows . Forms . MenuItem 

00287             Me . mnuTablaBorrarNodo = New System . Windows . Forms . MenuItem 

00288             Me . MenuItem2 = New System . Windows . Forms . MenuItem 

00289             Me . mnuTablaTotalNodos = New System . Windows . Forms . MenuItem 

00290             Me . MenuItem3 = New System . Windows . Forms . MenuItem 

00291             Me . mnuTablaCopiarTabla = New System . Windows . Forms . MenuItem 

00292             Me . hfgTabla = New AxMSFlexGridLib . AxMSFlexGrid 

00293             Me . PrintDialog1 = New System . Windows . Forms . PrintDialog 

00294             Me . PrintPreviewDialog1 = New System . Windows . Forms . PrintPreviewDialog 

00295             Me . PrintDocument1 = New System . Drawing . Printing . PrintDocument 

00296             CType ( Me . PanelX , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00297             CType ( Me . PanelY , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00298             CType ( Me . SobreObj , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00299             CType ( Me . Nd1 , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00300             CType ( Me . Nd2 , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00301             CType ( Me . z , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00302             CType ( Me . filestatusbar , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00303             Me . Panel1 . SuspendLayout () 

00304             CType ( Me . hfgTabla , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00305             Me . SuspendLayout () 

00306             '  

00307             'MainMenu1  

00308             '  

00309             Me . MainMenu1 . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () { Me .  

       »               MenuItem1 , Me . mnuEdicion , Me . mnuFormato , Me . mnuAnalisis , Me . MenuItem5  

       »               }) 

00310             '  

00311             'MenuItem1  

00312             '  

00313             Me . MenuItem1 . Index = 0 

00314             Me . MenuItem1 . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () { Me .  

       »               mnuArchivoNuevo , Me . mnuArchivoNuevoAleatorio , Me . mnuArchivoAbrir , Me .  

       »               mnuArchivoImportarDatos , Me . MenuItem8 , Me . mnuArchivoGuardar , Me .  

       »               mnuArchivoGuardarComo , Me . mnuArchivoExportarDatos , Me . MenuItem20 , Me .  

       »               mnuArchivoCopiarImg , Me . mnuArchivoExportarImg , Me . mnuEdicion2 , Me .  

       »               mnuArchivoConfigurarImp , Me . mnuArchivoConfigurarPag , Me .  

       »               mnuArchivoImprimir , Me . MenuItem11 , Me . mnuArchivoSalir }) 

00315             Me . MenuItem1 . Text = "&Archivo" 

00316             '  

00317             'mnuArchivoNuevo  

00318             '  

00319             Me . mnuArchivoNuevo . Index = 0 

00320             Me . mnuArchivoNuevo . Shortcut = System . Windows . Forms . Shortcut . CtrlU 

00321             Me . mnuArchivoNuevo . Text = "&Nuevo" 

00322             '  

00323             'mnuArchivoNuevoAleatorio  

00324             '  

00325             Me . mnuArchivoNuevoAleatorio . Index = 1 

00326             Me . mnuArchivoNuevoAleatorio . Text = "Crear alea&torio..." 

00327             '  

00328             'mnuArchivoAbrir  

00329             '  

00330             Me . mnuArchivoAbrir . Index = 2 

00331             Me . mnuArchivoAbrir . Shortcut = System . Windows . Forms . Shortcut . CtrlA 

00332             Me . mnuArchivoAbrir . Text = "&Abrir" 

00333             '  

00334             'mnuArchivoImportarDatos  

00335             '  

00336             Me . mnuArchivoImportarDatos . Enabled = False 

00337             Me . mnuArchivoImportarDatos . Index = 3 

00338             Me . mnuArchivoImportarDatos . Text = "I&mportar datos..." 

00339             '  

00340             'MenuItem8  

00341             '  

00342             Me . MenuItem8 . Index = 4 

00343             Me . MenuItem8 . Text = "-" 

00344             '  

00345             'mnuArchivoGuardar  

00346             '  

00347             Me . mnuArchivoGuardar . Enabled = False 

00348             Me . mnuArchivoGuardar . Index = 5 

00349             Me . mnuArchivoGuardar . Shortcut = System . Windows . Forms . Shortcut . CtrlG 

00350             Me . mnuArchivoGuardar . Text = "&Guardar" 

00351             '  

00352             'mnuArchivoGuardarComo  

00353             '  

00354             Me . mnuArchivoGuardarComo . Enabled = False 

00355             Me . mnuArchivoGuardarComo . Index = 6 

00356             Me . mnuArchivoGuardarComo . Text = "G&uardar como..." 

00357             '  

00358             'mnuArchivoExportarDatos  

00359             '  

00360             Me . mnuArchivoExportarDatos . Enabled = False 

00361             Me . mnuArchivoExportarDatos . Index = 7 

00362             Me . mnuArchivoExportarDatos . Text = "Exportar &datos..." 

00363             '  

00364             'MenuItem20  

00365             '  

00366             Me . MenuItem20 . Index = 8 

00367             Me . MenuItem20 . Text = "-" 

00368             '  

00369             'mnuArchivoCopiarImg  

00370             '  

00371             Me . mnuArchivoCopiarImg . Enabled = False 

00372             Me . mnuArchivoCopiarImg . Index = 9 

00373             Me . mnuArchivoCopiarImg . Shortcut = System . Windows . Forms . Shortcut . CtrlC 

00374             Me . mnuArchivoCopiarImg . Text = "&Copiar imagen" 

00375             '  

00376             'mnuArchivoExportarImg  

00377             '  

00378             Me . mnuArchivoExportarImg . Enabled = False 

00379             Me . mnuArchivoExportarImg . Index = 10 

00380             Me . mnuArchivoExportarImg . Shortcut = System . Windows . Forms . Shortcut . CtrlE 

00381             Me . mnuArchivoExportarImg . Text = "&Exportar imagen..." 

00382             '  

00383             'mnuEdicion2  

00384             '  

00385             Me . mnuEdicion2 . Index = 11 

00386             Me . mnuEdicion2 . Text = "-" 

00387             '  

00388             'mnuArchivoConfigurarImp  

00389             '  

00390             Me . mnuArchivoConfigurarImp . Index = 12 

00391             Me . mnuArchivoConfigurarImp . Text = "C&onfigurar impresora..." 

00392             '  

00393             'mnuArchivoConfigurarPag  

00394             '  

00395             Me . mnuArchivoConfigurarPag . Enabled = False 

00396             Me . mnuArchivoConfigurarPag . Index = 13 

00397             Me . mnuArchivoConfigurarPag . Text = "Con&figurar página..." 

00398             '  

00399             'mnuArchivoImprimir  

00400             '  

00401             Me . mnuArchivoImprimir . Enabled = False 

00402             Me . mnuArchivoImprimir . Index = 14 

00403             Me . mnuArchivoImprimir . Shortcut = System . Windows . Forms . Shortcut . CtrlP 

00404             Me . mnuArchivoImprimir . Text = "&Imprimir..." 

00405             '  

00406             'MenuItem11  

00407             '  

00408             Me . MenuItem11 . Index = 15 

00409             Me . MenuItem11 . Text = "-" 

00410             '  

00411             'mnuArchivoSalir  

00412             '  

00413             Me . mnuArchivoSalir . Index = 16 

00414             Me . mnuArchivoSalir . Text = "&Salir" 

00415             '  

00416             'mnuEdicion  

00417             '  

00418             Me . mnuEdicion . Enabled = False 

00419             Me . mnuEdicion . Index = 1 

00420             Me . mnuEdicion . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () { Me  

       »               . mnuEdicionGrafica , Me . mnuEdicionTabular }) 

00421             Me . mnuEdicion . Text = "&Edición" 

00422             '  

00423             'mnuEdicionGrafica  

00424             '  

00425             Me . mnuEdicionGrafica . Checked = True 

00426             Me . mnuEdicionGrafica . Index = 0 

00427             Me . mnuEdicionGrafica . RadioCheck = True 

00428             Me . mnuEdicionGrafica . Text = "&Gráfica" 

00429             '  

00430             'mnuEdicionTabular  

00431             '  

00432             Me . mnuEdicionTabular . Index = 1 

00433             Me . mnuEdicionTabular . RadioCheck = True 

00434             Me . mnuEdicionTabular . Text = "&Tabular" 

00435             '  

00436             'mnuFormato  

00437             '  

00438             Me . mnuFormato . Enabled = False 

00439             Me . mnuFormato . Index = 2 

00440             Me . mnuFormato . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () { Me  

       »               . mnuFormatoOpciones , Me . MenuItem19 , Me . mnuFormatoRejilla , Me .  

       »               mnuFormatoIman , Me . MenuItem15 , Me . mnuFormatoCentrar , Me .  

       »               mnuFormatoAjustar , Me . mnuFormatoImantar , Me . MenuItem18 , Me .  

       »               mnuFormatoAutoRadio , Me . mnuFormatoAutoTrazo , Me . MenuItem6 , Me .  

       »               mnuFormatoAleatorio , Me . mnuFormatoCircular , Me . mnuFormatoTablero , Me .  

       »               mnuFormatoFlujo , Me . mnuFormatoOrganico }) 

00441             Me . mnuFormato . Text = "&Formato" 

00442             '  

00443             'mnuFormatoOpciones  

00444             '  

00445             Me . mnuFormatoOpciones . Enabled = False 

00446             Me . mnuFormatoOpciones . Index = 0 

00447             Me . mnuFormatoOpciones . Shortcut = System . Windows . Forms . Shortcut . CtrlO 

00448             Me . mnuFormatoOpciones . Text = "&Opciones..." 

00449             '  

00450             'MenuItem19  

00451             '  

00452             Me . MenuItem19 . Index = 1 

00453             Me . MenuItem19 . Text = "-" 

00454             '  

00455             'mnuFormatoRejilla  

00456             '  

00457             Me . mnuFormatoRejilla . Checked = True 

00458             Me . mnuFormatoRejilla . Index = 2 

00459             Me . mnuFormatoRejilla . Shortcut = System . Windows . Forms . Shortcut . CtrlR 

00460             Me . mnuFormatoRejilla . Text = "&Rejilla" 

00461             '  

00462             'mnuFormatoIman  

00463             '  

00464             Me . mnuFormatoIman . Checked = True 

00465             Me . mnuFormatoIman . Index = 3 

00466             Me . mnuFormatoIman . Shortcut = System . Windows . Forms . Shortcut . CtrlI 

00467             Me . mnuFormatoIman . Text = "&Imán" 

00468             '  

00469             'MenuItem15  

00470             '  

00471             Me . MenuItem15 . Index = 4 

00472             Me . MenuItem15 . Text = "-" 

00473             '  

00474             'mnuFormatoCentrar  

00475             '  

00476             Me . mnuFormatoCentrar . Index = 5 

00477             Me . mnuFormatoCentrar . Text = "&Centrar grafo" 

00478             '  

00479             'mnuFormatoAjustar  

00480             '  

00481             Me . mnuFormatoAjustar . Index = 6 

00482             Me . mnuFormatoAjustar . Text = "&Ajustar tapiz" 

00483             '  

00484             'mnuFormatoImantar  

00485             '  

00486             Me . mnuFormatoImantar . Index = 7 

00487             Me . mnuFormatoImantar . Text = "I&mantar" 

00488             '  

00489             'MenuItem18  

00490             '  

00491             Me . MenuItem18 . Index = 8 

00492             Me . MenuItem18 . Text = "-" 

00493             '  

00494             'mnuFormatoAutoRadio  

00495             '  

00496             Me . mnuFormatoAutoRadio . Index = 9 

00497             Me . mnuFormatoAutoRadio . Text = "&1 Auto-radio nodos (valor)" 

00498             '  

00499             'mnuFormatoAutoTrazo  

00500             '  

00501             Me . mnuFormatoAutoTrazo . Index = 10 

00502             Me . mnuFormatoAutoTrazo . Text = "&2 Auto-trazo arcos (coste)" 

00503             '  

00504             'MenuItem6  

00505             '  

00506             Me . MenuItem6 . Index = 11 

00507             Me . MenuItem6 . Text = "-" 

00508             '  

00509             'mnuFormatoAleatorio  

00510             '  

00511             Me . mnuFormatoAleatorio . Index = 12 

00512             Me . mnuFormatoAleatorio . RadioCheck = True 

00513             Me . mnuFormatoAleatorio . Text = "A&leatorio" 

00514             '  

00515             'mnuFormatoCircular  

00516             '  

00517             Me . mnuFormatoCircular . Checked = True 

00518             Me . mnuFormatoCircular . Index = 13 

00519             Me . mnuFormatoCircular . RadioCheck = True 

00520             Me . mnuFormatoCircular . Text = "Circ&ular" 

00521             '  

00522             'mnuFormatoTablero  

00523             '  

00524             Me . mnuFormatoTablero . Index = 14 

00525             Me . mnuFormatoTablero . RadioCheck = True 

00526             Me . mnuFormatoTablero . Text = "&Tablero" 

00527             '  

00528             'mnuFormatoFlujo  

00529             '  

00530             Me . mnuFormatoFlujo . Index = 15 

00531             Me . mnuFormatoFlujo . RadioCheck = True 

00532             Me . mnuFormatoFlujo . Text = "&Flujo" 

00533             '  

00534             'mnuFormatoOrganico  

00535             '  

00536             Me . mnuFormatoOrganico . Index = 16 

00537             Me . mnuFormatoOrganico . Text = "Or&gánico" 

00538             '  

00539             'mnuAnalisis  

00540             '  

00541             Me . mnuAnalisis . Enabled = False 

00542             Me . mnuAnalisis . Index = 3 

00543             Me . mnuAnalisis . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () {  

       »               Me . mnuAnalisisDijkstra , Me . mnuAnalisisDijkstraMax , Me . MenuItem4 , Me .  

       »               mnuAnalisisDijkstraCM , Me . mnuAnalisisDijkstraCC , Me . MenuItem7 , Me .  

       »               mnuAnalisisBellmanFordCmin , Me . mnuAnalisisBellmanFordCmax , Me .  

       »               MenuItem13 , Me . mnuAnalisisFloydWarshallmin , Me . MenuItem9 , Me .  

       »               mnuAnalisisKruskalmin , Me . mnuAnalisisKruskalmax , Me . MenuItem10 , Me .  

       »               mnuAnalisisPrimMin , Me . mnuAnalisisPrimMax , Me . MenuItem12 , Me .  

       »               mnuAnalisisFordFulkersonMax , Me . MenuItem14 , Me . mnuAnalisis_Transbordo  

       »               , Me . mnuAnalisis_TSP }) 

00544             Me . mnuAnalisis . Text = "A&nálisis" 

00545             '  

00546             'mnuAnalisisDijkstra  

00547             '  

00548             Me . mnuAnalisisDijkstra . Enabled = False 

00549             Me . mnuAnalisisDijkstra . Index = 0 

00550             Me . mnuAnalisisDijkstra . Text = "Árbol mínimo - Alg. Dijkstra (Nd1)" 

00551             '  

00552             'mnuAnalisisDijkstraMax  

00553             '  

00554             Me . mnuAnalisisDijkstraMax . Enabled = False 

00555             Me . mnuAnalisisDijkstraMax . Index = 1 

00556             Me . mnuAnalisisDijkstraMax . Text = "Árbol máximo - Alg. Dijkstra (Nd1)" 

00557             '  

00558             'MenuItem4  

00559             '  

00560             Me . MenuItem4 . Index = 2 

00561             Me . MenuItem4 . Text = "-" 

00562             '  

00563             'mnuAnalisisDijkstraCM  

00564             '  

00565             Me . mnuAnalisisDijkstraCM . Enabled = False 

00566             Me . mnuAnalisisDijkstraCM . Index = 3 

00567             Me . mnuAnalisisDijkstraCM . Text = "Camino mínimo - Alg. Dijkstra  

       »               (Nd1-Nd2)" 

00568             '  

00569             'mnuAnalisisDijkstraCC  

00570             '  

00571             Me . mnuAnalisisDijkstraCC . Enabled = False 

00572             Me . mnuAnalisisDijkstraCC . Index = 4 

00573             Me . mnuAnalisisDijkstraCC . Text = "Camino crítico - Alg. Dijkstra  

       »               (Nd1-Nd2)" 

00574             '  

00575             'MenuItem7  

00576             '  

00577             Me . MenuItem7 . Index = 5 

00578             Me . MenuItem7 . Text = "-" 

00579             '  

00580             'mnuAnalisisBellmanFordCmin  

00581             '  

00582             Me . mnuAnalisisBellmanFordCmin . Enabled = False 

00583             Me . mnuAnalisisBellmanFordCmin . Index = 6 

00584             Me . mnuAnalisisBellmanFordCmin . Text = "Camino mínimo - Alg. BellmanFord  

       »               (Nd1-Nd2)" 

00585             '  

00586             'mnuAnalisisBellmanFordCmax  

00587             '  

00588             Me . mnuAnalisisBellmanFordCmax . Enabled = False 

00589             Me . mnuAnalisisBellmanFordCmax . Index = 7 

00590             Me . mnuAnalisisBellmanFordCmax . Text = "Camino máximo - Alg. BellmanFord  

       »               (Nd1-Nd2)" 

00591             '  

00592             'MenuItem13  

00593             '  

00594             Me . MenuItem13 . Index = 8 

00595             Me . MenuItem13 . Text = "-" 

00596             '  

00597             'mnuAnalisisFloydWarshallmin  

00598             '  

00599             Me . mnuAnalisisFloydWarshallmin . Enabled = False 

00600             Me . mnuAnalisisFloydWarshallmin . Index = 9 

00601             Me . mnuAnalisisFloydWarshallmin . Text = "Todos los Caminos mínimos - Alg.  

       »               FloydWarshall" 

00602             '  

00603             'MenuItem9  

00604             '  

00605             Me . MenuItem9 . Index = 10 

00606             Me . MenuItem9 . Text = "-" 

00607             '  

00608             'mnuAnalisisKruskalmin  

00609             '  

00610             Me . mnuAnalisisKruskalmin . Enabled = False 

00611             Me . mnuAnalisisKruskalmin . Index = 11 

00612             Me . mnuAnalisisKruskalmin . Text = "Árbol de valor total mínimo - Alg.  

       »               Kruskal" 

00613             '  

00614             'mnuAnalisisKruskalmax  

00615             '  

00616             Me . mnuAnalisisKruskalmax . Enabled = False 

00617             Me . mnuAnalisisKruskalmax . Index = 12 

00618             Me . mnuAnalisisKruskalmax . Text = "Árbol de valor total máximo - Alg.  

       »               Kruskal" 

00619             '  

00620             'MenuItem10  

00621             '  

00622             Me . MenuItem10 . Index = 13 

00623             Me . MenuItem10 . Text = "-" 

00624             '  

00625             'mnuAnalisisPrimMin  

00626             '  

00627             Me . mnuAnalisisPrimMin . Enabled = False 

00628             Me . mnuAnalisisPrimMin . Index = 14 

00629             Me . mnuAnalisisPrimMin . Text = "Árbol de valor total mínimo - Alg. Prim" 

00630             '  

00631             'mnuAnalisisPrimMax  

00632             '  

00633             Me . mnuAnalisisPrimMax . Enabled = False 

00634             Me . mnuAnalisisPrimMax . Index = 15 

00635             Me . mnuAnalisisPrimMax . Text = "Árbol de valor total máximo - Alg. Prim" 

00636             '  

00637             'MenuItem12  

00638             '  

00639             Me . MenuItem12 . Index = 16 

00640             Me . MenuItem12 . Text = "-" 

00641             '  

00642             'mnuAnalisisFordFulkersonMax  

00643             '  

00644             Me . mnuAnalisisFordFulkersonMax . Enabled = False 

00645             Me . mnuAnalisisFordFulkersonMax . Index = 17 

00646             Me . mnuAnalisisFordFulkersonMax . Text = "Flujo máximo - Alg. FordFulkerson 

       »               (Nd1-Nd2)" 

00647             '  

00648             'MenuItem14  

00649             '  

00650             Me . MenuItem14 . Index = 18 

00651             Me . MenuItem14 . Text = "-" 

00652             '  

00653             'mnuAnalisis_Transbordo  

00654             '  

00655             Me . mnuAnalisis_Transbordo . Enabled = False 

00656             Me . mnuAnalisis_Transbordo . Index = 19 

00657             Me . mnuAnalisis_Transbordo . Text = "Transbordo a coste mínimo - LP  

       »               (equilibrado)" 

00658             '  

00659             'mnuAnalisis_TSP  

00660             '  

00661             Me . mnuAnalisis_TSP . Enabled = False 

00662             Me . mnuAnalisis_TSP . Index = 20 

00663             Me . mnuAnalisis_TSP . Text = "Viajante de Comercio - MILP" 

00664             '  

00665             'MenuItem5  

00666             '  

00667             Me . MenuItem5 . Index = 4 

00668             Me . MenuItem5 . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () { Me .  

       »               mnuAyudaAcercade }) 

00669             Me . MenuItem5 . Text = "Ay&uda" 

00670             '  

00671             'mnuAyudaAcercade  

00672             '  

00673             Me . mnuAyudaAcercade . Index = 0 

00674             Me . mnuAyudaAcercade . Text = "&Acerca de..." 

00675             '  

00676             'StatusBar  

00677             '  

00678             Me . StatusBar . Location = New System . Drawing . Point ( 0 , 346 ) 

00679             Me . StatusBar . Name = "StatusBar" 

00680             Me . StatusBar . Panels . AddRange ( New System . Windows . Forms . StatusBarPanel () {  

       »               Me . PanelX , Me . PanelY , Me . SobreObj , Me . Nd1 , Me . Nd2 , Me . z , Me .  

       »               filestatusbar }) 

00681             Me . StatusBar . ShowPanels = True 

00682             Me . StatusBar . Size = New System . Drawing . Size ( 624 , 16 ) 

00683             Me . StatusBar . TabIndex = 0 

00684             Me . StatusBar . Text = "StatusBar1" 

00685             '  

00686             'PanelX  

00687             '  

00688             Me . PanelX . BorderStyle = System . Windows . Forms . StatusBarPanelBorderStyle .  

       »               None 

00689             Me . PanelX . MinWidth = 60 

00690             Me . PanelX . Width = 60 

00691             '  

00692             'PanelY  

00693             '  

00694             Me . PanelY . BorderStyle = System . Windows . Forms . StatusBarPanelBorderStyle .  

       »               None 

00695             Me . PanelY . MinWidth = 60 

00696             Me . PanelY . Width = 60 

00697             '  

00698             'SobreObj  

00699             '  

00700             Me . SobreObj . BorderStyle = System . Windows . Forms . StatusBarPanelBorderStyle  

       »               . None 

00701             Me . SobreObj . MinWidth = 120 

00702             Me . SobreObj . Width = 120 

00703             '  

00704             'Nd1  

00705             '  

00706             Me . Nd1 . MinWidth = 100 

00707             '  

00708             'Nd2  

00709             '  

00710             Me . Nd2 . MinWidth = 100 

00711             '  

00712             'z  

00713             '  

00714             Me . z . BorderStyle = System . Windows . Forms . StatusBarPanelBorderStyle . None 

00715             Me . z . MinWidth = 120 

00716             Me . z . Width = 120 

00717             '  

00718             'filestatusbar  

00719             '  

00720             Me . filestatusbar . AutoSize = System . Windows . Forms . StatusBarPanelAutoSize .  

       »               Spring 

00721             Me . filestatusbar . Width = 48 

00722             '  

00723             'PictureBox1  

00724             '  

00725             Me . PictureBox1 . BackColor = System . Drawing . Color . White 

00726             Me . PictureBox1 . BorderStyle = System . Windows . Forms . BorderStyle .  

       »               FixedSingle 

00727             Me . PictureBox1 . ContextMenu = Me . mnuPopUp 

00728             Me . PictureBox1 . Cursor = System . Windows . Forms . Cursors . Cross 

00729             Me . PictureBox1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00730             Me . PictureBox1 . Name = "PictureBox1" 

00731             Me . PictureBox1 . Size = New System . Drawing . Size ( 168 , 160 ) 

00732             Me . PictureBox1 . SizeMode = System . Windows . Forms . PictureBoxSizeMode .  

       »               CenterImage 

00733             Me . PictureBox1 . TabIndex = 1 

00734             Me . PictureBox1 . TabStop = False 

00735             Me . PictureBox1 . Visible = False 

00736             '  

00737             'mnuPopUp  

00738             '  

00739             Me . mnuPopUp . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () { Me .  

       »               mnuAñadirNodo , Me . mnuEditarNodo , Me . mnuBorrarNodo , Me . mnuAlinearNodos  

       »               , Me . mnuEdicion4 , Me . mnuAñadirArco , Me . mnuEditarArco , Me .  

       »               mnuBorrarArco , Me . mnuEdicion8 , Me . mnuZoomMas , Me . mnuZoomMenos , Me .  

       »               mnuZoomAjustar }) 

00740             '  

00741             'mnuAñadirNodo  

00742             '  

00743             Me . mnuAñadirNodo . Index = 0 

00744             Me . mnuAñadirNodo . Text = "Añadir Nodo" 

00745             '  

00746             'mnuEditarNodo  

00747             '  

00748             Me . mnuEditarNodo . Index = 1 

00749             Me . mnuEditarNodo . Text = "Editar Nodo" 

00750             '  

00751             'mnuBorrarNodo  

00752             '  

00753             Me . mnuBorrarNodo . Index = 2 

00754             Me . mnuBorrarNodo . Text = "Borrar Nodo" 

00755             '  

00756             'mnuAlinearNodos  

00757             '  

00758             Me . mnuAlinearNodos . Index = 3 

00759             Me . mnuAlinearNodos . MenuItems . AddRange ( New System . Windows . Forms . MenuItem ( 

       »               ) { Me . mnuAlinearNodosH , Me . mnuAlinearNodosV }) 

00760             Me . mnuAlinearNodos . Text = "Alinear Nodos" 

00761             '  

00762             'mnuAlinearNodosH  

00763             '  

00764             Me . mnuAlinearNodosH . Index = 0 

00765             Me . mnuAlinearNodosH . Text = "Horizontalmente" 

00766             '  

00767             'mnuAlinearNodosV  

00768             '  

00769             Me . mnuAlinearNodosV . Index = 1 

00770             Me . mnuAlinearNodosV . Text = "Verticalmente" 

00771             '  

00772             'mnuEdicion4  

00773             '  

00774             Me . mnuEdicion4 . Index = 4 

00775             Me . mnuEdicion4 . Text = "-" 

00776             '  

00777             'mnuAñadirArco  

00778             '  

00779             Me . mnuAñadirArco . Index = 5 

00780             Me . mnuAñadirArco . Text = "Añadir Arco" 

00781             '  

00782             'mnuEditarArco  

00783             '  

00784             Me . mnuEditarArco . Index = 6 

00785             Me . mnuEditarArco . Text = "Editar Arco" 

00786             '  

00787             'mnuBorrarArco  

00788             '  

00789             Me . mnuBorrarArco . Index = 7 

00790             Me . mnuBorrarArco . Text = "Borrar Arco" 

00791             '  

00792             'mnuEdicion8  

00793             '  

00794             Me . mnuEdicion8 . Index = 8 

00795             Me . mnuEdicion8 . Text = "-" 

00796             '  

00797             'mnuZoomMas  

00798             '  

00799             Me . mnuZoomMas . Index = 9 

00800             Me . mnuZoomMas . Text = "Zoom +" 

00801             '  

00802             'mnuZoomMenos  

00803             '  

00804             Me . mnuZoomMenos . Index = 10 

00805             Me . mnuZoomMenos . Text = "Zoom -" 

00806             '  

00807             'mnuZoomAjustar  

00808             '  

00809             Me . mnuZoomAjustar . Index = 11 

00810             Me . mnuZoomAjustar . Text = "Zoom ajustado" 

00811             '  

00812             'Panel1  

00813             '  

00814             Me . Panel1 . AutoScroll = True 

00815             Me . Panel1 . AutoScrollMinSize = New System . Drawing . Size ( 20 , 20 ) 

00816             Me . Panel1 . BorderStyle = System . Windows . Forms . BorderStyle . Fixed3D 

00817             Me . Panel1 . Controls . Add ( Me . PictureBox1 ) 

00818             Me . Panel1 . Controls . Add ( Me . TextBox1 ) 

00819             Me . Panel1 . Controls . Add ( Me . hfgTabla ) 

00820             Me . Panel1 . Dock = System . Windows . Forms . DockStyle . Fill 

00821             Me . Panel1 . Font = New System . Drawing . Font ( "Verdana" , 9.75 !, System .  

       »               Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point , CType ( 0  

       »               , Byte )) 

00822             Me . Panel1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00823             Me . Panel1 . Name = "Panel1" 

00824             Me . Panel1 . Size = New System . Drawing . Size ( 624 , 346 ) 

00825             Me . Panel1 . TabIndex = 3 

00826             '  

00827             'TextBox1  

00828             '  

00829             Me . TextBox1 . AutoSize = False 

00830             Me . TextBox1 . BackColor = System . Drawing . Color . FromArgb ( CType ( 255 , Byte ), 

       »               CType ( 255 , Byte ), CType ( 192 , Byte )) 

00831             Me . TextBox1 . BorderStyle = System . Windows . Forms . BorderStyle . FixedSingle 

00832             Me . TextBox1 . ContextMenu = Me . mnuPopTabla 

00833             Me . TextBox1 . Font = New System . Drawing . Font ( "Verdana" , 9.75 !, System .  

       »               Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point , CType ( 0  

       »               , Byte )) 

00834             Me . TextBox1 . HideSelection = False 

00835             Me . TextBox1 . Location = New System . Drawing . Point ( 432 , 96 ) 

00836             Me . TextBox1 . Name = "TextBox1" 

00837             Me . TextBox1 . Size = New System . Drawing . Size ( 88 , 20 ) 

00838             Me . TextBox1 . TabIndex = 2 

00839             Me . TextBox1 . Text = "TextBox1" 

00840             Me . TextBox1 . TextAlign = System . Windows . Forms . HorizontalAlignment . Right 

00841             Me . TextBox1 . Visible = False 

00842             '  

00843             'mnuPopTabla  

00844             '  

00845             Me . mnuPopTabla . MenuItems . AddRange ( New System . Windows . Forms . MenuItem () {  

       »               Me . mnuTablaAñadirNodo , Me . mnuTablaBorrarNodo , Me . MenuItem2 , Me .  

       »               mnuTablaTotalNodos , Me . MenuItem3 , Me . mnuTablaCopiarTabla }) 

00846             '  

00847             'mnuTablaAñadirNodo  

00848             '  

00849             Me . mnuTablaAñadirNodo . Index = 0 

00850             Me . mnuTablaAñadirNodo . Text = "Añadir Nodo" 

00851             '  

00852             'mnuTablaBorrarNodo  

00853             '  

00854             Me . mnuTablaBorrarNodo . Index = 1 

00855             Me . mnuTablaBorrarNodo . Text = "Borrar Nodo" 

00856             '  

00857             'MenuItem2  

00858             '  

00859             Me . MenuItem2 . Index = 2 

00860             Me . MenuItem2 . Text = "-" 

00861             '  

00862             'mnuTablaTotalNodos  

00863             '  

00864             Me . mnuTablaTotalNodos . Index = 3 

00865             Me . mnuTablaTotalNodos . Text = "Total Nodos..." 

00866             '  

00867             'MenuItem3  

00868             '  

00869             Me . MenuItem3 . Index = 4 

00870             Me . MenuItem3 . Text = "-" 

00871             '  

00872             'mnuTablaCopiarTabla  

00873             '  

00874             Me . mnuTablaCopiarTabla . Index = 5 

00875             Me . mnuTablaCopiarTabla . Text = "Copiar Tabla" 

00876             '  

00877             'hfgTabla  

00878             '  

00879             Me . hfgTabla . ContainingControl = Me 

00880             Me . hfgTabla . Location = New System . Drawing . Point ( 152 , 64 ) 

00881             Me . hfgTabla . Name = "hfgTabla" 

00882             Me . hfgTabla . OcxState = CType ( resources . GetObject ( "hfgTabla.OcxState" ),  

       »               System . Windows . Forms . AxHost . State ) 

00883             Me . hfgTabla . Size = New System . Drawing . Size ( 224 , 144 ) 

00884             Me . hfgTabla . TabIndex = 4 

00885             Me . hfgTabla . Visible = False 

00886             '  

00887             'PrintPreviewDialog1  

00888             '  

00889             Me . PrintPreviewDialog1 . AutoScrollMargin = New System . Drawing . Size ( 0 , 0 ) 

00890             Me . PrintPreviewDialog1 . AutoScrollMinSize = New System . Drawing . Size ( 0 , 0 ) 

00891             Me . PrintPreviewDialog1 . ClientSize = New System . Drawing . Size ( 400 , 300 ) 

00892             Me . PrintPreviewDialog1 . Enabled = True 

00893             Me . PrintPreviewDialog1 . Icon = CType ( resources . GetObject (  

       »               "PrintPreviewDialog1.Icon" ), System . Drawing . Icon ) 

00894             Me . PrintPreviewDialog1 . Location = New System . Drawing . Point ( 462 , 17 ) 

00895             Me . PrintPreviewDialog1 . MinimumSize = New System . Drawing . Size ( 375 , 250 ) 

00896             Me . PrintPreviewDialog1 . Name = "PrintPreviewDialog1" 

00897             Me . PrintPreviewDialog1 . TransparencyKey = System . Drawing . Color . Empty 

00898             Me . PrintPreviewDialog1 . Visible = False 

00899             '  

00900             'PrintDocument1  

00901             '  

00902             '  

00903             'Form1  

00904             '  

00905             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00906             Me . AutoScroll = True 

00907             Me . ClientSize = New System . Drawing . Size ( 624 , 362 ) 

00908             Me . Controls . Add ( Me . Panel1 ) 

00909             Me . Controls . Add ( Me . StatusBar ) 

00910             Me . Icon = CType ( resources . GetObject ( "$this.Icon" ), System . Drawing . Icon ) 

00911             Me . Menu = Me . MainMenu1 

00912             Me . Name = "Form1" 

00913             Me . StartPosition = System . Windows . Forms . FormStartPosition . CenterScreen 

00914             Me . Text = "Grafos - (cc) 2003..2005 - Alejandro Rodríguez Villalobos " 

00915             Me . WindowState = System . Windows . Forms . FormWindowState . Maximized 

00916             CType ( Me . PanelX , System . ComponentModel . ISupportInitialize ) . EndInit () 

00917             CType ( Me . PanelY , System . ComponentModel . ISupportInitialize ) . EndInit () 

00918             CType ( Me . SobreObj , System . ComponentModel . ISupportInitialize ) . EndInit () 

00919             CType ( Me . Nd1 , System . ComponentModel . ISupportInitialize ) . EndInit () 

00920             CType ( Me . Nd2 , System . ComponentModel . ISupportInitialize ) . EndInit () 

00921             CType ( Me . z , System . ComponentModel . ISupportInitialize ) . EndInit () 

00922             CType ( Me . filestatusbar , System . ComponentModel . ISupportInitialize ) .  

       »               EndInit () 

00923             Me . Panel1 . ResumeLayout ( False ) 

00924             CType ( Me . hfgTabla , System . ComponentModel . ISupportInitialize ) . EndInit () 

00925             Me . ResumeLayout ( False ) 

00926      

00927         End Sub 

00928      

00929     # End Region 

00930      

00931         'Declaraciones de DLLs de Análisis  

00932         Dim WithEvents Dijkstra1 As New Dijkstra . Dijkstra 

00933         Dim WithEvents BellmanFord1 As New BellmanFord . BellmanFord 

00934         Dim WithEvents Kruskal1 As New Kruskal . Kruskal 

00935         Dim WithEvents Prim1 As New Prim . Prim 

00936         Dim WithEvents FordFulkerson1 As New FordFulkerson . FordFulkerson 

00937         Dim WithEvents FloydWarshall1 As New FloydWarshall . FloydWarshall 

00938      

00939         'declaración de ventana de opciones de formato  

00940         Dim WithEvents CajaPropiedades As New Form2 

00941         'declaración de ventana de importar datos  

00942         Dim WithEvents CajaImportar As New frmImportarDatos 

00943         Dim CajaExportar As New frmExportarDatos 

00944         Dim WithEvents CajaNuevoAleatorio As New frmNuevoAleatorio 

00945         'Array donde guardará la solución de las  

00946         'variables de decisión del modelo LP_solve  

00947         Dim SolucionModeloLP () 

00948         Dim TiempoModelado As Long 

00949         'Estructura de árbol para guardar datos XML  

00950         Public EstructuraArbol As New ArrayList 

00951         Public XMLValido As Boolean 

00952      



00953         'Declara la estructura del objeto Nodo  

00954         Public Structure Nodo 

00955             Dim Texto As String 'etiqueta  

00956             Dim Valor As Single 'valor del nodo  

00957             Dim X As Single 'coordenadas  

00958             Dim Y As Single 

00959             Dim Z As Single 

00960             Dim Col As Color   'color de relleno del nodo  

00961             Dim Radio As Single 'radio del nodo  

00962             Dim Grosor As Single 'trazo del nodo  

00963         End Structure 

00964         'Declara la estructura del objeto Arco o relación entre nodos  

00965         Public Structure Arco 

00966             Dim Texto As String 'etiqueta  

00967             Dim Min As Single 'valor de mínimo  

00968             Dim Max As Single 'valor de máximo  

00969             Dim Coste As Single 'valor de coste  

00970             Dim Col As Color 'color del arco  

00971             Dim Grosor As Single 'trazo del arco  

00972             Dim Nd1 As Long 'nodo origen  

00973             Dim Nd2 As Long 'nodo destino  

00974             Dim B As Boolean 'doble flecha si o no  

00975         End Structure 

00976         'Declara la estructura del objeto Grafo  

00977         Public Structure Graf 

00978             Dim Fichero As String  'nombre del fichero  

00979             Dim Extension As String 'extensión del formato de fichero  

00980             Dim Zoom As Single 

00981             Dim Rejilla As Single 

00982             Dim Iman As Boolean 

00983             Dim MostrarRejilla As Boolean 

00984             Dim TapizX As Single 

00985             Dim TapizY As Single 

00986             Dim ColorRejilla As Color 

00987             Dim ColorTapiz As Color 

00988             Dim ImagenTapiz As String 

00989             Dim MostrarImagenTapiz As Boolean 

00990      

00991             'Nodos  

00992             Dim Fuente As Font 

00993             Dim RadioNodo As Single 

00994             Dim TrazoNodo As Single 

00995             Dim ColNodo As Color 

00996             Dim textoNodo As Boolean 

00997             Dim costNodo As Boolean 

00998      

00999             'Arcos  

01000             Dim minArco As Boolean 

01001             Dim maxArco As Boolean 

01002             Dim costArco As Boolean 

01003             Dim ColArco As Color 

01004             Dim TrazoArco As Single 

01005             Dim BArco As Boolean 'bidireccional  

01006      

01007         End Structure 

01008      

01009         'Nodos Seleccionados  

01010         Public Shared Nd1S As Long = - 1 'primer nodo seleccionado  

01011         Public Shared Nd2S As Long = - 1 'segundo nodo seleccionado  

01012         'Arco Seleccionado  

01013         Dim ArcS As Long = - 1 'Arco seleccionado  

01014      

01015         'Coordenadas de creación de un nuevo nodo  

01016         Dim XNuevo , YNuevo As Single 

01017      

01018         'Totales de Nodos y Arcos  

01019         Public Shared TotalNodos As Long 

01020         Public Shared TotalArcos As Long 

01021      

01022         'Crea las colecciones para ambos objetos  

01023         Public Shared Nodos ( 1 ) As Nodo 

01024         Public Shared Arcos ( 1 ) As Arco 

01025         'para copia previo a solución  

01026         Public Shared NodosPrev ( 1 ) As Nodo 

01027         Public Shared ArcosPrev ( 1 ) As Arco 

01028         'para copia de solución  

01029         Public Shared NodosSol ( 1 ) As Nodo 

01030         Public Shared ArcosSol ( 1 ) As Arco 

01031      

01032         'crea objeto grafo  

01033         Public Shared Grafico As Graf 'public shared para compartir entre forms  

01034      

01035         'crea matriz para la tabla de arcos  

01036         Public Matriz (- 1 , - 1 ) As String 

01037         'crea matriz para la cabecera de nodos  

01038         Public Cabecera1 () As String 

01039         'crea matriz par los valore de nodos  

01040         Public Cabecera2 () As String 

01041         'total nodos en la matriz  

01042         Public Shared NodosMatriz As Long 

01043         Public Shared NuevoNodosMatriz As Long 'para ser cambiado por usuario  

01044         'Celda en edición  

01045         Public CeldaX As Long 

01046         Public CeldaY As Long 

01047      

01048         'Crea el objeto Graphics principal  

01049         Public G As Graphics 

01050      

01051         'para la publicación de resultados del algoritmo  

01052         Public Shared txtResultadosAlgoritmo As String 

01053         Public Shared AlgoritmoMILP As Boolean 

01054         Public WithEvents CajaSolucion As New Form6 

01055      



01056         Sub DibujaGrafo () 

01057             'Me.Cursor = Cursors.WaitCursor  

01058             Try 

01059                 PictureBox1 . Width = Grafico . TapizX * Grafico . Zoom 

01060                 PictureBox1 . Height = Grafico . TapizY * Grafico . Zoom 

01061                 'PictureBox1.BackColor = Grafico.ColorTapiz  

01062                 'Pone la información de zoom en panel  

01063                 StatusBar . Panels ( 5 ) . Text = "Zoom = " & Format ( Grafico . Zoom , "#0.00"  

       »                   ) 

01064      

01065                 'Crea un objeto Graphics  

01066                 'Dim G As Graphics  

01067      

01068                 'toma el objeto graphics  

01069                 G = TomaObjetoGraphics ( PictureBox1 ) 

01070      

01071                 'borra el objeto graphics  

01072                 G . Clear ( Grafico . ColorTapiz ) 

01073                 If Grafico . MostrarImagenTapiz = True And Grafico . ImagenTapiz <> ""  

       »                   Then 

01074                     'carga y ajusta la imagen de fondo al tamaño del tapiz  

01075                     G . DrawImage ( Image . FromFile ( Grafico . ImagenTapiz ), 0 , 0 , Grafico .  

       »                       TapizX * Grafico . Zoom , Grafico . TapizY * Grafico . Zoom ) 

01076                 Else 

01077                     G . Clear ( Grafico . ColorTapiz ) 

01078                 End If 

01079      

01080                 'Opciones de prestaciones gráficas  

01081                 G . SmoothingMode = Drawing . Drawing2D . SmoothingMode . None 

01082                 'G.InterpolationMode = Drawing.Drawing2D.InterpolationMode.Low  

01083                 'G.TextRenderingHint = Drawing.Text.TextRenderingHint.SystemDefault  

01084      

01085                 'definiciones  

01086                 Dim p As Pen 'pluma  

01087                 Dim brocha As System . Drawing . SolidBrush 

01088      

01089                 Dim pf As Pen ' pluma  

01090      

01091                 Dim b As Rectangle 

01092                 Dim i As Long 'contador  

01093      

01094                 Dim x , y As Single 

01095                 Dim x2 , y2 As Single 

01096                 Dim radio As Single 

01097                 Dim t As String 'para texto  

01098                 Dim v As Single 'para valor  

01099      

01100                 Dim tamañotexto As SizeF 

01101      

01102                 Dim LV As Single 

01103                 Dim Xa As Single , Ya As Single 

01104                 Dim Xb As Single , Yb As Single 

01105      

01106                 Dim fuente As Font 

01107      

01108                 Dim f As Form2 

01109                 f = New Form2 

01110      

01111                 'prueba de linea con cabezas flecha  

01112                 '#######  

01113                 Dim Fxa , Fya , Fxb , Fyb As Single 

01114                 Dim pff As Pen ' pluma  

01115                 '#######  

01116      



01117                 'Cambia escala del tipo de letra  

01118                 fuente = New Font ( Grafico . Fuente . Name , Grafico . Fuente . Size *  

       »                   Grafico . Zoom , Grafico . Fuente . Style , GraphicsUnit . Pixel ) 

01119      

01120                 '--------------  

01121                 'DibujaRejilla  

01122                 '--------------  

01123                 If mnuFormatoRejilla . Checked = True Then 

01124                     'define trazo y color de pluma  

01125                     p = New Pen ( Grafico . ColorRejilla , 1 ) 

01126                     p . DashStyle = Drawing . Drawing2D . DashStyle . Dash 

01127                     For x = 0 To PictureBox1 . Width Step Grafico . Rejilla * Grafico .  

       »                       Zoom 

01128                         'líneas verticales  

01129                         G . DrawLine ( p , x , 0 , x , PictureBox1 . Height ) 

01130                         For y = 0 To PictureBox1 . Height Step Grafico . Rejilla *  

       »                           Grafico . Zoom 

01131                             'líneas horizontales  

01132                             G . DrawLine ( p , 0 , y , PictureBox1 . Width , y ) 

01133                         Next y 

01134                     Next x 

01135                 End If 

01136                 '-------------  

01137      

01138                 '----------------------------  

01139                 'Dibuja la colección de Arcos  

01140                 '----------------------------  

01141                 Dim nArcosR As Long 

01142                 Dim xxa , yya As Single 

01143                 Dim rra As Single 

01144      

01145                 Dim ArcS As Long 

01146      

01147                 For i = 0 To TotalArcos - 1 

01148      

01149                     'define el trazo y su color  

01150                     p = New Pen ( Arcos ( i ) . Col , Arcos ( i ) . Grosor * Grafico . Zoom ) 

01151      

01152                     'Compone etiqueta del arco  

01153                     If Grafico . minArco Or Grafico . maxArco Or Grafico . costArco Then 

01154                         t = "(" 

01155      

01156                         If Grafico . minArco Then 

01157                             t = t & Arcos ( i ) . Min . ToString 

01158                         End If 

01159      

01160                         If Grafico . maxArco Then 

01161                             If Grafico . minArco Then t = t & "; " 

01162                             t = t & Arcos ( i ) . Max . ToString 

01163                         End If 

01164      

01165                         If Grafico . costArco Then 

01166                             If ( Grafico . maxArco Or Grafico . minArco ) Then t = t &  

       »                               "; " 

01167                             t = t & Arcos ( i ) . Coste . ToString 

01168                         End If 

01169      

01170                         t = t & ")" 

01171                     End If 

01172      

01173                     If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

01174                         'Arco entre un mismo nodo  

01175                         '----------  

01176                         rra = Nodos ( Arcos ( i ) . Nd1 ) . Radio * Grafico . Zoom 

01177                         x = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01178                         y = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01179                         'dibuja beizer  

01180                         G . DrawBezier ( p , x - rra , y , x - rra * 3 , y + rra * 3 , x + 

       »                           rra * 5 , y + rra * 4.6 , x , y ) 

01181                     Else 

01182                         'El arco va entre nodos diferentes  

01183                         '----------  

01184                         'Comprueba si entre nodos existe doble arco  

01185                         nArcosR = 0 

01186                         nArcosR = ExisteArcoReves ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) 

01187      

01188                         'Busca un arco simétrico  

01189                         ArcS = - 1 

01190                         ArcS = BuscaArcoSimetrico ( i ) 

01191      

01192                         If ArcS <> - 1 Then 

01193                             If ArcS > i Then 

01194                                 Arcos ( i ) . B = True 

01195                                 Arcos ( ArcS ) . B = False 

01196                             End If 

01197                         Else 

01198                             Arcos ( i ) . B = False 

01199                         End If 

01200      

01201                         If nArcosR = 0 Or ( ArcS <> - 1 And Grafico . BArco = True )  

       »                           Then 'un sólo arco también si es simétrico  

01202                             'un sólo arco  

01203                             'toma datos del nodo 1  

01204                             x = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01205                             y = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01206      

01207                             'toma datos del nodo 2  

01208                             x2 = Nodos ( Arcos ( i ) . Nd2 ) . X * Grafico . Zoom 

01209                             y2 = Nodos ( Arcos ( i ) . Nd2 ) . Y * Grafico . Zoom 

01210      

01211                         Else 

01212                             'toma datos del nodo 1  

01213                             x = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01214                             y = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01215      

01216                             'toma datos del nodo 2  

01217                             x2 = Nodos ( Arcos ( i ) . Nd2 ) . X * Grafico . Zoom 

01218                             y2 = Nodos ( Arcos ( i ) . Nd2 ) . Y * Grafico . Zoom 

01219      

01220      

01221                             'dos arcos en diferentes sentidos  

01222                             'calcula vector unitario  

01223                             LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01224                             If LV = 0 Then LV = 0.0000001 

01225      

01226                             'vector unitario de tamaño radio más pequeño  

01227                             If Nodos ( Arcos ( i ) . Nd1 ) . Radio < Nodos ( Arcos ( i ) . Nd2 ) .  

       »                               Radio Then 

01228                                 rra = Nodos ( Arcos ( i ) . Nd1 ) . Radio * 0.5 

01229                             Else 

01230                                 rra = Nodos ( Arcos ( i ) . Nd2 ) . Radio * 0.5 

01231                             End If 

01232                             'vector perpendicular  

01233                             yya = ( x2 - x ) / LV * rra * Grafico . Zoom 

01234                             xxa = (- 1 ) * ( y2 - y ) / LV * rra * Grafico . Zoom 

01235                             'traslada el punto de origen y destino  

01236                             x = x + xxa 

01237                             y = y + yya 

01238                             x2 = x2 + xxa 

01239                             y2 = y2 + yya 

01240                         End If 

01241      

01242                         'línea principal de centro a centro  

01243                         '------------------------------------  

01244                         G . DrawLine ( p , x , y , x2 , y2 ) 

01245      

01246                         ''prueba de dibujar flecha de otra manera  

01247                         ''######  

01248                         ''---------  

01249      

01250                         ''dos arcos en diferentes sentidos  

01251                         ''calcula vector unitario  

01252                         'LV = Math.Sqrt(((x2 - x)) ^ 2 + ((y2 - y)) ^ 2)  

01253                         'If LV = 0 Then LV = 0.0000001  

01254                         'xxa = (x2 - x) / LV * Grafico.Zoom  

01255                         'yya = (y2 - y) / LV * Grafico.Zoom  

01256                         ''calcula puntos de intersección con la circunferencia de  

       »                           ambos nodos  

01257                         'rra = Nodos(Arcos(i).Nd1).Radio * 1  

01258                         'Fxa = x + xxa * rra  

01259                         'Fya = y + yya * rra  

01260                         'rra = Nodos(Arcos(i).Nd2).Radio * 1  

01261                         'Fxb = x2 - xxa * rra  

01262                         'Fyb = y2 - yya * rra  

01263                         ''--------  

01264                         ''define el trazo y su color  

01265                         'p = New Pen(Arcos(i).Col, Arcos(i).Grosor * Grafico.Zoom)  

01266                         'p.StartCap = Drawing2D.LineCap.NoAnchor  

01267                         'p.EndCap = Drawing2D.LineCap.NoAnchor  

01268                         'G.DrawLine(p, Fxb, Fyb + 30, Fxa, Fya + 30)  

01269      

01270                         ''define el trazo y su color  

01271                         'pff = New Pen(Arcos(i).Col, Arcos(i).Grosor * 5 *  

       »                           Grafico.Zoom)  

01272                         'pff.StartCap = Drawing2D.LineCap.ArrowAnchor  

01273                         'pff.EndCap = Drawing2D.LineCap.NoAnchor  

01274                         'G.DrawLine(pff, Fxb, Fyb + 30, Fxb - xxa * 5, Fyb + 30 -  

       »                           yya * 5)  

01275                         'pff.StartCap = Drawing2D.LineCap.ArrowAnchor  

01276                         'pff.EndCap = Drawing2D.LineCap.NoAnchor  

01277                         'G.DrawLine(pff, Fxa, Fya + 30, Fxa + xxa * 5, Fya + 30 +  

       »                           yya * 5)  

01278                         ''#########  

01279      

01280                     End If 

01281      

01282                     'Dibuja etiqueta del arco  

01283                     '-------------------------  

01284                     If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

01285                         'Arco sobre un mismo nodo  

01286                         'si se quisiera a la mitad, sustituir por 0.5  

01287                         tamañotexto = G . MeasureString ( t , fuente ) 

01288                         'rectangulo blanco debajo para que el texto se lea más  

       »                           claro  

01289                         b = New Rectangle ( x - tamañotexto . Width / 2 , y + rra * 2 - 

       »                           tamañotexto . Height / 2 , tamañotexto . Width , tamañotexto .  

       »                           Height ) 

01290                         brocha = New System . Drawing . SolidBrush ( Grafico . ColorTapiz ) 

01291                         G . FillRectangle ( brocha , b ) 

01292                         'escribe el texto  

01293                         G . DrawString ( t , fuente , Brushes . Black , x - tamañotexto .  

       »                           Width / 2 , y + rra * 2 - tamañotexto . Height / 2 ) 

01294      

01295                         'punta de flecha en arco sobre un mismo nodo  

01296                         y2 = y + rra * 3 

01297                         x2 = x + rra * 3 

01298                         'calcula vector unitario  

01299      

01300                         LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01301                         If LV = 0 Then LV = 0.0000001 

01302                         'vector unitario de tamaño radio destino  

01303                         x = (- 1 ) * ( x2 - x ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio *  

       »                           Grafico . Zoom 

01304                         y = (- 1 ) * ( y2 - y ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio *  

       »                           Grafico . Zoom 

01305      

01306                         'punto de intersección de la línea principal con el  

       »                           círculo del nodo destino  

01307                         Xa = x2 - rra * 2.3 

01308                         Ya = y2 - rra * 2.3 

01309                         'cambia el tamaño de la flecha  

01310                         x = x / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01311                         y = y / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01312                         'segmento estribor de la punta de la flecha  

01313                         Xb = Xa - x * Arcos ( i ) . Grosor - y / 2 * Arcos ( i ) . Grosor 

01314                         Yb = Ya - y * Arcos ( i ) . Grosor + x / 2 * Arcos ( i ) . Grosor 

01315                         G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

01316                         'segmento babor de la punta de la flecha  

01317                         Xb = Xa - x * Arcos ( i ) . Grosor + y / 2 * Arcos ( i ) . Grosor 

01318                         Yb = Ya - y * Arcos ( i ) . Grosor - x / 2 * Arcos ( i ) . Grosor 

01319                         G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

01320      

01321                     Else 

01322      

01323                         If Arcos ( i ) . B = True And Grafico . BArco = True Then 

01324                             'si se quisiera a la mitad, sustituir por 0.5  

01325                             tamañotexto = G . MeasureString ( t , fuente ) 

01326                             'rectangulo blanco debajo para que el texto se lea más  

       »                               claro  

01327                             b = New Rectangle ( x + 0.3 * ( x2 - x ) - tamañotexto .  

       »                               Width / 2 , y + 0.3 * ( y2 - y ) - tamañotexto . Height / 

       »                               2 , tamañotexto . Width , tamañotexto . Height ) 

01328                             brocha = New System . Drawing . SolidBrush ( Grafico .  

       »                               ColorTapiz ) 

01329                             G . FillRectangle ( brocha , b ) 

01330                             'escribe el texto  

01331                             G . DrawString ( t , fuente , Brushes . Black , x + 0.3 * ( x2 - 

       »                               x ) - tamañotexto . Width / 2 , y + 0.3 * ( y2 - y ) -  

       »                               tamañotexto . Height / 2 ) 

01332                         Else 

01333                             'el 0.7 hace que el texto del arco se encuentre cerca  

       »                               del destino  

01334                             'si se quisiera a la mitad, sustituir por 0.5  

01335                             tamañotexto = G . MeasureString ( t , fuente ) 

01336                             'rectangulo blanco debajo para que el texto se lea más  

       »                               claro  

01337                             b = New Rectangle ( x + 0.7 * ( x2 - x ) - tamañotexto .  

       »                               Width / 2 , y + 0.7 * ( y2 - y ) - tamañotexto . Height / 

       »                               2 , tamañotexto . Width , tamañotexto . Height ) 

01338                             brocha = New System . Drawing . SolidBrush ( Grafico .  

       »                               ColorTapiz ) 

01339                             G . FillRectangle ( brocha , b ) 

01340                             'escribe el texto  

01341                             G . DrawString ( t , fuente , Brushes . Black , x + 0.7 * ( x2 - 

       »                               x ) - tamañotexto . Width / 2 , y + 0.7 * ( y2 - y ) -  

       »                               tamañotexto . Height / 2 ) 

01342                         End If 

01343      

01344                         'punta de flecha destino  

01345                         '-----------------------  

01346      

01347                         'calcula vector unitario  

01348                         LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01349                         If LV = 0 Then LV = 0.0000001 

01350                         'vector unitario de tamaño radio destino  

01351                         x = ( x2 - x ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio * Grafico .  

       »                           Zoom 

01352                         y = ( y2 - y ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio * Grafico .  

       »                           Zoom 

01353      

01354                         'punto de intersección de la línea principal con el  

       »                           círculo del nodo destino  

01355                         Xa = x2 - x 

01356                         Ya = y2 - y 

01357      

01358                         'cambia el tamaño de la flecha  

01359                         x = x / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01360                         y = y / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01361                         'segmento estribor de la punta de la flecha  

01362                         Xb = Xa - x * Arcos ( i ) . Grosor - y / 2 * Arcos ( i ) . Grosor 

01363                         Yb = Ya - y * Arcos ( i ) . Grosor + x / 2 * Arcos ( i ) . Grosor 

01364                         G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

01365                         'segmento babor de la punta de la flecha  

01366                         Xb = Xa - x * Arcos ( i ) . Grosor + y / 2 * Arcos ( i ) . Grosor 

01367                         Yb = Ya - y * Arcos ( i ) . Grosor - x / 2 * Arcos ( i ) . Grosor 

01368                         G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

01369      

01370                         'Caso de arco bidireccional  

01371                         'con dos puntas de flecha  

01372                         If Arcos ( i ) . B = True And Grafico . BArco = True Then 

01373                             'punta de flecha origen  

01374                             '-----------------------  

01375                             'toma los nodos al revés y ya está!  

01376                             'toma datos del nodo 1  

01377                             x = Nodos ( Arcos ( i ) . Nd2 ) . X * Grafico . Zoom 

01378                             y = Nodos ( Arcos ( i ) . Nd2 ) . Y * Grafico . Zoom 

01379      

01380                             'toma datos del nodo 2  

01381                             x2 = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01382                             y2 = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01383      

01384                             'calcula vector unitario  

01385                             LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01386                             If LV = 0 Then LV = 0.0000001 

01387                             'vector unitario de tamaño radio destino  

01388                             x = ( x2 - x ) / LV * Nodos ( Arcos ( i ) . Nd1 ) . Radio *  

       »                               Grafico . Zoom 

01389                             y = ( y2 - y ) / LV * Nodos ( Arcos ( i ) . Nd1 ) . Radio *  

       »                               Grafico . Zoom 

01390      

01391                             'punto de intersección de la línea principal con el  

       »                               círculo del nodo destino  

01392                             Xa = x2 - x 

01393                             Ya = y2 - y 

01394      

01395                             'cambia el tamaño de la flecha  

01396                             x = x / Nodos ( Arcos ( i ) . Nd1 ) . Radio * 10 

01397                             y = y / Nodos ( Arcos ( i ) . Nd1 ) . Radio * 10 

01398                             'segmento estribor de la punta de la flecha  

01399                             Xb = Xa - x * Arcos ( i ) . Grosor - y / 2 * Arcos ( i ) .  

       »                               Grosor 

01400                             Yb = Ya - y * Arcos ( i ) . Grosor + x / 2 * Arcos ( i ) .  

       »                               Grosor 

01401                             G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

01402                             'segmento babor de la punta de la flecha  

01403                             Xb = Xa - x * Arcos ( i ) . Grosor + y / 2 * Arcos ( i ) .  

       »                               Grosor 

01404                             Yb = Ya - y * Arcos ( i ) . Grosor - x / 2 * Arcos ( i ) .  

       »                               Grosor 

01405                             G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

01406                         End If 

01407                     End If 

01408                 Next i 

01409      

01410                 '----------------------------  

01411                 'Dibuja la colección de Nodos  

01412                 '----------------------------  

01413                 For i = 0 To TotalNodos - 1 

01414                     'toma datos del nodo  

01415                     x = Nodos ( i ) . X * Grafico . Zoom 

01416                     y = Nodos ( i ) . Y * Grafico . Zoom 

01417                     radio = Nodos ( i ) . Radio * Grafico . Zoom 

01418      

01419                     'define el trazo y su color  

01420                     p = New Pen ( Color . Black , Nodos ( i ) . Grosor * Grafico . Zoom ) 

01421                     'dibuja círculo del nodo  

01422                     b = New Rectangle ( x - radio , y - radio , radio * 2 , radio * 2 ) 

01423                     'rellena el círculo del nodo  

01424                     Select Case i 

01425                         Case Nd1S 'primer nodo seleccionado  

01426                             brocha = New System . Drawing . SolidBrush ( Color . LightGreen  

       »                               ) 

01427                         Case Nd2S 'segundo nodo seleccionado  

01428                             brocha = New System . Drawing . SolidBrush ( Color . Red ) 

01429                         Case Else 'no seleccionado - color original  

01430                             brocha = New System . Drawing . SolidBrush ( Nodos ( i ) . Col ) 

01431                     End Select 

01432      

01433                     'condicion de dibujado de ambos textos separados por ecuador  

01434                     'o uno sólo centrado en el nodo  

01435                     Dim condicion As Integer 

01436                     If Grafico . textoNodo = False Or Grafico . costNodo = False Then 

01437                         condicion = 0 

01438                     Else 

01439                         condicion = 1 

01440                     End If 

01441      

01442                     G . FillEllipse ( brocha , b ) 

01443                     If Grafico . textoNodo And Grafico . costNodo Then 

01444                         'dibuja ecuador del nodo  

01445                         G . DrawLine ( p , x - radio , y , x + radio , y ) 

01446                     End If 

01447                     If Grafico . textoNodo Then 

01448                         'pone texto etiqueta en la mitad superior  

01449                         t = Nodos ( i ) . Texto 

01450                         tamañotexto = G . MeasureString ( t , fuente ) 

01451                         G . DrawString ( t , fuente , Brushes . Black , x - tamañotexto .  

       »                           Width / 2 , y - tamañotexto . Height / 2 - radio / 2 *  

       »                           condicion ) 

01452                     End If 

01453                     If Grafico . costNodo Then 

01454                         'pone texto valor en la mitad inferior  

01455                         t = Nodos ( i ) . Valor . ToString 

01456                         tamañotexto = G . MeasureString ( t , fuente ) 

01457                         G . DrawString ( t , fuente , Brushes . Black , x - tamañotexto .  

       »                           Width / 2 , y - tamañotexto . Height / 2 + radio / 2 *  

       »                           condicion ) 

01458                     End If 

01459      

01460                     'dibuja el borde del nodo  

01461                     G . DrawEllipse ( p , b ) 

01462                 Next i 

01463                 '----------------------------  

01464      

01465                 'Intercepción de posibles errores al dibujar  

01466             Catch ex As Exception 

01467                 Me . Cursor = Cursors . Default 

01468                 MsgBox ( "Ha fallado el proceso de dibujar el grafo" & vbCrLf & ex .  

       »                   Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

01469                 Exit Sub 

01470             Finally 

01471             End Try 

01472      

01473         End Sub 

01474      



01475         Public Sub DibujaGrafoSVG ( ByVal fichero As String ) 

01476             'Esta rutina se basa en la rutina DibujaGrafo  

01477             'transforma todas los comandos gráficos en instrucciones  

01478             'xml que serán guardadas como texto en un fichero de  

01479             'extensión .svg (Scalable Vector Graphics) que puede ser  

01480             'interpretado por un navegador con el plugin svg instalado.  

01481             Try 

01482                 Dim txt , txt0 , txt1 , txt2 , txt3 , txt4 As String 

01483                 Dim cdn As String 

01484                 Dim cr , cg , cb As Integer 

01485      

01486      

01487                 Dim version As String 

01488                 version = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »                   Reflection . Assembly . GetExecutingAssembly . Location ) . FileMajorPart 

01489                 version = version & "." & System . Diagnostics . FileVersionInfo .  

       »                   GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »                   Location ) . FileMinorPart 

01490                 version = version & "." & System . Diagnostics . FileVersionInfo .  

       »                   GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »                   Location ) . FileBuildPart 

01491      

01492                 'cabecera del fichero xml  

01493                 txt = "" 

01494                 txt = "<?xml version=""1.0"" encoding=""UTF-8""?>" 

01495                 txt & = vbCrLf 

01496                 txt & = "<!-- This file was written by Grafos software. -->" &  

       »                   vbCrLf 

01497                 txt & = "<!-- http://ttt.upv.es/~arodrigu/grafos -->" &  

       »                   vbCrLf 

01498                 txt & = "<!-- (cc) 2003..2005 - Alejandro Rodriguez Villalobos -->" & 

       »                   vbCrLf 

01499                 txt & = "<!-- Fecha: " & Now . ToShortDateString & " -->" & vbCrLf 

01500                 txt & = "<!-- Version: " & version & " -->" & vbCrLf 

01501                 txt & = vbCrLf 

01502                 'tamaño del grafo  

01503                 txt & = "<!-- Tamaño del objeto -->" 

01504                 txt & = vbCrLf 

01505                 txt & = "<svg xml:space=""preserve"" width=""" & Grafico . TapizX *  

       »                   Grafico . Zoom + 2 & """ height=""" & Grafico . TapizY * Grafico . Zoom 

       »                   + 2 & """>" 

01506                 txt & = vbCrLf 

01507                 txt & = "<!-- Escala general 1:1 en pixeles -->" 

01508                 txt & = vbCrLf 

01509                 txt & = "<g transform=""scale(1)"">" 

01510                 txt & = vbCrLf 

01511                 'tapiz  

01512                 txt0 & = "<g id=""0"">" 

01513                 txt0 & = vbCrLf 

01514                 txt0 & = "<!-- Tapiz -->" 

01515                 txt0 & = vbCrLf 

01516                 cr = Grafico . ColorTapiz . R 

01517                 cg = Grafico . ColorTapiz . G 

01518                 cb = Grafico . ColorTapiz . B 

01519      

01520                 txt0 & = "<rect style=""fill:rgb(" & cr & "," & cg & "," & cb &  

       »                   ");stroke:rgb(127,127,127)"" width=""" & Grafico . TapizX * Grafico  

       »                   . Zoom + 1 & """ height=""" & Grafico . TapizY * Grafico . Zoom + 1 &  

       »                   """/>" 

01521                 txt0 & = vbCrLf 

01522                 txt0 & = "</g>" 

01523                 txt0 & = vbCrLf 

01524                 'definiciones  

01525                 G = TomaObjetoGraphics ( PictureBox1 ) 

01526      

01527                 Dim p As Pen 'pluma  

01528                 Dim brocha As System . Drawing . SolidBrush 

01529      

01530                 Dim b As Rectangle 

01531                 Dim i As Long 'contador  

01532      

01533                 Dim x , y As Single 

01534                 Dim x2 , y2 As Single 

01535                 Dim radio As Single 

01536                 Dim t As String 'para texto  

01537                 Dim v As Single 'para valor  

01538      

01539                 Dim tamañotexto As SizeF 

01540      

01541                 Dim LV As Single 

01542                 Dim Xa As Single , Ya As Single 

01543                 Dim Xb As Single , Yb As Single 

01544      

01545                 Dim fuente As Font 

01546      

01547                 Dim f As Form2 

01548                 f = New Form2 

01549                 'Cambia escala del tipo de letra  

01550                 fuente = New Font ( Grafico . Fuente . Name , Grafico . Fuente . Size *  

       »                   Grafico . Zoom , Grafico . Fuente . Style , GraphicsUnit . Pixel ) 

01551      

01552                 '--------------  

01553                 'DibujaRejilla  

01554                 '--------------  

01555                 txt1 & = "<g id=""1"">" 

01556                 txt1 & = vbCrLf 

01557                 If mnuFormatoRejilla . Checked = True Then 

01558                     txt1 & = "<!-- rejilla -->" 

01559                     txt1 & = vbCrLf 

01560                     cr = Grafico . ColorRejilla . R 

01561                     cg = Grafico . ColorRejilla . G 

01562                     cb = Grafico . ColorRejilla . B 

01563      

01564                     For x = 0 To Grafico . TapizX * Grafico . Zoom Step Grafico . Rejilla 

       »                       * Grafico . Zoom 

01565                         'líneas verticales  

01566                         txt1 & = "<line x1=""" & x & """ y1=""" & 0 & """ x2=""" & x 

       »                           & """ y2=""" & Grafico . TapizY * Grafico . Zoom & """  

       »                           style=""stroke-width:" & 1 & ";stroke:rgb(" & cr & "," &  

       »                           cg & "," & cb & ")""></line>" 

01567                         txt1 & = vbCrLf 

01568                         For y = 0 To Grafico . TapizY * Grafico . Zoom Step Grafico .  

       »                           Rejilla * Grafico . Zoom 

01569                             'líneas horizontales  

01570                             txt1 & = "<line x1=""" & 0 & """ y1=""" & y & """ x2=""" 

       »                               & Grafico . TapizX * Grafico . Zoom & """ y2=""" & y &  

       »                               """ style=""stroke-width:" & 1 & ";stroke:rgb(" & cr  

       »                               & "," & cg & "," & cb & ")""></line>" 

01571                             txt1 & = vbCrLf 

01572                         Next y 

01573                     Next x 

01574                 End If 

01575                 txt1 & = "</g>" 

01576                 txt1 & = vbCrLf 

01577                 '------------  

01578      

01579                 '----------------------------  

01580                 'Dibuja la colección de Arcos  

01581                 '----------------------------  

01582                 Dim nArcosR As Long 

01583                 Dim xxa , yya As Single 

01584                 Dim rra As Single 

01585      

01586                 Dim ArcS As Long 

01587      

01588                 txt2 & = "<!-- arcos -->" 

01589                 txt2 & = "<g id=""2"">" 

01590                 txt2 & = vbCrLf 

01591                 txt2 & = vbCrLf 

01592      

01593                 txt3 & = "<!-- textos -->" 

01594                 txt3 & = "<g id=""3"">" 

01595                 txt3 & = vbCrLf 

01596                 txt3 & = vbCrLf 

01597      

01598                 For i = 0 To TotalArcos - 1 

01599      

01600                     'define el trazo y su color  

01601                     cr = Arcos ( i ) . Col . R 

01602                     cg = Arcos ( i ) . Col . G 

01603                     cb = Arcos ( i ) . Col . B 

01604      

01605                     'Compone etiqueta del arco  

01606                     If Grafico . minArco Or Grafico . maxArco Or Grafico . costArco Then 

01607                         t = "(" 

01608      

01609                         If Grafico . minArco Then 

01610                             t = t & Arcos ( i ) . Min . ToString 

01611                         End If 

01612      

01613                         If Grafico . maxArco Then 

01614                             If Grafico . minArco Then t = t & "; " 

01615                             t = t & Arcos ( i ) . Max . ToString 

01616                         End If 

01617      

01618                         If Grafico . costArco Then 

01619                             If ( Grafico . maxArco Or Grafico . minArco ) Then t = t &  

       »                               "; " 

01620                             t = t & Arcos ( i ) . Coste . ToString 

01621                         End If 

01622      

01623                         t = t & ")" 

01624                     End If 

01625      

01626                     If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

01627                         'Arco entre un mismo nodo  

01628                         '----------  

01629                         rra = Nodos ( Arcos ( i ) . Nd1 ) . Radio * Grafico . Zoom 

01630                         x = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01631                         y = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01632                         'dibuja beizer  

01633                         'g.DrawBezier(p,, x - rra, y, x - rra * 3, y + rra * 3, x  

       »                           + rra * 5, y + rra * 4.6, x, y)  

01634                         txt2 & = "<path style=""stroke-width:" & Arcos ( i ) . Grosor *  

       »                           Grafico . Zoom & ";stroke:rgb(" & cr & "," & cg & "," & cb  

       »                           & ");fill:none""" 

01635                         txt2 & = " d=""M " & Int ( x - rra ) & "," & Int ( y ) & " " 

01636                         txt2 & = " Q " & Int ( x - rra * 3.5 ) & "," & Int ( y + rra * 2  

       »                           ) & " " & Int ( x ) & "," & Int ( y + rra * 3 ) & " " 

01637                         txt2 & = " Q " & Int ( x + rra * 3.5 ) & "," & Int ( y + rra *  

       »                           3.8 ) & " " & Int ( x ) & "," & Int ( y - 6 ) & " " 

01638      

01639                         txt2 & = "Z""/> " 

01640                         txt2 & = vbCrLf 

01641      

01642                     Else 

01643                         'El arco va entre nodos diferentes  

01644                         '----------  

01645                         'Comprueba si entre nodos existe doble arco  

01646                         nArcosR = 0 

01647                         nArcosR = ExisteArcoReves ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) 

01648      

01649                         'Busca un arco simétrico  

01650                         ArcS = - 1 

01651                         ArcS = BuscaArcoSimetrico ( i ) 

01652      

01653                         If ArcS <> - 1 Then 

01654                             If ArcS > i Then 

01655                                 Arcos ( i ) . B = True 

01656                                 Arcos ( ArcS ) . B = False 

01657                             End If 

01658                         Else 

01659                             Arcos ( i ) . B = False 

01660                         End If 

01661      

01662                         If nArcosR = 0 Or ( ArcS <> - 1 And Grafico . BArco = True )  

       »                           Then 'un sólo arco también si es simétrico  

01663                             'un sólo arco  

01664                             'toma datos del nodo 1  

01665                             x = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01666                             y = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01667      

01668                             'toma datos del nodo 2  

01669                             x2 = Nodos ( Arcos ( i ) . Nd2 ) . X * Grafico . Zoom 

01670                             y2 = Nodos ( Arcos ( i ) . Nd2 ) . Y * Grafico . Zoom 

01671      

01672                         Else 

01673                             'toma datos del nodo 1  

01674                             x = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01675                             y = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01676      

01677                             'toma datos del nodo 2  

01678                             x2 = Nodos ( Arcos ( i ) . Nd2 ) . X * Grafico . Zoom 

01679                             y2 = Nodos ( Arcos ( i ) . Nd2 ) . Y * Grafico . Zoom 

01680      

01681      

01682                             'dos arcos en diferentes sentidos  

01683                             'calcula vector unitario  

01684                             LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01685                             If LV = 0 Then LV = 0.0000001 

01686      

01687      

01688                             'vector unitario de tamaño radio más pequeño  

01689                             If Nodos ( Arcos ( i ) . Nd1 ) . Radio < Nodos ( Arcos ( i ) . Nd2 ) .  

       »                               Radio Then 

01690                                 rra = Nodos ( Arcos ( i ) . Nd1 ) . Radio * 0.5 

01691                             Else 

01692                                 rra = Nodos ( Arcos ( i ) . Nd2 ) . Radio * 0.5 

01693                             End If 

01694                             'vector perpendicular  

01695                             yya = ( x2 - x ) / LV * rra * Grafico . Zoom 

01696                             xxa = (- 1 ) * ( y2 - y ) / LV * rra * Grafico . Zoom 

01697                             'traslada el punto de origen y destino  

01698                             x = x + xxa 

01699                             y = y + yya 

01700                             x2 = x2 + xxa 

01701                             y2 = y2 + yya 

01702                         End If 

01703      



01704                         'línea principal de centro a centro  

01705                         '------------------------------------  

01706                         txt2 & = "<line x1=""" & x & """ y1=""" & y & """ x2=""" &  

       »                           x2 & """ y2=""" & y2 & """ style=""stroke-width:" & Arcos  

       »                           ( i ) . Grosor * Grafico . Zoom & ";stroke:rgb(" & cr & "," &  

       »                           cg & "," & cb & ")""></line>" 

01707                         txt2 & = vbCrLf 

01708      

01709                     End If 

01710      

01711                     'Dibuja etiqueta del arco  

01712                     '-------------------------  

01713                     If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

01714                         'Arco sobre un mismo nodo  

01715                         'si se quisiera a la mitad, sustituir por 0.5  

01716                         tamañotexto = G . MeasureString ( t , fuente ) 

01717      

01718                         'escribe el texto  

01719                         txt3 & = "<text x=""" & Int ( x ) & """ y=""" & Int ( y + rra *  

       »                           2 ) & """ style=""font-family:" & Grafico . Fuente . Name .  

       »                           ToString & ";font-size:" & Int ( tamañotexto . Height ) &  

       »                           ";fill:rgb(0,0,0);text-anchor:middle;"">" & t & "</text>" 

01720                         txt3 & = vbCrLf 

01721      

01722                         'punta de flecha en arco sobre un mismo nodo  

01723                         y2 = y + rra * 3 

01724                         x2 = x + rra * 3 

01725                         'calcula vector unitario  

01726      

01727                         LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01728                         If LV = 0 Then LV = 0.0000001 

01729                         'vector unitario de tamaño radio destino  

01730                         x = (- 1 ) * ( x2 - x ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio *  

       »                           Grafico . Zoom 

01731                         y = (- 1 ) * ( y2 - y ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio *  

       »                           Grafico . Zoom 

01732      

01733                         'punto de intersección de la línea principal con el  

       »                           círculo del nodo destino  

01734                         Xa = x2 - rra * 2.3 

01735                         Ya = y2 - rra * 2.3 

01736      

01737                         'cambia el tamaño de la flecha  

01738                         x = x / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01739                         y = y / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01740                         'segmento estribor de la punta de la flecha  

01741                         Xb = Xa - x * Arcos ( i ) . Grosor - y / 2 * Arcos ( i ) . Grosor 

01742                         Yb = Ya - y * Arcos ( i ) . Grosor + x / 2 * Arcos ( i ) . Grosor 

01743      

01744                         txt2 & = "<line x1=""" & Xb & """ y1=""" & Yb & """ x2=""" & 

       »                           Xa & """ y2=""" & Ya & """ style=""stroke-width:" &  

       »                           Arcos ( i ) . Grosor * Grafico . Zoom & ";stroke:rgb(" & cr &  

       »                           "," & cg & "," & cb & ")""></line>" 

01745                         txt2 & = vbCrLf 

01746                         'segmento babor de la punta de la flecha  

01747                         Xb = Xa - x * Arcos ( i ) . Grosor + y / 2 * Arcos ( i ) . Grosor 

01748                         Yb = Ya - y * Arcos ( i ) . Grosor - x / 2 * Arcos ( i ) . Grosor 

01749      

01750                         txt2 & = "<line x1=""" & Xb & """ y1=""" & Yb & """ x2=""" & 

       »                           Xa & """ y2=""" & Ya & """ style=""stroke-width:" &  

       »                           Arcos ( i ) . Grosor * Grafico . Zoom & ";stroke:rgb(" & cr &  

       »                           "," & cg & "," & cb & ")""></line>" 

01751                         txt2 & = vbCrLf 

01752                     Else 

01753                         If Arcos ( i ) . B = True And Grafico . BArco = True Then 

01754                             'si se quisiera a la mitad, sustituir por 0.5  

01755                             tamañotexto = G . MeasureString ( t , fuente ) 

01756      

01757                             'escribe el texto  

01758                             txt3 & = "<text x=""" & Int ( x + 0.3 * ( x2 - x )) & """  

       »                               y=""" & Int ( y + 0.3 * ( y2 - y )) & """ style=" 

       »                               "font-family:" & Grafico . Fuente . Name . ToString &  

       »                               ";font-size:" & Int ( tamañotexto . Height ) &  

       »                               ";fill:rgb(0,0,0);text-anchor:middle;"">" & t &  

       »                               "</text>" 

01759                             txt3 & = vbCrLf 

01760      

01761                         Else 

01762                             'el 0.7 hace que el texto del arco se encuentre cerca  

       »                               del destino  

01763                             'si se quisiera a la mitad, sustituir por 0.5  

01764                             tamañotexto = G . MeasureString ( t , fuente ) 

01765      

01766                             'escribe el texto  

01767                             txt3 & = "<text x=""" & Int ( x + 0.7 * ( x2 - x )) & """  

       »                               y=""" & Int ( y + 0.7 * ( y2 - y )) & """ style=" 

       »                               "font-family:" & Grafico . Fuente . Name . ToString &  

       »                               ";font-size:" & Int ( tamañotexto . Height ) &  

       »                               ";fill:rgb(0,0,0);text-anchor:middle;"">" & t &  

       »                               "</text>" 

01768                             txt3 & = vbCrLf 

01769                         End If 

01770      

01771                         'punta de flecha destino  

01772                         '-----------------------  

01773      

01774                         'calcula vector unitario  

01775                         LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01776                         If LV = 0 Then LV = 0.0000001 

01777                         'vector unitario de tamaño radio destino  

01778                         x = ( x2 - x ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio * Grafico .  

       »                           Zoom 

01779                         y = ( y2 - y ) / LV * Nodos ( Arcos ( i ) . Nd2 ) . Radio * Grafico .  

       »                           Zoom 

01780      

01781                         'punto de intersección de la línea principal con el  

       »                           círculo del nodo destino  

01782                         Xa = x2 - x 

01783                         Ya = y2 - y 

01784      

01785                         'cambia el tamaño de la flecha  

01786                         x = x / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01787                         y = y / Nodos ( Arcos ( i ) . Nd2 ) . Radio * 10 

01788                         'segmento estribor de la punta de la flecha  

01789                         Xb = Xa - x * Arcos ( i ) . Grosor - y / 2 * Arcos ( i ) . Grosor 

01790                         Yb = Ya - y * Arcos ( i ) . Grosor + x / 2 * Arcos ( i ) . Grosor 

01791      

01792                         txt2 & = "<line x1=""" & Xb & """ y1=""" & Yb & """ x2=""" & 

       »                           Xa & """ y2=""" & Ya & """ style=""stroke-width:" &  

       »                           Arcos ( i ) . Grosor * Grafico . Zoom & ";stroke:rgb(" & cr &  

       »                           "," & cg & "," & cb & ")""></line>" 

01793                         txt2 & = vbCrLf 

01794                         'segmento babor de la punta de la flecha  

01795                         Xb = Xa - x * Arcos ( i ) . Grosor + y / 2 * Arcos ( i ) . Grosor 

01796                         Yb = Ya - y * Arcos ( i ) . Grosor - x / 2 * Arcos ( i ) . Grosor 

01797      

01798                         txt2 & = "<line x1=""" & Xb & """ y1=""" & Yb & """ x2=""" & 

       »                           Xa & """ y2=""" & Ya & """ style=""stroke-width:" &  

       »                           Arcos ( i ) . Grosor * Grafico . Zoom & ";stroke:rgb(" & cr &  

       »                           "," & cg & "," & cb & ")""></line>" 

01799                         txt2 & = vbCrLf 

01800      

01801                         'Caso de arco bidireccional  

01802                         'con dos puntas de flecha  

01803                         If Arcos ( i ) . B = True And Grafico . BArco = True Then 

01804                             'punta de flecha origen  

01805                             '-----------------------  

01806                             'toma los nodos al revés y ya está!  

01807                             'toma datos del nodo 1  

01808                             x = Nodos ( Arcos ( i ) . Nd2 ) . X * Grafico . Zoom 

01809                             y = Nodos ( Arcos ( i ) . Nd2 ) . Y * Grafico . Zoom 

01810      

01811                             'toma datos del nodo 2  

01812                             x2 = Nodos ( Arcos ( i ) . Nd1 ) . X * Grafico . Zoom 

01813                             y2 = Nodos ( Arcos ( i ) . Nd1 ) . Y * Grafico . Zoom 

01814      

01815                             'calcula vector unitario  

01816                             LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

01817                             If LV = 0 Then LV = 0.0000001 

01818                             'vector unitario de tamaño radio destino  

01819                             x = ( x2 - x ) / LV * Nodos ( Arcos ( i ) . Nd1 ) . Radio *  

       »                               Grafico . Zoom 

01820                             y = ( y2 - y ) / LV * Nodos ( Arcos ( i ) . Nd1 ) . Radio *  

       »                               Grafico . Zoom 

01821      

01822                             'punto de intersección de la línea principal con el  

       »                               círculo del nodo destino  

01823                             Xa = x2 - x 

01824                             Ya = y2 - y 

01825                             'cambia el tamaño de la flecha  

01826                             x = x / Nodos ( Arcos ( i ) . Nd1 ) . Radio * 10 

01827                             y = y / Nodos ( Arcos ( i ) . Nd1 ) . Radio * 10 

01828                             'segmento estribor de la punta de la flecha  

01829                             Xb = Xa - x * Arcos ( i ) . Grosor - y / 2 * Arcos ( i ) .  

       »                               Grosor 

01830                             Yb = Ya - y * Arcos ( i ) . Grosor + x / 2 * Arcos ( i ) .  

       »                               Grosor 

01831      

01832                             txt2 & = "<line x1=""" & Xb & """ y1=""" & Yb & """ x2=" 

       »                               "" & Xa & """ y2=""" & Ya & """ style=" 

       »                               "stroke-width:" & Arcos ( i ) . Grosor * Grafico . Zoom &  

       »                               ";stroke:rgb(" & cr & "," & cg & "," & cb & ")" 

       »                               "></line>" 

01833                             txt2 & = vbCrLf 

01834                             'segmento babor de la punta de la flecha  

01835                             Xb = Xa - x * Arcos ( i ) . Grosor + y / 2 * Arcos ( i ) .  

       »                               Grosor 

01836                             Yb = Ya - y * Arcos ( i ) . Grosor - x / 2 * Arcos ( i ) .  

       »                               Grosor 

01837      

01838                             txt2 & = "<line x1=""" & Xb & """ y1=""" & Yb & """ x2=" 

       »                               "" & Xa & """ y2=""" & Ya & """ style=" 

       »                               "stroke-width:" & Arcos ( i ) . Grosor * Grafico . Zoom &  

       »                               ";stroke:rgb(" & cr & "," & cg & "," & cb & ")" 

       »                               "></line>" 

01839                             txt2 & = vbCrLf 

01840                         End If 

01841                     End If 

01842                 Next i 

01843      

01844                 txt2 & = "</g>" 

01845                 txt2 & = vbCrLf 

01846      

01847                 txt4 & = "<!-- nodos -->" 

01848                 txt4 & = "<g id=""4"">" 

01849                 txt4 & = vbCrLf 

01850      

01851                 '----------------------------  

01852                 'Dibuja la colección de Nodos  

01853                 '----------------------------  

01854                 For i = 0 To TotalNodos - 1 

01855                     'toma datos del nodo  

01856                     x = Nodos ( i ) . X * Grafico . Zoom 

01857                     y = Nodos ( i ) . Y * Grafico . Zoom 

01858                     radio = Nodos ( i ) . Radio * Grafico . Zoom 

01859      

01860                     'condicion de dibujado de ambos textos separados por ecuador  

01861                     'o uno sólo centrado en el nodo  

01862                     Dim condicion As Integer 

01863                     If Grafico . textoNodo = False Or Grafico . costNodo = False Then 

01864                         condicion = 0 

01865                     Else 

01866                         condicion = 1 

01867                     End If 

01868      

01869                     'dibuja nodo en svg  

01870                     txt4 & = "<!-- nodo " & i & " -->" 

01871                     txt4 & = vbCrLf 

01872                     txt4 & = "<ellipse cx=""" & x & """ cy=""" & y & """ rx=""" &  

       »                       radio & """ ry=""" & radio & """ style=""fill:rgb(" & Nodos ( i  

       »                       ) . Col . R & "," & Nodos ( i ) . Col . G & "," & Nodos ( i ) . Col . B &  

       »                       ");stroke:rgb(0,0,0);stroke-width:" & Nodos ( i ) . Grosor *  

       »                       Grafico . Zoom & ";""/>" 

01873                     txt4 & = vbCrLf 

01874      

01875                     If Grafico . textoNodo And Grafico . costNodo Then 

01876                         'dibuja ecuador del nodo  

01877                         txt4 & = "<line x1=""" & x - radio & """ y1=""" & y & """  

       »                           x2=""" & x + radio & """ y2=""" & y & """ style=" 

       »                           "stroke-width:" & Nodos ( i ) . Grosor * Grafico . Zoom &  

       »                           ";stroke:rgb(0,0,0)""></line>" 

01878                         txt4 & = vbCrLf 

01879                     End If 

01880                     If Grafico . textoNodo Then 

01881                         ' 'pone texto etiqueta en la mitad superior  

01882                         t = Nodos ( i ) . Texto 

01883                         tamañotexto = G . MeasureString ( t , fuente ) 

01884                         txt3 & = "<text x=""" & Int ( x ) & """ y=""" & Int ( y +  

       »                           tamañotexto . Height * 0.25 - radio / 2 * condicion ) & """  

       »                           style=""font-family:" & Grafico . Fuente . Name . ToString &  

       »                           ";font-size:" & Int ( tamañotexto . Height ) &  

       »                           ";fill:rgb(0,0,0);text-anchor:middle;"">" & t & "</text>" 

01885                         txt3 & = vbCrLf 

01886                     End If 

01887                     If Grafico . costNodo Then 

01888                         ' 'pone texto valor en la mitad inferior  

01889                         t = Nodos ( i ) . Valor . ToString 

01890                         tamañotexto = G . MeasureString ( t , fuente ) 

01891                         txt3 & = "<text x=""" & Int ( x ) & """ y=""" & Int ( y +  

       »                           tamañotexto . Height * 0.25 + radio / 2 * condicion ) & """  

       »                           style=""font-family:" & Grafico . Fuente . Name . ToString &  

       »                           ";font-size:" & Int ( tamañotexto . Height ) &  

       »                           ";fill:rgb(0,0,0);text-anchor:middle;"">" & t & "</text>" 

01892                         txt3 & = vbCrLf 

01893                     End If 

01894                 Next i 

01895                 '----------------------------  

01896                 txt3 & = "</g>" 

01897                 txt3 & = vbCrLf 

01898                 txt4 & = "</g>" 

01899                 txt4 & = vbCrLf 

01900      

01901                 'consolida todos los textos  

01902                 'lo último en dibujar son los textos,  

01903                 'las capas van de izq a dcha. y de abajo a arriba.  

01904                 txt & = txt0 & txt1 & txt2 & txt4 & txt3 

01905      

01906                 'pie del fichero xml  

01907                 txt & = "</g></svg>" 

01908                 'Guarda el fichero .svg  

01909                 EscribeFicheroTexto ( fichero , txt ) 

01910      

01911                 'fichero .htm anexo que permite activar/desactivar capas  

01912                 txt = "<HTML>" 

01913                 txt & = vbCrLf & "<HEAD>" 

01914                 txt & = vbCrLf & "<TITLE>Grafo en formato SVG - (cc) 2003..2005 -  

       »                   Alejandro Rodriguez Villalobos</TITLE>" 

01915                 txt & = vbCrLf & "<SCRIPT LANGUAGE=""JavaScript1.2""><!--" 

01916                 txt & = vbCrLf & "/*" 

01917                 txt & = vbCrLf & "* Esta función activa/desactiva las capas de la  

       »                   imagen SVG." 

01918                 txt & = vbCrLf & "* Para ello hay que hacer click en los checkbox del 

       »                   lateral." 

01919                 txt & = vbCrLf & "*" 

01920                 txt & = vbCrLf & "* Input Parameters:" 

01921                 txt & = vbCrLf & "* checkbox - Form object (checkbox) that was  

       »                   clicked on." 

01922                 txt & = vbCrLf & "* element_name - SVG element name that should be  

       »                   made visible/" 

01923                 txt & = vbCrLf & "* invisible." 

01924                 txt & = vbCrLf & "*/" 

01925                 txt & = vbCrLf & "function hilite_elem (checkbox, element_name)" 

01926                 txt & = vbCrLf & "{" 

01927                 txt & = vbCrLf & " var svgobj;" 

01928                 txt & = vbCrLf & " var svgstyle;" 

01929                 txt & = vbCrLf & " var svgdoc = document.network.getSVGDocument();" 

01930                 txt & = vbCrLf & " // For selected element, get the elements style  

       »                   object, then set" 

01931                 txt & = vbCrLf & " // its visibility according to the state of the  

       »                   checkbox." 

01932                 txt & = vbCrLf & " svgobj = svgdoc.getElementById(element_name);" 

01933                 txt & = vbCrLf & " svgstyle = svgobj.getStyle();" 

01934                 txt & = vbCrLf & " if (!checkbox.checked) " 

01935                 txt & = vbCrLf & " { // Hide layer." 

01936                 txt & = vbCrLf & " svgstyle.setProperty('visibility',  

       »                   'hidden');" 

01937                 txt & = vbCrLf & " }" 

01938                 txt & = vbCrLf & " else" 

01939                 txt & = vbCrLf & " { // SHow layer." 

01940                 txt & = vbCrLf & " svgstyle.setProperty('visibility',  

       »                   'visible');" 

01941                 txt & = vbCrLf & " }" 

01942                 txt & = vbCrLf & "}" 

01943                 txt & = vbCrLf & "// -->" 

01944                 txt & = vbCrLf & "</SCRIPT>" 

01945                 txt & = vbCrLf & " </HEAD>" 

01946                 txt & = vbCrLf & "<BODY>" 

01947                 txt & = vbCrLf & "<center>" 

01948                 txt & = vbCrLf & "<table><tr><td>" 

01949                 txt & = vbCrLf & "<EMBED SRC=""" & fichero & " "" NAME=""network""" 

01950                 txt & = vbCrLf & " HEIGHT=""555.00"" WIDTH=""887.00""" 

01951                 txt & = vbCrLf & " TYPE=""image/svg-xml""" 

01952                 txt & = vbCrLf & " PLUGINSPAGE=" 

       »                   "http://www.adobe.com/svg/viewer/install/"">" 

01953                 txt & = vbCrLf & "</td><td>" 

01954                 txt & = vbCrLf & "<FORM NAME=""hilite_form"">" 

01955                 txt & = vbCrLf & " <TABLE BORDER=""0"" CELLPADDING=""0""  

       »                   CELLSPACING=""2"" WIDTH=""100%"">" 

01956                 txt & = vbCrLf & " <TR>" 

01957                 txt & = vbCrLf & " <TD><INPUT TYPE=""checkbox"" VALUE="""" ONCLICK=" 

       »                   "hilite_elem(this,0)"">Tapiz</TD></tr>" 

01958                 txt & = vbCrLf & " <TD><INPUT TYPE=""checkbox"" VALUE="""" ONCLICK=" 

       »                   "hilite_elem(this,1)"">Rejilla</TD></tr>" 

01959                 txt & = vbCrLf & " <TD><INPUT TYPE=""checkbox"" VALUE="""" ONCLICK=" 

       »                   "hilite_elem(this,2)"">Arcos</TD></tr>" 

01960                 txt & = vbCrLf & " <TD><INPUT TYPE=""checkbox"" VALUE="""" ONCLICK=" 

       »                   "hilite_elem(this,3)"">Textos</TD></tr>" 

01961                 txt & = vbCrLf & " </TABLE>" 

01962                 txt & = vbCrLf & "<SCRIPT><!--" 

01963                 txt & = vbCrLf & " // Make sure all checkboxes are checked whenever  

       »                   the page" 

01964                 txt & = vbCrLf & " // is reloaded in the browser." 

01965                 txt & = vbCrLf & " for (var i = 0; i <  

       »                   document.hilite_form.elements.length; i++)" 

01966                 txt & = vbCrLf & " if (document.hilite_form.elements[i].type ==  

       »                   'checkbox')" 

01967                 txt & = vbCrLf & " document.hilite_form.elements[i].checked =  

       »                   true;" 

01968                 txt & = vbCrLf & " // -->" 

01969                 txt & = vbCrLf & "</SCRIPT>" 

01970                 txt & = vbCrLf & "</FORM>" 

01971                 txt & = vbCrLf & "</td></tr>" 

01972                 txt & = vbCrLf & "</table>" 

01973                 txt & = vbCrLf & " </center>" 

01974                 txt & = vbCrLf & "</BODY>" 

01975                 txt & = vbCrLf & "</HTML>" 

01976                 'Guarda el fichero .htm  

01977                 EscribeFicheroTexto ( fichero & ".htm" , txt ) 

01978      

01979                 'Intercepción de posibles errores al dibujar  

01980             Catch ex As Exception 

01981                 Me . Cursor = Cursors . Default 

01982                 MsgBox ( "Ha fallado el proceso de exportación gráfica a .svg" &  

       »                   vbCrLf & ex . Message , MsgBoxStyle . Exclamation , "Grafos -  

       »                   Excepción" ) 

01983                 Exit Sub 

01984             Finally 

01985             End Try 

01986         End Sub 

01987         Function BuscaArcoSimetrico ( ByVal i As Long ) As Long 

01988             'Busca un arco simétrico al pasado como parámetro  

01989             'para ser fusionado en el grafo (en caso de opción bidireccional)  

01990             'y que aparezca sólo un arco con doble flecha  

01991             Dim j As Long 

01992             For j = 0 To TotalArcos - 1 

01993                 'que no sea él mismo  

01994                 If j <> i Then 

01995      

01996                     'coincide dirección y sentido inverso  

01997                     If Arcos ( i ) . Nd1 = Arcos ( j ) . Nd2 And Arcos ( i ) . Nd2 = Arcos ( j ) . Nd1 

       »                       Then 

01998      

01999                         'coinciden valores  

02000                         If Arcos ( i ) . Min = Arcos ( j ) . Min And Arcos ( i ) . Max = Arcos ( j )  

       »                           . Max And Arcos ( i ) . Coste = Arcos ( j ) . Coste Then 

02001                             'encontrado  

02002                             Return j 

02003                         End If 

02004                     End If 

02005                 End If 

02006             Next j 

02007      

02008             Return - 1 

02009         End Function 

02010         Private Sub PictureBox1_MouseMove ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . MouseEventArgs ) Handles PictureBox1 . MouseMove 

02011      

02012             'Muestra en el panel de estado las coordenadas del ratón en movimiento.  

02013             StatusBar . Panels ( 0 ) . Text = "X = " & e . X . ToString 

02014             StatusBar . Panels ( 1 ) . Text = "Y = " & e . Y . ToString 

02015             Dim nd As Long 

02016             nd = XYSobreNodo ( e . X , e . Y ) 

02017             If nd <> - 1 Then 

02018                 StatusBar . Panels ( 2 ) . Text = "Nodo = " & Nodos ( nd ) . Texto 

02019             Else 

02020                 StatusBar . Panels ( 2 ) . Text = " " 

02021             End If 

02022      

02023             If e . Button = MouseButtons . Left And Nd1S <> - 1 Then 

02024                 'redondea el valor de las coordenadas al ancho de la rejilla  

02025                 'si la opción imán está seleccionada en el menú  

02026                 If mnuFormatoIman . Checked = True Then 

02027                     Nodos ( Nd1S ) . X = Int (( e . X - XNuevo ) / Grafico . Zoom / Grafico .  

       »                       Rejilla ) * Grafico . Rejilla 

02028                     Nodos ( Nd1S ) . Y = Int (( e . Y - YNuevo ) / Grafico . Zoom / Grafico .  

       »                       Rejilla ) * Grafico . Rejilla 

02029                 Else 

02030                     'sino, toma los valores tal cual  

02031                     'Nodos(Nd1S).X = e.X / Grafico.Zoom  

02032                     'Nodos(Nd1S).Y = e.Y / Grafico.Zoom  

02033                     ' If e.X / Grafico.Zoom <> XNuevo Or e.Y / Grafico.Zoom <>  

       »                       YNuevo Then  

02034                     Nodos ( Nd1S ) . X = ( e . X - XNuevo ) / Grafico . Zoom 

02035                     Nodos ( Nd1S ) . Y = ( e . Y - YNuevo ) / Grafico . Zoom 

02036                     'End If  

02037                 End If 

02038      

02039                 DibujaGrafo () 

02040                 PictureBox1 . Refresh () 

02041      

02042             End If 

02043      

02044             'Activa o desactiva menús de análisis  

02045             'debe existir al menos un arco para tener un grafo  

02046             If TotalArcos > 0 Then 

02047                 mnuAnalisisDijkstra . Enabled = True 

02048                 mnuAnalisisDijkstraCC . Enabled = True 

02049                 mnuAnalisisDijkstraCM . Enabled = True 

02050                 mnuAnalisisDijkstraMax . Enabled = True 

02051                 mnuAnalisisBellmanFordCmin . Enabled = True 

02052                 mnuAnalisisBellmanFordCmax . Enabled = True 

02053                 mnuAnalisisFordFulkersonMax . Enabled = True 

02054      

02055                 mnuAnalisisKruskalmin . Enabled = True 

02056                 mnuAnalisisKruskalmax . Enabled = True 

02057                 mnuAnalisisPrimMin . Enabled = True 

02058                 mnuAnalisisPrimMax . Enabled = True 

02059                 mnuAnalisisFloydWarshallmin . Enabled = True 

02060                 mnuAnalisis_Transbordo . Enabled = True 

02061                 mnuAnalisis_TSP . Enabled = True 

02062             Else 

02063                 mnuAnalisisDijkstra . Enabled = False 

02064                 mnuAnalisisDijkstraCC . Enabled = False 

02065                 mnuAnalisisDijkstraCM . Enabled = False 

02066                 mnuAnalisisDijkstraMax . Enabled = False 

02067                 mnuAnalisisBellmanFordCmin . Enabled = False 

02068                 mnuAnalisisBellmanFordCmax . Enabled = False 

02069                 mnuAnalisisFordFulkersonMax . Enabled = False 

02070      

02071                 mnuAnalisisKruskalmin . Enabled = False 

02072                 mnuAnalisisKruskalmax . Enabled = False 

02073                 mnuAnalisisPrimMin . Enabled = False 

02074                 mnuAnalisisPrimMax . Enabled = False 

02075                 mnuAnalisisFloydWarshallmin . Enabled = False 

02076                 mnuAnalisis_Transbordo . Enabled = False 

02077                 mnuAnalisis_TSP . Enabled = False 

02078             End If 

02079         End Sub 

02080         Function XYSobreNodo ( ByVal x As Single , ByVal y As Single ) As Long 

02081      

02082             Dim i As Long 

02083             Dim Dist As Single 

02084      

02085             Dim minDist As Single 

02086             Dim NdProx As Long 

02087      

02088             minDist = 1000000000000000000 

02089             NdProx = - 1 

02090      

02091             For i = 0 To UBound ( Nodos ) 

02092                 Dist = Math . Sqrt (( x - Nodos ( i ) . X * Grafico . Zoom ) ^ 2 + ( y - Nodos (  

       »                   i ) . Y * Grafico . Zoom ) ^ 2 ) 

02093                 If Dist <= minDist And Dist <= Nodos ( i ) . Radio * Grafico . Zoom Then 

02094                     minDist = Dist 

02095                     NdProx = i 

02096                 End If 

02097             Next i 

02098      

02099             Return NdProx 

02100         End Function 

02101         Private Sub mnuFormatoRejilla_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoRejilla . Click 

02102             'Activa o desactiva la visualización de la rejilla  

02103             If mnuFormatoRejilla . Checked = True Then 

02104                 mnuFormatoRejilla . Checked = False 

02105                 Grafico . MostrarRejilla = False 

02106                 CajaPropiedades . chkMostrarRejilla . Checked = False 

02107                 DibujaGrafo () 'redibuja el grafo  

02108             Else 

02109                 mnuFormatoRejilla . Checked = True 

02110                 Grafico . MostrarRejilla = True 

02111                 CajaPropiedades . chkMostrarRejilla . Checked = True 

02112      

02113                 DibujaGrafo () 'redibuja el grafo  

02114             End If 

02115      

02116         End Sub 

02117         Private Sub mnuArchivoImprimir_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuArchivoImprimir . Click 

02118             'Muestra el diálogo de previsualización  

02119             'que a su vez llama al evento PrintPage de PrintDocument1  

02120      

02121             Try 

02122                 PrintPreviewDialog1 . Document = PrintDocument1 

02123                 PrintPreviewDialog1 . ShowDialog () 

02124      

02125                 'si ocurriera algún error lo muestra en pantalla  

02126             Catch ex As Exception 

02127                 MsgBox ( "Ha fallado la operación de impresión." & vbCrLf & ex . Message  

       »                   , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

02128             End Try 

02129      

02130         End Sub 

02131         Private Sub mnuArchivoConfigurarPag_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuArchivoConfigurarPag . Click 

02132             'Establece configuración de página  

02133             With PageSetupDialog1 

02134                 . PageSettings = PrintDocument1 . DefaultPageSettings 

02135                 If . ShowDialog () = DialogResult . OK Then 

02136                     PrintDocument1 . DefaultPageSettings = . PageSettings 

02137                 End If 

02138             End With 

02139         End Sub 

02140         Private Sub mnuArchivoConfigurarImp_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuArchivoConfigurarImp . Click 

02141             'Configura impresora y parámetros de impresión  

02142             With PrintDialog1 

02143                 . PrinterSettings = PrintDocument1 . PrinterSettings 

02144                 If . ShowDialog () = DialogResult . OK Then 

02145                     PrintDocument1 . PrinterSettings = . PrinterSettings 

02146                 End If 

02147             End With 

02148         End Sub 

02149         Private Sub PrintDocument1_PrintPage ( ByVal sender As Object , ByVal e As  

       »           System . Drawing . Printing . PrintPageEventArgs ) Handles PrintDocument1 .  

       »           PrintPage 

02150             'Es llamado por el previsualizador  

02151             'rellena el PrintDocument con la imagen del picturebox  

02152             'ajustada al tamaño de página.  

02153             Me . Cursor = Cursors . WaitCursor 

02154             Dim r As Rectangle 

02155             Dim pw , ph , pl , pt As Integer 

02156      

02157             pw = PictureBox1 . Width 

02158             ph = PictureBox1 . Height 

02159             'si la imagen del picturebox es más pequeña que la página la centra en  

       »               ella  

02160             'si no se cortará!!!! (ver posibilidad de ajustar)  

02161             With PrintDocument1 . DefaultPageSettings . PaperSize 

02162                 If pw < . Width Then 

02163                     pl = ( . Width - pw ) / 2 

02164                 Else 

02165                     pl = 0 

02166                 End If 

02167                 If ph < . Height Then 

02168                     pt = ( . Height - ph ) / 2 

02169                 Else 

02170                     pt = 0 

02171                 End If 

02172             End With 

02173      

02174             'dibuja la imagen en la impresora  

02175             r = New Rectangle ( pl , pt , pw , ph ) 

02176             e . Graphics . DrawImage ( PictureBox1 . Image , r ) 

02177             Me . Cursor = Cursors . Default 

02178         End Sub 

02179         Private Sub PictureBox1_MouseDown ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . MouseEventArgs ) Handles PictureBox1 . MouseDown 

02180             Dim nd As Long 

02181             'Selección del nodo origen  

02182             If e . Button = MouseButtons . Left Then 

02183                 nd = XYSobreNodo ( e . X , e . Y ) 

02184                 If nd <> - 1 Then 

02185                     Nd1S = nd 

02186                     'If Nd1S = Nd2S Then  

02187                     'Nd2S = -1 'si selecciona encima del nd2s, deselecciona el nd2s  

02188                     'End If  

02189      

02190                     'PRUEBA ALEX  

02191                     'PUNTOS PANTALLA  

02192                     XNuevo = ( e . X - Nodos ( nd ) . X * Grafico . Zoom ) 

02193                     YNuevo = ( e . Y - Nodos ( nd ) . Y * Grafico . Zoom ) 

02194      

02195                 Else 

02196                     Nd1S = - 1 

02197                 End If 

02198                 DibujaGrafo () 

02199             End If 

02200      

02201             'Selección del nodo destino  

02202             If e . Button = MouseButtons . Right Then 

02203      

02204                 'Guarda coordenadas para la creación de un nuevo nodo  

02205                 XNuevo = e . X / Grafico . Zoom 

02206                 YNuevo = e . Y / Grafico . Zoom 

02207      

02208                 nd = XYSobreNodo ( e . X , e . Y ) 

02209                 If nd <> - 1 Then 

02210                     Nd2S = nd 

02211                     'If Nd2S = Nd1S Then  

02212                     ' Nd1S = -1 'si selecciona encima del nd1s, deselecciona el  

       »                       nd1s  

02213                     'End If  

02214                 Else 

02215                     Nd2S = - 1 

02216                 End If 

02217                 DibujaGrafo () 

02218             End If 

02219      

02220             'evita errores de selección fuera de rango  

02221             If Nd1S > TotalNodos - 1 Then Nd1S = - 1 

02222             If Nd2S > TotalNodos - 1 Then Nd2S = - 1 

02223      

02224             'Cambia visualizaciones según las selecciones  

02225             'según el nodo seleccionado  

02226             If Nd1S = - 1 Then 

02227                 StatusBar . Panels ( 3 ) . Text = "-" 

02228      

02229                 mnuAnalisisDijkstra . Enabled = False 

02230                 mnuAnalisisDijkstraMax . Enabled = False 

02231             Else 

02232                 StatusBar . Panels ( 3 ) . Text = "Nd1 = " & Nodos ( Nd1S ) . Texto 

02233      

02234                 mnuAnalisisDijkstra . Enabled = True 

02235                 mnuAnalisisDijkstraMax . Enabled = True 

02236             End If 

02237             If Nd2S = - 1 Then 

02238                 StatusBar . Panels ( 4 ) . Text = "-" 

02239                 mnuBorrarNodo . Enabled = False 

02240                 mnuEditarNodo . Enabled = False 

02241             Else 

02242                 StatusBar . Panels ( 4 ) . Text = "Nd2 = " & Nodos ( Nd2S ) . Texto 

02243                 mnuBorrarNodo . Enabled = True 

02244                 mnuEditarNodo . Enabled = True 

02245             End If 

02246             'dos nodos seleccionados  

02247             If Nd1S <> - 1 And Nd2S <> - 1 Then 'And Nd1S <> Nd2S Then  

02248                 Dim nArcos As Long 

02249                 nArcos = ExisteArco ( Nd1S , Nd2S ) 

02250                 Dim nArcosR As Long 

02251                 nArcosR = ExisteArcoReves ( Nd1S , Nd2S ) 

02252                 'comprobaciones  

02253                 'If nArcos > 0 Or nArcosR > 0 Then 'sólo un arco y en un sólo  

       »                   sentido  

02254                 If nArcos > 0 Then  'dos arcos si son en sentidos opuestos  

02255                     mnuAñadirArco . Enabled = False 

02256                 Else 

02257                     mnuAñadirArco . Enabled = True 

02258                 End If 

02259                 If nArcos = 0 Then 

02260                     'no se puede borrar y editar algo que no existe  

02261                     mnuBorrarArco . Enabled = False 

02262                     mnuEditarArco . Enabled = False 

02263                 Else 

02264                     'si existe si se puede borrar y editar  

02265                     mnuBorrarArco . Enabled = True 

02266                     mnuEditarArco . Enabled = True 

02267      

02268                 End If 

02269                 mnuAlinearNodos . Enabled = True 

02270                 mnuAnalisisDijkstraCC . Enabled = True 

02271                 mnuAnalisisDijkstraCM . Enabled = True 

02272                 mnuAnalisisBellmanFordCmax . Enabled = True 

02273                 mnuAnalisisBellmanFordCmin . Enabled = True 

02274                 mnuAnalisisFordFulkersonMax . Enabled = True 

02275             Else 

02276                 'si no se seleccionan dos no se pueden efectuar operaciones de arco  

02277                 mnuAñadirArco . Enabled = False 

02278                 mnuBorrarArco . Enabled = False 

02279                 mnuEditarArco . Enabled = False 

02280                 mnuAlinearNodos . Enabled = False 

02281                 mnuAnalisisDijkstraCC . Enabled = False 

02282                 mnuAnalisisDijkstraCM . Enabled = False 

02283                 mnuAnalisisBellmanFordCmax . Enabled = False 

02284                 mnuAnalisisBellmanFordCmin . Enabled = False 

02285                 mnuAnalisisFordFulkersonMax . Enabled = False 

02286             End If 

02287      

02288             If Nd1S = Nd2S Then mnuAlinearNodos . Enabled = False 

02289         End Sub 

02290         Private Sub mnuAñadirArco_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuAñadirArco . Click 

02291             'Añade un arco nuevo a la colección  

02292             'El arco no puede ser entre un mismo nodo  

02293             'If Nd1S = Nd2S Then Exit Sub  

02294      

02295             Dim i As Long 

02296             'i = UBound(Arcos) + 1  

02297             TotalArcos = TotalArcos + 1 

02298      

02299             ReDim Preserve Arcos ( TotalArcos - 1 ) 

02300             i = TotalArcos - 1 

02301             Arcos ( i ) . Nd1 = Nd1S 

02302             Arcos ( i ) . Nd2 = Nd2S 

02303      

02304             Arcos ( i ) . Min = 0 

02305             Arcos ( i ) . Max = 0 

02306             Arcos ( i ) . Coste = 0 

02307      

02308             'tomar opciones gráficas de la configuración por defecto  

02309             Arcos ( i ) . B = False 'por defecto false, se trata en DibujaGrafo  

02310      

02311             Arcos ( i ) . Grosor = Grafico . TrazoArco 

02312             Arcos ( i ) . Col = Grafico . ColArco 

02313      

02314             DibujaGrafo () 

02315         End Sub 

02316         Private Sub mnuAñadirNodo_Click ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles mnuAñadirNodo . Click 

02317             'Añade un nodo nuevo a la colección  

02318      

02319             Dim i As Long 

02320             ' i = UBound(Nodos) + 1  

02321      

02322             If TotalNodos = 200 Then Exit Sub 

02323      

02324             TotalNodos = TotalNodos + 1 

02325      

02326             ReDim Preserve Nodos ( TotalNodos - 1 ) 

02327             i = TotalNodos - 1 'ultimo nodo  

02328             Nodos ( i ) . X = XNuevo 

02329             Nodos ( i ) . Y = YNuevo 

02330             Nodos ( i ) . Z = 0 

02331      

02332             If Grafico . Iman Then 

02333                 Nodos ( i ) . X = Int ( Nodos ( i ) . X / Grafico . Rejilla ) * Grafico . Rejilla 

02334                 Nodos ( i ) . Y = Int ( Nodos ( i ) . Y / Grafico . Rejilla ) * Grafico . Rejilla 

02335             End If 

02336      

02337             'tomará datos de un formulario  

02338             Nodos ( i ) . Texto = i . ToString 

02339             Nodos ( i ) . Valor = 0 

02340             'tomar opciones gráficas de la configuración por defecto  

02341             'si no peta cuando el grafo está vacio y se pone el primer nodo  

02342             Nodos ( i ) . Radio = Grafico . RadioNodo  'todos los radios iguales  

02343             Nodos ( i ) . Grosor = Grafico . TrazoNodo 

02344             Nodos ( i ) . Col = Grafico . ColNodo 

02345      

02346             DibujaGrafo () 

02347         End Sub 

02348         Sub BorraArco ( ByVal n As Long ) 

02349             'Redimensiona la matriz de arcos para borrar el arco seleccionado  

02350             Dim i As Long 

02351      

02352             If n > TotalArcos - 1 Or n < 0 Then Exit Sub 

02353      

02354             If n = TotalArcos - 1 Then 'se borra el último  

02355                 ReDim Preserve Arcos ( TotalArcos - 1 - 1 ) 

02356             Else 'se corren los valores  

02357                 For i = n To TotalArcos - 1 - 1 

02358                     Arcos ( i ) = Arcos ( i + 1 ) 

02359                 Next i 

02360                 ReDim Preserve Arcos ( TotalArcos - 1 - 1 ) 

02361             End If 

02362      

02363             TotalArcos = TotalArcos - 1 

02364         End Sub 

02365         Private Sub mnuBorrarNodo_Click ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles mnuBorrarNodo . Click 

02366             Dim i As Long 

02367             Dim total As Long 

02368      

02369             'debe recorrer los arcos  

02370             If TotalArcos > 0 Then 

02371                 i = 0 

02372                 Do While i <= TotalArcos - 1 

02373      

02374                     If Arcos ( i ) . Nd1 = Nd2S Or Arcos ( i ) . Nd2 = Nd2S Then 

02375                         BorraArco ( i ) 'borrar el que tenga ese nodo seleccionado  

02376                         i = - 1 'vuelve a empezar el recorrido  

02377                     End If 

02378                     i = i + 1 

02379      

02380                     'así hasta no encontrar más arcos con ese nodo  

02381                 Loop 

02382             End If 

02383             'renumera nodos superiores al que se va a borrar  

02384             'por la traslación de indices hacia abajo que hay  

02385             'en el proceso de borrar nodo  

02386             For i = 0 To TotalArcos - 1 

02387                 If Arcos ( i ) . Nd1 > Nd2S Then Arcos ( i ) . Nd1 = Arcos ( i ) . Nd1 - 1 

02388                 If Arcos ( i ) . Nd2 > Nd2S Then Arcos ( i ) . Nd2 = Arcos ( i ) . Nd2 - 1 

02389             Next 

02390      

02391             total = UBound ( Nodos ) 'ultimo nodo  

02392      

02393             If Nd2S = total Then  'se borra el último  

02394                 'If total = 0 'Then ATENCION se borra el único existente????  

02395      

02396                 ReDim Preserve Nodos ( total - 1 ) 

02397             Else 

02398                 For i = Nd2S To total - 1 

02399                     Nodos ( i ) = Nodos ( i + 1 ) 

02400                 Next i 

02401      

02402                 'If total = 0 'Then ATENCION se borra el único existente????  

02403      

02404                 ReDim Preserve Nodos ( total - 1 ) 

02405             End If 

02406      

02407             TotalNodos = TotalNodos - 1 

02408      

02409             'no selecciona segundo nodo  

02410             Nd2S = - 1 

02411             StatusBar . Panels ( 4 ) . Text = "" 

02412      

02413             DibujaGrafo () 

02414         End Sub 

02415         Private Sub mnuBorrarArco_Click ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles mnuBorrarArco . Click 

02416             'busca en la colección de arcos el que cumple/los que cumplen las  

02417             'condiciones de origen y destino de nodos seleccionados  

02418             'una vez localizados los borra uno a uno  

02419             Dim i As Long 

02420      

02421             i = 0 

02422             Do While i <= TotalArcos - 1 

02423      

02424                 If Arcos ( i ) . Nd1 = Nd1S And Arcos ( i ) . Nd2 = Nd2S Then 

02425                     BorraArco ( i ) 

02426                     i = - 1 'vuelve a empezar el recorrido  

02427                 End If 

02428                 i = i + 1 

02429      

02430                 'así hasta no encontrar más arcos con esa condición  

02431             Loop 

02432             DibujaGrafo () 

02433         End Sub 

02434         Private Sub mnuZoomMas_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuZoomMas . Click 

02435             'Va subiendo los valores del zoom hasta 4 = 400%  

02436             If Grafico . Zoom < 4 Then Grafico . Zoom = Grafico . Zoom + 0.2 

02437      

02438             DibujaGrafo () 

02439         End Sub 

02440         Private Sub mnuZoomMenos_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuZoomMenos . Click 

02441             'Baja los valores del zoom hasta llegar a un 0.2 = 20%  

02442             If Grafico . Zoom > 0.4 Then Grafico . Zoom = Grafico . Zoom - 0.2 

02443      

02444             DibujaGrafo () 

02445         End Sub 

02446         Private Sub mnuZoomAjustar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuZoomAjustar . Click 

02447             If TotalNodos < 2 Then Exit Sub 

02448             Dim i As Long 

02449      

02450             Dim minX As Single = 1000000000 

02451             Dim minY As Single = 1000000000 

02452             Dim maxX As Single = - 1000000000 

02453             Dim maxY As Single = - 1000000000 

02454      

02455             Dim zoomx As Single 

02456             Dim zoomy As Single 

02457      

02458             For i = 0 To TotalNodos - 1 

02459      

02460                 minX = Math . Min ( Nodos ( i ) . X - Nodos ( i ) . Radio , minX ) 

02461                 minY = Math . Min ( Nodos ( i ) . Y - Nodos ( i ) . Radio , minY ) 

02462      

02463                 maxX = Math . Max ( Nodos ( i ) . X + Nodos ( i ) . Radio , maxX ) 

02464                 maxY = Math . Max ( Nodos ( i ) . Y + Nodos ( i ) . Radio , maxY ) 

02465             Next i 

02466      

02467             zoomx = ( Panel1 . Width - 20 ) / ( maxX - minX ) 

02468             zoomy = ( Panel1 . Height - 20 ) / ( maxY - minY ) 

02469      

02470             If zoomx > zoomy Then Grafico . Zoom = zoomy Else Grafico . Zoom = zoomx 

02471             minX = minX - 20 

02472             minY = minY - 20 

02473      

02474             DibujaGrafo () 

02475      

02476             'Panel1.AutoScroll = False  

02477             Dim p As Point 

02478             If minX * Grafico . Zoom <= 0 Then 

02479                 p . X = 0 

02480             Else 

02481                 p . X = minX * Grafico . Zoom 

02482             End If 

02483      

02484             If minY * Grafico . Zoom <= 0 Then 

02485                 p . Y = 0 

02486             Else 

02487                 p . Y = minY * Grafico . Zoom 

02488             End If 

02489      

02490             PictureBox1 . Left = 0 

02491             PictureBox1 . Top = 0 

02492      

02493             Panel1 . AutoScrollPosition = p 

02494      

02495             'Pone la información de zoom en panel  

02496             StatusBar . Panels ( 5 ) . Text = "Zoom = " & Format ( Grafico . Zoom , "#0.00" ) 

02497         End Sub 

02498         Sub ActivaMenus () 

02499      

02500             Me . mnuArchivoGuardar . Enabled = True 

02501             Me . mnuArchivoGuardarComo . Enabled = True 

02502             Me . mnuArchivoNuevoAleatorio . Enabled = True 

02503             Me . mnuArchivoExportarDatos . Enabled = True 

02504             Me . mnuArchivoImportarDatos . Enabled = True 

02505             Me . mnuArchivoCopiarImg . Enabled = True 

02506             Me . mnuArchivoExportarImg . Enabled = True 

02507             Me . mnuArchivoConfigurarPag . Enabled = True 

02508             Me . mnuArchivoImprimir . Enabled = True 

02509             Me . mnuEdicion . Enabled = True 

02510             Me . mnuFormato . Enabled = True 

02511             Me . mnuFormatoOpciones . Enabled = True 

02512             Me . mnuAnalisis . Enabled = True 

02513      

02514             Me . mnuAnalisisBellmanFordCmax . Enabled = False 

02515             Me . mnuAnalisisBellmanFordCmin . Enabled = False 

02516             Me . mnuAnalisisDijkstra . Enabled = False 

02517             Me . mnuAnalisisDijkstraCC . Enabled = False 

02518             Me . mnuAnalisisDijkstraCM . Enabled = False 

02519             Me . mnuAnalisisDijkstraMax . Enabled = False 

02520             Me . mnuAnalisisKruskalmax . Enabled = False 

02521             Me . mnuAnalisisKruskalmin . Enabled = False 

02522             Me . mnuAnalisisPrimMax . Enabled = False 

02523             Me . mnuAnalisisPrimMin . Enabled = False 

02524             Me . mnuAnalisisFordFulkersonMax . Enabled = False 

02525             Me . mnuAnalisisFloydWarshallmin . Enabled = False 

02526      

02527             Me . mnuAnalisis_Transbordo . Enabled = False 

02528             Me . mnuAnalisis_TSP . Enabled = False 

02529      

02530         End Sub 

02531         Private Sub mnuArchivoNuevo_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuArchivoNuevo . Click 

02532      

02533             If TotalNodos > 0 Or NodosMatriz > 0 Then 

02534                 Dim respuesta As MsgBoxResult 

02535                 respuesta = MsgBox ( " Si no ha grabado las últimas modificaciones,  

       »                   perderá los datos actuales." & vbCrLf & " ¿Desea realmente crear  

       »                   un nuevo grafo?" , MsgBoxStyle . OKCancel , ) 

02536                 If respuesta = MsgBoxResult . Cancel Then Exit Sub 

02537             End If 

02538             'nombre del fichero en estatus bar  

02539             Me . StatusBar . Panels ( 6 ) . Text = "" 

02540      

02541             'lee las opciones por defecto  

02542             OpcionesporDefecto () 

02543      

02544             'inicia la caja de propiedades con las opciones por defecto elegidas  

02545             CajaPropiedades . LeeOpciones () 

02546      

02547             'Cambia y posiciona el picturebox  

02548             PictureBox1 . Top = 0 

02549             PictureBox1 . Left = 0 

02550             PictureBox1 . Width = Grafico . TapizX * Grafico . Zoom 

02551             PictureBox1 . Height = Grafico . TapizX * Grafico . Zoom 

02552      

02553             TotalNodos = 0 

02554             TotalArcos = 0 

02555             NodosMatriz = 0 

02556      

02557             'no selecciona ningún nodo  

02558             Nd1S = - 1 

02559             Nd2S = - 1 

02560      

02561             'Llama al proceso principal de dibujar grafo  

02562             DibujaGrafo () 

02563             Grafico . Fichero = "" 

02564             Grafico . Extension = ".graphML" 'extensión por defecto .graphML  

02565      

02566             PictureBox1 . Visible = True 

02567             ActivaMenus () 

02568             Me . mnuEdicionGrafica_Click ( Me , e ) 

02569         End Sub 

02570         Sub CreaGrafoAleatorio ( ByVal n As Long , ByVal a As Long , ByVal r As Boolean ) 

02571             'Crea un grafo aleatorio  

02572             If n > 200 Then Exit Sub 

02573      

02574             TotalNodos = n 

02575             ReDim Nodos ( TotalNodos - 1 ) 

02576      

02577             Dim i , j , k As Integer 

02578             'Crea una colección de nodos  

02579             For i = 0 To TotalNodos - 1 

02580                 Nodos ( i ) . Texto = i . ToString 

02581                 Nodos ( i ) . X = Rnd () * Grafico . TapizX 

02582                 Nodos ( i ) . Y = Rnd () * Grafico . TapizY 

02583                 Nodos ( i ) . Col = Grafico . ColNodo 

02584      

02585                 Nodos ( i ) . Radio = Grafico . RadioNodo 

02586                 Nodos ( i ) . Grosor = Grafico . TrazoNodo 

02587                 Nodos ( i ) . Valor = 0 

02588             Next i 

02589             'Crea una colección de arcos  

02590      

02591             TotalArcos = 0 

02592             ReDim Arcos ( 0 ) 

02593             Dim sigue As Boolean 

02594             For i = 0 To TotalNodos - 1 

02595                 For j = 0 To TotalNodos - 1 

02596                     If 100 * Rnd () < a And a > 0 Then 

02597                         sigue = True 

02598                         If r = True And i = j Then sigue = True 

02599                         If r = False And i = j Then sigue = False 

02600                         If i <> j Then sigue = True 

02601      

02602                         If sigue Then 

02603                             TotalArcos = TotalArcos + 1 

02604                             ReDim Preserve Arcos ( TotalArcos - 1 ) 

02605      

02606                             Arcos ( TotalArcos - 1 ) . Texto = i . ToString 

02607                             Arcos ( TotalArcos - 1 ) . Col = Grafico . ColArco 

02608                             Arcos ( TotalArcos - 1 ) . Grosor = Grafico . TrazoNodo 

02609      

02610                             Arcos ( TotalArcos - 1 ) . Min = 0 

02611                             Arcos ( TotalArcos - 1 ) . Max = 0 

02612                             Arcos ( TotalArcos - 1 ) . Coste = 0 

02613      

02614                             Arcos ( TotalArcos - 1 ) . Nd1 = i 

02615                             Arcos ( TotalArcos - 1 ) . Nd2 = j 

02616                         End If 

02617                     End If 

02618                 Next j 

02619             Next i 

02620         End Sub 

02621         Private Sub mnuFormatoIman_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuFormatoIman . Click 

02622             'Activa o desactiva la opción de redondeo de rejilla  

02623             If mnuFormatoIman . Checked = True Then 

02624                 mnuFormatoIman . Checked = False 

02625                 Grafico . Iman = False 

02626                 CajaPropiedades . chkIman . Checked = False 

02627             Else 

02628                 mnuFormatoIman . Checked = True 

02629                 Grafico . Iman = True 

02630                 CajaPropiedades . chkIman . Checked = True 

02631             End If 

02632         End Sub 

02633         Private Sub mnuArchivoSalir_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuArchivoSalir . Click 

02634             'Sale del programa pidiendo antes confirmación  

02635             Dim respuesta As MsgBoxResult 

02636             respuesta = MsgBox ( "¿Desea realmente finalizar el programa?" ,  

       »               MsgBoxStyle . OKCancel , ) 

02637             If respuesta = MsgBoxResult . OK Then End 

02638         End Sub 

02639         Private Sub mnuArchivoGuardar_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuArchivoGuardar . Click 

02640             If TotalNodos < 1 Then 

02641                 MsgBox ( "Debe de crear primero algún nodo" , MsgBoxStyle . Information , 

       »                   "Grafos - Guardar" ) 

02642                 Exit Sub 

02643             End If 

02644      

02645             If Grafico . Fichero = "" Then 

02646                 'Debe elegir un nombre para el fichero  

02647                 Me . mnuArchivoGuardarComo_Click ( sender , e ) 'vuelve a 'Guardar  

       »                   como..'  

02648                 If Grafico . Fichero = "" Then Exit Sub 

02649             End If 

02650      

02651             'Diferencia rutinas de guardar en función  

02652             'del formato de fichero seleccionado (.graphML, .grf )  

02653             Me . Cursor = Cursors . WaitCursor 

02654             Me . StatusBar . Panels ( 6 ) . Text = Grafico . Fichero 

02655      

02656             Select Case Grafico . Extension 

02657                 Case ".grf" 'Extensión propietaria .grf  

02658                     GuardaFicheroGRF () 

02659                 Case ".graphML" 'Extensión por defecto .graphML  

02660                     GuardaFicheroGraphML ( Grafico . Fichero ) 

02661                 Case Else 

02662                     GuardaFicheroGRF () 

02663             End Select 

02664      

02665             Me . Cursor = Cursors . Default 

02666      

02667         End Sub 

02668         Private Sub GuardaFicheroGRF () 

02669             'Guarda el grafo en formato propietario .grf  

02670             'Este formato es secuencial, y tal vez se deje de usar en futuras  

       »               versiones  

02671             'del(programa)  

02672             'la pequeña ventaja es que generará ficheros de menor tamaño  

02673      

02674             'Abre el fichero para guardar  

02675             Try 

02676                 FileOpen ( 1 , Grafico . Fichero , OpenMode . Output , OpenAccess . Write ) 

02677      

02678                 WriteLine ( 1 , "Grafos - (cc) 2003..2005 - Alejandro Rodríguez  

       »                   Villalobos" ) 

02679                 WriteLine ( 1 , "versión: 1.0.0" ) 

02680      

02681                 'Opciones generales  

02682                 WriteLine ( 1 , Grafico . Zoom ) 

02683                 WriteLine ( 1 , Grafico . Rejilla ) 

02684      

02685                 WriteLine ( 1 , Grafico . TapizX ) 

02686                 WriteLine ( 1 , Grafico . TapizY ) 

02687      

02688                 WriteLine ( 1 , Grafico . ColorRejilla . A ) 

02689                 WriteLine ( 1 , Grafico . ColorRejilla . R ) 

02690                 WriteLine ( 1 , Grafico . ColorRejilla . G ) 

02691                 WriteLine ( 1 , Grafico . ColorRejilla . B ) 

02692      

02693                 WriteLine ( 1 , Grafico . ColorTapiz . A ) 

02694                 WriteLine ( 1 , Grafico . ColorTapiz . R ) 

02695                 WriteLine ( 1 , Grafico . ColorTapiz . G ) 

02696                 WriteLine ( 1 , Grafico . ColorTapiz . B ) 

02697      

02698                 'nodo  

02699                 WriteLine ( 1 , Grafico . Fuente . Name ) 

02700                 WriteLine ( 1 , Grafico . Fuente . Size ) 

02701                 WriteLine ( 1 , Grafico . Fuente . Style ) 

02702      

02703                 WriteLine ( 1 , Grafico . TrazoNodo ) 

02704                 WriteLine ( 1 , Grafico . RadioNodo ) 

02705                 WriteLine ( 1 , Grafico . ColNodo . A ) 

02706                 WriteLine ( 1 , Grafico . ColNodo . R ) 

02707                 WriteLine ( 1 , Grafico . ColNodo . G ) 

02708                 WriteLine ( 1 , Grafico . ColNodo . B ) 

02709      

02710                 WriteLine ( 1 , Grafico . textoNodo ) 

02711                 WriteLine ( 1 , Grafico . costNodo ) 

02712      

02713                 'arco  

02714                 WriteLine ( 1 , Grafico . minArco ) 

02715                 WriteLine ( 1 , Grafico . maxArco ) 

02716                 WriteLine ( 1 , Grafico . costArco ) 

02717                 WriteLine ( 1 , Grafico . TrazoArco ) 

02718                 WriteLine ( 1 , Grafico . BArco ) 

02719                 WriteLine ( 1 , Grafico . ColArco . A ) 

02720                 WriteLine ( 1 , Grafico . ColArco . R ) 

02721                 WriteLine ( 1 , Grafico . ColArco . G ) 

02722                 WriteLine ( 1 , Grafico . ColArco . B ) 

02723      

02724                 '---------  

02725                 WriteLine ( 1 , TotalNodos ) 'número de nodos  

02726                 WriteLine ( 1 , TotalArcos ) 'número de arcos  

02727                 Dim i As Long 

02728                 For i = 0 To TotalNodos - 1 

02729                     WriteLine ( 1 , Nodos ( i ) . Texto ) 

02730                     WriteLine ( 1 , Nodos ( i ) . X ) 

02731                     WriteLine ( 1 , Nodos ( i ) . Y ) 

02732                     WriteLine ( 1 , Nodos ( i ) . Valor ) 

02733                     WriteLine ( 1 , Nodos ( i ) . Radio ) 

02734                     WriteLine ( 1 , Nodos ( i ) . Grosor ) 

02735                     WriteLine ( 1 , Nodos ( i ) . Col . A ) 

02736                     WriteLine ( 1 , Nodos ( i ) . Col . R ) 

02737                     WriteLine ( 1 , Nodos ( i ) . Col . G ) 

02738                     WriteLine ( 1 , Nodos ( i ) . Col . B ) 

02739                 Next i 

02740                 For i = 0 To TotalArcos - 1 

02741                     WriteLine ( 1 , Arcos ( i ) . Min ) 

02742                     WriteLine ( 1 , Arcos ( i ) . Max ) 

02743                     WriteLine ( 1 , Arcos ( i ) . Coste ) 

02744                     WriteLine ( 1 , Arcos ( i ) . Nd1 ) 

02745                     WriteLine ( 1 , Arcos ( i ) . Nd2 ) 

02746                     WriteLine ( 1 , Arcos ( i ) . B ) 

02747                     WriteLine ( 1 , Arcos ( i ) . Texto ) 

02748                     WriteLine ( 1 , Arcos ( i ) . Col . A ) 

02749                     WriteLine ( 1 , Arcos ( i ) . Col . R ) 

02750                     WriteLine ( 1 , Arcos ( i ) . Col . G ) 

02751                     WriteLine ( 1 , Arcos ( i ) . Col . B ) 

02752                     WriteLine ( 1 , Arcos ( i ) . Grosor ) 

02753                 Next i 

02754      

02755                 'Intercepción de posibles errores al grabar  

02756             Catch ex As Exception 

02757                 Me . Cursor = Cursors . Default 

02758                 MsgBox ( "Ha fallado la operación de guardar fichero." & vbCrLf & ex .  

       »                   Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

02759                 Exit Sub 

02760             Finally 

02761                 FileClose ( 1 ) 

02762             End Try 

02763         End Sub 

02764         Private Sub GuardaFicheroGraphML ( ByVal fichero As String ) 

02765             'Guarda el grafo en formato de estructura XML  

02766             'GraphML  

02767             'http://graphml.graphdrawing.org  

02768      

02769             'variables locales  

02770             Dim txt As String 

02771             Dim i As Long 

02772             Dim version As String 

02773             version = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . FileMajorPart 

02774             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileMinorPart 

02775             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileBuildPart 

02776      

02777             '------------------------------  

02778             'Comienza el fichero .graphML  

02779             '------------------------------  

02780             'información cabecera .graphML  

02781             '------------------------------  

02782             txt = "" 

02783             txt & = "" 

02784             txt & = "<?xml version=""1.0"" encoding=""UTF-8""?> " & vbCrLf 

02785             txt & = "<!-- This file was written by Grafos software. -->" &  

       »               vbCrLf 

02786             txt & = "<!-- http://ttt.upv.es/~arodrigu/grafos -->" &  

       »               vbCrLf 

02787             txt & = "<!-- (cc) 2003..2005 - Alejandro Rodriguez Villalobos -->" &  

       »               vbCrLf 

02788             txt & = "<!-- Fecha: " & Now . ToShortDateString & " -->" & vbCrLf 

02789             txt & = "<!-- Version: " & version & " -->" & vbCrLf 

02790             txt & = "<graphml xmlns=""http://graphml.graphdrawing.org/xmlns"" " &  

       »               vbCrLf 

02791             txt & = " xmlns:xsi=" 

       »               "http://www.w3.org/2001/XMLSchema-instance"" " & vbCrLf 

02792             txt & = " xsi:schemaLocation=" 

       »               "http://graphml.graphdrawing.org/xmlns " & vbCrLf 

02793             txt & = "  

       »               http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd"">" & vbCrLf 

02794             txt & = "<!-- Declaración de atributos -->" & vbCrLf 

02795             '------------------------------  

02796             'Declaración de atributos xml  

02797             '------------------------------  

02798             'Atributos para el grafo  

02799             '------------------------------  

02800             txt & = "<!-- Atributos del grafo -->" & vbCrLf 

02801      

02802             'Añadir atributo de versión de Grafos??  

02803             'Atributos del tapiz por defecto  

02804             '--------------------------------  

02805             txt & = "<!-- Atributos del tapiz por defecto -->" & vbCrLf 

02806             'WriteLine(1, Grafico.Zoom)  

02807             'WriteLine(1, Grafico.Rejilla)  

02808             'WriteLine(1, Grafico.Iman)  

02809             'WriteLine(1, Grafico.MostrarRejilla)  

02810             'WriteLine(1, Grafico.TapizX)  

02811             'WriteLine(1, Grafico.TapizY)  

02812      

02813             'Atributo zoom  

02814             txt & = "<key id=""GvZ"" for=""graph"" attr.name=""GZoom"" attr.type=" 

       »               "float"">" & vbCrLf 

02815             txt & = "<default>" & Grafico . Zoom & "</default>" & vbCrLf 

02816             txt & = "</key>" & vbCrLf 

02817             'Atributo rejilla  

02818             txt & = "<key id=""GvR"" for=""graph"" attr.name=""GRejilla"" attr.type=" 

       »               "float"">" & vbCrLf 

02819             txt & = "<default>" & Grafico . Rejilla & "</default>" & vbCrLf 

02820             txt & = "</key>" & vbCrLf 

02821      

02822             'Atributo mostrar rejilla  

02823             txt & = "<key id=""GvMR"" for=""graph"" attr.name=""GMostrarRejilla""  

       »               attr.type=""boolean"">" & vbCrLf 

02824             txt & = "<default>" & Grafico . MostrarRejilla & "</default>" & vbCrLf 

02825             txt & = "</key>" & vbCrLf 

02826             'Atributo imán  

02827             txt & = "<key id=""GvI"" for=""graph"" attr.name=""GIman"" attr.type=" 

       »               "boolean"">" & vbCrLf 

02828             txt & = "<default>" & Grafico . Iman & "</default>" & vbCrLf 

02829             txt & = "</key>" & vbCrLf 

02830      

02831             'Atributo tapizX  

02832             txt & = "<key id=""GtX"" for=""graph"" attr.name=""GTapizX"" attr.type=" 

       »               "float"">" & vbCrLf 

02833             txt & = "<default>" & Grafico . TapizX & "</default>" & vbCrLf 

02834             txt & = "</key>" & vbCrLf 

02835             'Atributo tapizY  

02836             txt & = "<key id=""GtY"" for=""graph"" attr.name=""GTapizY"" attr.type=" 

       »               "float"">" & vbCrLf 

02837             txt & = "<default>" & Grafico . TapizY & "</default>" & vbCrLf 

02838             txt & = "</key>" & vbCrLf 

02839      

02840             txt & = "<!-- Atributos del color rejilla por defecto -->" & vbCrLf 

02841             'WriteLine(1, Grafico.ColorRejilla.A)  

02842             'WriteLine(1, Grafico.ColorRejilla.R)  

02843             'WriteLine(1, Grafico.ColorRejilla.G)  

02844             'WriteLine(1, Grafico.ColorRejilla.B)  

02845      

02846             'Atributo Color A  

02847             txt & = "<key id=""GrCA"" for=""graph"" attr.name=""GColorARejilla""  

       »               attr.type=""int"">" & vbCrLf 

02848             txt & = "<default>" & Grafico . ColorRejilla . A & "</default>" & vbCrLf 

02849             txt & = "</key>" & vbCrLf 

02850             'Atributo Color R  

02851             txt & = "<key id=""GrCR"" for=""graph"" attr.name=""GColorRRejilla""  

       »               attr.type=""int"">" & vbCrLf 

02852             txt & = "<default>" & Grafico . ColorRejilla . R & "</default>" & vbCrLf 

02853             txt & = "</key>" & vbCrLf 

02854             'Atributo Color G  

02855             txt & = "<key id=""GrCG"" for=""graph"" attr.name=""GColorGRejilla""  

       »               attr.type=""int"">" & vbCrLf 

02856             txt & = "<default>" & Grafico . ColorRejilla . G & "</default>" & vbCrLf 

02857             txt & = "</key>" & vbCrLf 

02858             'Atributo Color B  

02859             txt & = "<key id=""GrCB"" for=""graph"" attr.name=""GColorBRejilla""  

       »               attr.type=""int"">" & vbCrLf 

02860             txt & = "<default>" & Grafico . ColorRejilla . B & "</default>" & vbCrLf 

02861             txt & = "</key>" & vbCrLf 

02862      

02863      

02864             txt & = "<!-- Atributos del color tapiz por defecto -->" & vbCrLf 

02865             'WriteLine(1, Grafico.ColorTapiz.A)  

02866             'WriteLine(1, Grafico.ColorTapiz.R)  

02867             'WriteLine(1, Grafico.ColorTapiz.G)  

02868             'WriteLine(1, Grafico.ColorTapiz.B)  

02869             'Atributo Color A  

02870             txt & = "<key id=""GtCA"" for=""graph"" attr.name=""GColorATapiz""  

       »               attr.type=""int"">" & vbCrLf 

02871             txt & = "<default>" & Grafico . ColorTapiz . A & "</default>" & vbCrLf 

02872             txt & = "</key>" & vbCrLf 

02873             'Atributo Color R  

02874             txt & = "<key id=""GtCR"" for=""graph"" attr.name=""GColorRTapiz""  

       »               attr.type=""int"">" & vbCrLf 

02875             txt & = "<default>" & Grafico . ColorTapiz . R & "</default>" & vbCrLf 

02876             txt & = "</key>" & vbCrLf 

02877             'Atributo Color G  

02878             txt & = "<key id=""GtCG"" for=""graph"" attr.name=""GColorGTapiz""  

       »               attr.type=""int"">" & vbCrLf 

02879             txt & = "<default>" & Grafico . ColorTapiz . G & "</default>" & vbCrLf 

02880             txt & = "</key>" & vbCrLf 

02881             'Atributo Color B  

02882             txt & = "<key id=""GtCB"" for=""graph"" attr.name=""GColorBTapiz""  

       »               attr.type=""int"">" & vbCrLf 

02883             txt & = "<default>" & Grafico . ColorTapiz . B & "</default>" & vbCrLf 

02884             txt & = "</key>" & vbCrLf 

02885      

02886      

02887             txt & = "<!-- Atributos del tipo de letra por defecto -->" & vbCrLf 

02888             'WriteLine(1, Grafico.Fuente.Name)  

02889             'WriteLine(1, Grafico.Fuente.Size)  

02890             'WriteLine(1, Grafico.Fuente.Style)  

02891             'Atributo Tipo de letra  

02892             txt & = "<key id=""GfN"" for=""graph"" attr.name=""GFontName""  

       »               attr.type=""string"">" & vbCrLf 

02893             txt & = "<default>" & Grafico . Fuente . Name & "</default>" & vbCrLf 

02894             txt & = "</key>" & vbCrLf 

02895             'Atributo tamaño de letra  

02896             txt & = "<key id=""GfS"" for=""graph"" attr.name=""GFontSize""  

       »               attr.type=""float"">" & vbCrLf 

02897             txt & = "<default>" & Grafico . Fuente . Size & "</default>" & vbCrLf 

02898             txt & = "</key>" & vbCrLf 

02899             'Atributo estilo de letra  

02900             txt & = "<key id=""GfSt"" for=""graph"" attr.name=""GFontStyle""  

       »               attr.type=""float"">" & vbCrLf 

02901             txt & = "<default>" & Grafico . Fuente . Style & "</default>" & vbCrLf 

02902             txt & = "</key>" & vbCrLf 

02903      

02904             'Atributos del nodo por defecto  

02905             '--------------------------------  

02906             txt & = "<!-- Atributos del nodo por defecto -->" & vbCrLf 

02907             'WriteLine(1, Grafico.TrazoNodo)  

02908             'WriteLine(1, Grafico.RadioNodo)  

02909             'WriteLine(1, Grafico.ColNodo.A)  

02910             'WriteLine(1, Grafico.ColNodo.R)  

02911             'WriteLine(1, Grafico.ColNodo.G)  

02912             'WriteLine(1, Grafico.ColNodo.B)  

02913             'WriteLine(1, Grafico.textoNodo)  

02914             'WriteLine(1, Grafico.costNodo)  

02915      

02916             'Atributo Texto  

02917             txt & = "<key id=""GnT"" for=""graph"" attr.name=""GTextoNodo""  

       »               attr.type=""boolean"">" & vbCrLf 

02918             txt & = "<default>" & Grafico . textoNodo & "</default>" & vbCrLf 

02919             txt & = "</key>" & vbCrLf 

02920             'Atributo posX  

02921             txt & = "<key id=""GnX"" for=""graph"" attr.name=""GposXNodo""  

       »               attr.type=""float"">" & vbCrLf 

02922             txt & = "<default>0</default>" & vbCrLf 

02923             txt & = "</key>" & vbCrLf 

02924             'Atributo posY  

02925             txt & = "<key id=""GnY"" for=""graph"" attr.name=""GposYNodo""  

       »               attr.type=""float"">" & vbCrLf 

02926             txt & = "<default>0</default>" & vbCrLf 

02927             txt & = "</key>" & vbCrLf 

02928             'Atributo posZ  

02929             txt & = "<key id=""GnZ"" for=""graph"" attr.name=""GposZNodo""  

       »               attr.type=""float"">" & vbCrLf 

02930             txt & = "<default>0</default>" & vbCrLf 

02931             txt & = "</key>" & vbCrLf 

02932             'Atributo Valor  

02933             txt & = "<key id=""GnV"" for=""graph"" attr.name=""GValorNodo""  

       »               attr.type=""boolean"">" & vbCrLf 

02934             txt & = "<default>" & Grafico . costNodo & "</default>" & vbCrLf 

02935             txt & = "</key>" & vbCrLf 

02936             'Atributo Radio  

02937             txt & = "<key id=""GnR"" for=""graph"" attr.name=""GRadioNodo""  

       »               attr.type=""float"">" & vbCrLf 

02938             txt & = "<default>" & Grafico . RadioNodo & "</default>" & vbCrLf 

02939             txt & = "</key>" & vbCrLf 

02940             'Atributo Grosor  

02941             txt & = "<key id=""GnG"" for=""graph"" attr.name=""GGrosorNodo""  

       »               attr.type=""float"">" & vbCrLf 

02942             txt & = "<default>" & Grafico . TrazoNodo & "</default>" & vbCrLf 

02943             txt & = "</key>" & vbCrLf 

02944             'Atributo Color A  

02945             txt & = "<key id=""GnCA"" for=""graph"" attr.name=""GColorANodo""  

       »               attr.type=""int"">" & vbCrLf 

02946             txt & = "<default>" & Grafico . ColNodo . A & "</default>" & vbCrLf 

02947             txt & = "</key>" & vbCrLf 

02948             'Atributo Color R  

02949             txt & = "<key id=""GnCR"" for=""graph"" attr.name=""GColorRNodo""  

       »               attr.type=""int"">" & vbCrLf 

02950             txt & = "<default>" & Grafico . ColNodo . R & "</default>" & vbCrLf 

02951             txt & = "</key>" & vbCrLf 

02952             'Atributo Color G  

02953             txt & = "<key id=""GnCG"" for=""graph"" attr.name=""GColorGNodo""  

       »               attr.type=""int"">" & vbCrLf 

02954             txt & = "<default>" & Grafico . ColNodo . G & "</default>" & vbCrLf 

02955             txt & = "</key>" & vbCrLf 

02956             'Atributo Color B  

02957             txt & = "<key id=""GnCB"" for=""graph"" attr.name=""GColorBNodo""  

       »               attr.type=""int"">" & vbCrLf 

02958             txt & = "<default>" & Grafico . ColNodo . B & "</default>" & vbCrLf 

02959             txt & = "</key>" & vbCrLf 

02960      

02961             ''arco  

02962             'WriteLine(1, Grafico.minArco)  

02963             'WriteLine(1, Grafico.maxArco)  

02964             'WriteLine(1, Grafico.costArco)  

02965             'WriteLine(1, Grafico.TrazoArco)  

02966             'WriteLine(1, Grafico.BArco)  

02967             'WriteLine(1, Grafico.ColArco.A)  

02968             'WriteLine(1, Grafico.ColArco.R)  

02969             'WriteLine(1, Grafico.ColArco.G)  

02970             'WriteLine(1, Grafico.ColArco.B)  

02971      

02972             'Atributos del arco por defecto  

02973             '--------------------------------  

02974             txt & = "<!-- Atributos del arco por defecto -->" & vbCrLf 

02975             'Atributo Min  

02976             txt & = "<key id=""GaMin"" for=""graph"" attr.name=""GMinArco""  

       »               attr.type=""boolean"">" & vbCrLf 

02977             txt & = "<default>" & Grafico . minArco & "</default>" & vbCrLf 

02978             txt & = "</key>" & vbCrLf 

02979             'Atributo Max  

02980             txt & = "<key id=""GaMax"" for=""graph"" attr.name=""GMaxArco""  

       »               attr.type=""boolean"">" & vbCrLf 

02981             txt & = "<default>" & Grafico . maxArco & "</default>" & vbCrLf 

02982             txt & = "</key>" & vbCrLf 

02983             'Atributo Coste  

02984             txt & = "<key id=""GaC"" for=""graph"" attr.name=""GCosteArco""  

       »               attr.type=""boolean"">" & vbCrLf 

02985             txt & = "<default>" & Grafico . costArco & "</default>" & vbCrLf 

02986             txt & = "</key>" & vbCrLf 

02987             'Atributo Bidireccional  

02988             txt & = "<key id=""GaB"" for=""graph"" attr.name=""GBArco"" attr.type=" 

       »               "boolean"">" & vbCrLf 

02989             txt & = "<default>" & Grafico . BArco & "</default>" & vbCrLf 

02990             txt & = "</key>" & vbCrLf 

02991             'Atributo Grosor  

02992             txt & = "<key id=""GaG"" for=""graph"" attr.name=""GGrosorArco""  

       »               attr.type=""float"">" & vbCrLf 

02993             txt & = "<default>" & Grafico . TrazoArco & "</default>" & vbCrLf 

02994             txt & = "</key>" & vbCrLf 

02995             'Atributo Color A  

02996             txt & = "<key id=""GaCA"" for=""graph"" attr.name=""GColorAArco""  

       »               attr.type=""int"">" & vbCrLf 

02997             txt & = "<default>" & Grafico . ColArco . A & "</default>" & vbCrLf 

02998             txt & = "</key>" & vbCrLf 

02999             'Atributo Color R  

03000             txt & = "<key id=""GaCR"" for=""graph"" attr.name=""GColorRArco""  

       »               attr.type=""int"">" & vbCrLf 

03001             txt & = "<default>" & Grafico . ColArco . R & "</default>" & vbCrLf 

03002             txt & = "</key>" & vbCrLf 

03003             'Atributo Color G  

03004             txt & = "<key id=""GaCG"" for=""graph"" attr.name=""GColorGArco""  

       »               attr.type=""int"">" & vbCrLf 

03005             txt & = "<default>" & Grafico . ColArco . G & "</default>" & vbCrLf 

03006             txt & = "</key>" & vbCrLf 

03007             'Atributo Color B  

03008             txt & = "<key id=""GaCB"" for=""graph"" attr.name=""GColorBArco""  

       »               attr.type=""int"">" & vbCrLf 

03009             txt & = "<default>" & Grafico . ColArco . B & "</default>" & vbCrLf 

03010             txt & = "</key>" & vbCrLf 

03011      

03012             '------------------------------  

03013             'Atributos para nodos  

03014             '------------------------------  

03015             txt & = "<!-- Atributos para los nodos -->" & vbCrLf 

03016             'Atributo Texto  

03017             txt & = "<key id=""nT"" for=""node"" attr.name=""TextoNodo"" attr.type=" 

       »               "string"">" & vbCrLf 

03018             txt & = "<default> </default>" & vbCrLf 

03019             txt & = "</key>" & vbCrLf 

03020             'Atributo posX  

03021             txt & = "<key id=""nX"" for=""node"" attr.name=""posXNodo"" attr.type=" 

       »               "float"">" & vbCrLf 

03022             txt & = "<default>0</default>" & vbCrLf 

03023             txt & = "</key>" & vbCrLf 

03024             'Atributo posY  

03025             txt & = "<key id=""nY"" for=""node"" attr.name=""posYNodo"" attr.type=" 

       »               "float"">" & vbCrLf 

03026             txt & = "<default>0</default>" & vbCrLf 

03027             txt & = "</key>" & vbCrLf 

03028             'Atributo posZ  

03029             txt & = "<key id=""nZ"" for=""node"" attr.name=""posZNodo"" attr.type=" 

       »               "float"">" & vbCrLf 

03030             txt & = "<default>0</default>" & vbCrLf 

03031             txt & = "</key>" & vbCrLf 

03032             'Atributo Valor  

03033             txt & = "<key id=""nV"" for=""node"" attr.name=""ValorNodo"" attr.type=" 

       »               "float"">" & vbCrLf 

03034             txt & = "<default>0</default>" & vbCrLf 

03035             txt & = "</key>" & vbCrLf 

03036             'Atributo Radio  

03037             txt & = "<key id=""nR"" for=""node"" attr.name=""RadioNodo"" attr.type=" 

       »               "float"">" & vbCrLf 

03038             txt & = "<default>" & Grafico . RadioNodo & "</default>" & vbCrLf 

03039             txt & = "</key>" & vbCrLf 

03040             'Atributo Grosor  

03041             txt & = "<key id=""nG"" for=""node"" attr.name=""GrosorNodo"" attr.type=" 

       »               "float"">" & vbCrLf 

03042             txt & = "<default>" & Grafico . TrazoNodo & "</default>" & vbCrLf 

03043             txt & = "</key>" & vbCrLf 

03044             'Atributo Color A  

03045             txt & = "<key id=""nCA"" for=""node"" attr.name=""ColorANodo""  

       »               attr.type=""int"">" & vbCrLf 

03046             txt & = "<default>" & Grafico . ColNodo . A & "</default>" & vbCrLf 

03047             txt & = "</key>" & vbCrLf 

03048             'Atributo Color R  

03049             txt & = "<key id=""nCR"" for=""node"" attr.name=""ColorRNodo""  

       »               attr.type=""int"">" & vbCrLf 

03050             txt & = "<default>" & Grafico . ColNodo . R & "</default>" & vbCrLf 

03051             txt & = "</key>" & vbCrLf 

03052             'Atributo Color G  

03053             txt & = "<key id=""nCG"" for=""node"" attr.name=""ColorGNodo""  

       »               attr.type=""int"">" & vbCrLf 

03054             txt & = "<default>" & Grafico . ColNodo . G & "</default>" & vbCrLf 

03055             txt & = "</key>" & vbCrLf 

03056             'Atributo Color B  

03057             txt & = "<key id=""nCB"" for=""node"" attr.name=""ColorBNodo""  

       »               attr.type=""int"">" & vbCrLf 

03058             txt & = "<default>" & Grafico . ColNodo . B & "</default>" & vbCrLf 

03059             txt & = "</key>" & vbCrLf 

03060      

03061      

03062             '------------------------------  

03063             'Atributos para arcos  

03064             '------------------------------  

03065             txt & = "<!-- Atributos para los arcos -->" & vbCrLf 

03066             'Atributo Texto  

03067             txt & = "<key id=""aT"" for=""edge"" attr.name=""TextoArco"" attr.type=" 

       »               "string"">" & vbCrLf 

03068             txt & = "<default> </default>" & vbCrLf 

03069             txt & = "</key>" & vbCrLf 

03070             'Atributo Min  

03071             txt & = "<key id=""aMin"" for=""edge"" attr.name=""MinArco"" attr.type=" 

       »               "float"">" & vbCrLf 

03072             txt & = "<default>0</default>" & vbCrLf 

03073             txt & = "</key>" & vbCrLf 

03074             'Atributo Max  

03075             txt & = "<key id=""aMax"" for=""edge"" attr.name=""MaxArco"" attr.type=" 

       »               "float"">" & vbCrLf 

03076             txt & = "<default>0</default>" & vbCrLf 

03077             txt & = "</key>" & vbCrLf 

03078             'Atributo Coste  

03079             txt & = "<key id=""aC"" for=""edge"" attr.name=""CosteArco"" attr.type=" 

       »               "float"">" & vbCrLf 

03080             txt & = "<default>0</default>" & vbCrLf 

03081             txt & = "</key>" & vbCrLf 

03082             'Atributo Bidireccional  

03083             txt & = "<key id=""aB"" for=""edge"" attr.name=""BArco"" attr.type=" 

       »               "boolean"">" & vbCrLf 

03084             txt & = "<default>" & Grafico . BArco & "</default>" & vbCrLf 

03085             txt & = "</key>" & vbCrLf 

03086             'Atributo Grosor  

03087             txt & = "<key id=""aG"" for=""edge"" attr.name=""GrosorArco"" attr.type=" 

       »               "float"">" & vbCrLf 

03088             txt & = "<default>" & Grafico . TrazoArco & "</default>" & vbCrLf 

03089             txt & = "</key>" & vbCrLf 

03090             'Atributo Color A  

03091             txt & = "<key id=""aCA"" for=""edge"" attr.name=""ColorAArco""  

       »               attr.type=""int"">" & vbCrLf 

03092             txt & = "<default>" & Grafico . ColArco . A & "</default>" & vbCrLf 

03093             txt & = "</key>" & vbCrLf 

03094             'Atributo Color R  

03095             txt & = "<key id=""aCR"" for=""edge"" attr.name=""ColorRArco""  

       »               attr.type=""int"">" & vbCrLf 

03096             txt & = "<default>" & Grafico . ColArco . R & "</default>" & vbCrLf 

03097             txt & = "</key>" & vbCrLf 

03098             'Atributo Color G  

03099             txt & = "<key id=""aCG"" for=""edge"" attr.name=""ColorGArco""  

       »               attr.type=""int"">" & vbCrLf 

03100             txt & = "<default>" & Grafico . ColArco . G & "</default>" & vbCrLf 

03101             txt & = "</key>" & vbCrLf 

03102             'Atributo Color B  

03103             txt & = "<key id=""aCB"" for=""edge"" attr.name=""ColorBArco""  

       »               attr.type=""int"">" & vbCrLf 

03104             txt & = "<default>" & Grafico . ColArco . B & "</default>" & vbCrLf 

03105             txt & = "</key>" & vbCrLf 

03106      

03107             '------------------------------  

03108             'Definición del grafo  

03109             '------------------------------  

03110             txt & = "<!-- Definición del grafo -->" & vbCrLf 

03111             'grafo con arcos dirigidos  

03112             txt & = "<graph id=""Grafo"" edgedefault=""directed"" " & vbCrLf 

03113             'total de nodos y arcos para comprobación  

03114             txt & = " parse.nodes=""" & TotalNodos & """ parse.edges=""" & 

       »               TotalArcos & """ " & vbCrLf 

03115             'esta línea no se usa  

03116             'parse.maxindegree="2" parse.maxoutdegree="3"  

03117             'id de nodo nX, id de arco eX. La alternativa sería "free"  

03118             txt & = " parse.nodeids=""canonical"" parse.edgeids=" 

       »               "canonical"" " & vbCrLf 

03119             'primero va la definición de TODOS los nodos y luego la de TODOS los  

       »               arcos  

03120             txt & = " parse.order=""nodesfirst"">" & vbCrLf 

03121      

03122             '------------------------------  

03123             'información de nodos  

03124             '------------------------------  

03125             txt & = "<!-- Definición de los nodos -->" & vbCrLf 

03126             For i = 0 To TotalNodos - 1 

03127                 'definición del nodo en forma canónica  

03128                 txt & = " <node id=""n" & i . ToString & """>" & vbCrLf 

03129                 'atributos del nodo  

03130                 txt & = " <data key=""nT"">" & Nodos ( i ) . Texto & "</data>" & vbCrLf 

03131                 txt & = " <data key=""nX"">" & Nodos ( i ) . X & "</data>" & vbCrLf 

03132                 txt & = " <data key=""nY"">" & Nodos ( i ) . Y & "</data>" & vbCrLf 

03133                 txt & = " <data key=""nZ"">" & Nodos ( i ) . Z & "</data>" & vbCrLf 

03134                 txt & = " <data key=""nV"">" & Nodos ( i ) . Valor & "</data>" & vbCrLf 

03135                 txt & = " <data key=""nR"">" & Nodos ( i ) . Radio & "</data>" & vbCrLf 

03136                 txt & = " <data key=""nG"">" & Nodos ( i ) . Grosor & "</data>" &  

       »                   vbCrLf 

03137                 txt & = " <data key=""nCA"">" & Nodos ( i ) . Col . A & "</data>" &  

       »                   vbCrLf 

03138                 txt & = " <data key=""nCR"">" & Nodos ( i ) . Col . R & "</data>" &  

       »                   vbCrLf 

03139                 txt & = " <data key=""nCG"">" & Nodos ( i ) . Col . G & "</data>" &  

       »                   vbCrLf 

03140                 txt & = " <data key=""nCB"">" & Nodos ( i ) . Col . B & "</data>" &  

       »                   vbCrLf 

03141                 'fin del nodo  

03142                 txt & = " </node>" 

03143             Next i 

03144      

03145             '------------------------------  

03146             'información de arcos  

03147             '------------------------------  

03148             txt & = "<!-- Definición de los arcos -->" & vbCrLf 

03149             For i = 0 To TotalArcos - 1 

03150                 'definición del arco en forma canónica  

03151                 txt & = " <edge id=""e" & i . ToString & """ source=""n" & Arcos ( i ) .  

       »                   Nd1 . ToString & """ target=""n" & Arcos ( i ) . Nd2 . ToString & """>" &  

       »                   vbCrLf 

03152                 'atributos del arco  

03153                 txt & = " <data key=""aT"">" & Arcos ( i ) . Texto & "</data>" & vbCrLf 

03154                 txt & = " <data key=""aMin"">" & Arcos ( i ) . Min & "</data>" & vbCrLf 

03155                 txt & = " <data key=""aMax"">" & Arcos ( i ) . Max & "</data>" & vbCrLf 

03156                 txt & = " <data key=""aC"">" & Arcos ( i ) . Coste & "</data>" & vbCrLf 

03157                 txt & = " <data key=""aB"">" & Arcos ( i ) . B & "</data>" & vbCrLf 

03158                 txt & = " <data key=""aG"">" & Arcos ( i ) . Grosor & "</data>" &  

       »                   vbCrLf 

03159                 txt & = " <data key=""aCA"">" & Arcos ( i ) . Col . A & "</data>" &  

       »                   vbCrLf 

03160                 txt & = " <data key=""aCR"">" & Arcos ( i ) . Col . R & "</data>" &  

       »                   vbCrLf 

03161                 txt & = " <data key=""aCG"">" & Arcos ( i ) . Col . G & "</data>" &  

       »                   vbCrLf 

03162                 txt & = " <data key=""aCB"">" & Arcos ( i ) . Col . B & "</data>" &  

       »                   vbCrLf 

03163                 'fin del arco  

03164                 txt & = " </edge>" 

03165             Next i 

03166      

03167             '------------------------------  

03168             'pie del fichero  

03169             '------------------------------  

03170             'fin de la defición del grafo  

03171             '------------------------------  

03172             txt & = "</graph>" & vbCrLf 

03173             '------------------------------  

03174             'fin del fichero  

03175             '------------------------------  

03176             txt & = "</graphml>" 

03177      

03178             'Guarda el fichero .graphML  

03179             EscribeFicheroTexto ( fichero , txt ) 

03180         End Sub 

03181         Private Sub mnuArchivoExportarImg_Click ( ByVal sender As System . Object , ByVal 

       »           e As System . EventArgs ) Handles mnuArchivoExportarImg . Click 

03182             'llama a la función de exportar imagen a la cual le pasa el picturebox1  

03183      

03184             Me . Cursor = Cursors . WaitCursor 

03185             ExportaImagen ( PictureBox1 ) 

03186             Me . Cursor = Cursors . Default 

03187      

03188         End Sub 

03189         Private Sub mnuArchivoCopiarImg_Click ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles mnuArchivoCopiarImg . Click 

03190             CopiaImagenPortapapeles ( PictureBox1 ) 

03191         End Sub 

03192         Private Sub mnuAyudaAcercade_Click ( ByVal sender As System . Object , ByVal e As 

       »           System . EventArgs ) Handles mnuAyudaAcercade . Click 

03193             Dim s As Form 

03194             s = New Splash 

03195             s . Visible = True 

03196         End Sub 

03197         Private Sub mnuEdicionGrafica_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuEdicionGrafica . Click 

03198             If mnuEdicionTabular . Checked = True Then 

03199      

03200                 'Quita el foco al textbox para que no se  

03201                 'quede grabado su antiguo valor que va a  

03202                 'desaparecer con esta operación  

03203                 TextBox1 . Visible = False 

03204                 hfgTabla . Focus () 

03205      

03206                 hfgTabla . Visible = False 

03207      

03208                 'transforma los datos de la matriz a las  

03209                 'colecciones que forman el gráfico  

03210                 Matriz_Grafico () 

03211      

03212                 If mnuFormatoCircular . Checked Then OrdenaenEstrella () 

03213                 If mnuFormatoAleatorio . Checked Then OrdenaAleatorio () 

03214                 If mnuFormatoTablero . Checked Then OrdenaenTablero () 

03215                 If mnuFormatoFlujo . Checked Then OrdenaenFlujo () 

03216                 If mnuFormatoOrganico . Checked Then OrdenaenForceDirect () 

03217      

03218                 'dibuja de nuevo el grafo  

03219                 DibujaGrafo () 

03220      

03221                 mnuEdicionTabular . Checked = False 

03222                 mnuEdicionGrafica . Checked = True 

03223      

03224                 mnuAnalisis . Enabled = True 

03225      

03226                 Me . mnuArchivoNuevoAleatorio . Enabled = True 

03227                 mnuArchivoGuardar . Enabled = True 

03228                 mnuArchivoGuardarComo . Enabled = True 

03229                 mnuArchivoExportarDatos . Enabled = True 

03230                 mnuArchivoImportarDatos . Enabled = True 

03231                 mnuArchivoImprimir . Enabled = True 

03232                 mnuArchivoExportarImg . Enabled = True 

03233                 mnuArchivoCopiarImg . Enabled = True 

03234                 mnuFormato . Enabled = True 

03235                 PictureBox1 . Visible = True 

03236      

03237             End If 

03238         End Sub 

03239         Sub OrdenaenEstrella () 

03240             'redibuja en formato estrella  

03241      

03242             Dim i As Long 

03243             Dim angulo As Single = 2 * 3.1415 / TotalNodos 

03244             Dim cx , cy , radio As Single 

03245             cx = Grafico . TapizX / 2 

03246             cy = Grafico . TapizY / 2 

03247      

03248             If cx < cy Then radio = cx Else radio = cy 

03249      

03250             For i = 0 To TotalNodos - 1 

03251                 Nodos ( i ) . X = cx + radio * 0.9 * Math . Cos ( angulo * i ) 

03252                 Nodos ( i ) . Y = cy + radio * 0.9 * Math . Sin ( angulo * i ) 

03253             Next i 

03254         End Sub 

03255         Sub OrdenaAleatorio () 

03256             'redibuja en formato aleatorio  

03257      

03258             Dim i As Long 

03259             Dim cx , cy As Single 

03260             cx = Grafico . TapizX * 0.9 

03261             cy = Grafico . TapizY * 0.9 

03262      

03263             For i = 0 To TotalNodos - 1 

03264                 Nodos ( i ) . X = cx * Rnd () 

03265                 Nodos ( i ) . Y = cy * Rnd () 

03266             Next i 

03267         End Sub 

03268         Sub OrdenaenForceDirect () 

03269             'formato Orgánico  

03270             'redibuja en formato del algoritmo Force Direct  

03271             '(spring = muelles)  

03272      

03273             'variables locales  

03274             Dim it As Long 'contador de iteraciones  

03275             Dim BordeActivo As Boolean 

03276             BordeActivo = ExistenNodosSueltos () 

03277      

03278             Dim u , v As Long 'contador de nodos  

03279             Dim i , j , k As Long 'contadores  

03280      

03281             Dim total_it As Single 'parámetro tiempo de iteración  

03282             Dim l As Single 'parámetro de longitud  

03283             Dim r As Single 'parámetro de repulsion  

03284             Dim a As Single 'parámetro de atracción  

03285             Dim g As Single 'parámetro de gravedad al baricentro  

03286             Dim s As Single 'parámetro de distancia mínima entre nodos  

03287             Dim temp , gradE As Double 'parámetro de temperatura  

03288      

03289             Dim Fx ( TotalNodos - 1 ) As Single 'Fuerza x resultante sobre el nodo  

03290             Dim Fy ( TotalNodos - 1 ) As Single 'Fuerza y resultante sobre el nodo  

03291      

03292             Dim E As Single 'energía total del sistema  

03293             Dim Ea As Single 'energía de los arcos  

03294             Dim En As Single 'energía de los nodos  

03295             Dim E1 , E0 As Single 'gradiente de energía  

03296      

03297             Dim f , f2 As Single 'fuerza  

03298             Dim narcos As Long 'num arcos simetricos  

03299             Dim dist , dist2 As Single 'distancia  

03300             Dim gdist As Single 'gradiente de distancia  

03301             Dim dx As Single 'distancia x  

03302             Dim dy As Single 'distancia y  

03303             Dim dx2 As Single 'distancia x  

03304             Dim dy2 As Single 'distancia y  

03305             Dim x0 , y0 As Single 

03306             Dim x1 , x2 , x3 , x4 As Single 

03307             Dim y1 , y2 , y3 , y4 As Single 

03308      

03309             Dim sumx As Single 'calculo baricentro x  

03310             Dim sumy As Single 'calculo baricentro y  

03311             Dim bx As Single 'x baricentro  

03312             Dim by As Single 'y baricentro  

03313      

03314             Dim mx As Single 'movimiento x  

03315             Dim my As Single 'movimiento y  

03316             Dim condicion As Boolean 

03317             'parámetros  

03318             total_it = 1000 

03319             'l = Math.Sqrt((Grafico.TapizX * Grafico.TapizY) / TotalNodos)  

03320             'l = l * 0.8  

03321             l = Grafico . RadioNodo * 5 

03322      

03323             r = 4 

03324             a = 1.1 

03325             g = 3 

03326             s = l * 0.7 

03327      

03328             temp = 0 

03329             E = 0 

03330             E0 = 0 

03331             'inicio del bucle de iteraciones  

03332             For it = 1 To total_it 

03333                 k = k + 1 

03334                 sumx = 0 

03335                 sumy = 0 

03336      

03337                 'cálculo de fuerzas repulsivas  

03338                 'y energía del sistema  

03339                 En = 0 

03340                 For u = 0 To TotalNodos - 1 

03341                     Fx ( u ) = 0 'fuerza x inicial del grafo para cada nodo es cero  

03342                     Fy ( u ) = 0 'fuerza y inicial del grafo para cada nodo es cero  

03343                     For v = 0 To TotalNodos - 1 

03344      

03345                         'cálculo baricentro  

03346                         sumx = sumx + Nodos ( v ) . X 

03347                         sumy = sumy + Nodos ( v ) . Y 

03348      

03349                         If u <> v Then 'un nodo no se compara consigo mismo  

03350                             'distancia entre nodos  

03351                             dx = Nodos ( v ) . X - Nodos ( u ) . X 

03352                             dy = Nodos ( v ) . Y - Nodos ( u ) . Y 

03353                             dist = Math . Sqrt ( dx ^ 2 + dy ^ 2 ) 

03354                             If dist = 0 Then dist = 0.1 

03355      

03356                             'permite o no nodos encima de otros o muy próximos  

03357                             If dist < s Then 

03358                                 'funcion fuerza repulsión en x  

03359                                 f = r * dx / dist ^ 4 

03360      

03361                                 If dist < ( Nodos ( v ) . Radio + Nodos ( u ) . Radio ) Then 

03362                                     f = f * TotalNodos ^ 4 

03363                                 End If 

03364      

03365                                 Fx ( v ) = Fx ( v ) + f 

03366                                 Fx ( u ) = Fx ( u ) - f 

03367                                 'funcion fuerza repulsión en y  

03368                                 f = r * dy / dist ^ 4 

03369      

03370                                 If dist < ( Nodos ( v ) . Radio + Nodos ( u ) . Radio ) Then 

03371                                     f = f * TotalNodos ^ 4 

03372                                 End If 

03373      

03374                                 Fy ( v ) = Fy ( v ) + f 

03375                                 Fy ( u ) = Fy ( u ) - f 

03376                                 'energía entre nodos  

03377                                 En = En + r / dist ^ 4 

03378                             Else 

03379                                 'funcion fuerza repulsión en x  

03380                                 f = r * dx / dist ^ 2 

03381                                 Fx ( v ) = Fx ( v ) + f 

03382                                 Fx ( u ) = Fx ( u ) - f 

03383                                 'funcion fuerza repulsión en y  

03384                                 f = r * dy / dist ^ 2 

03385                                 Fy ( v ) = Fy ( v ) + f 

03386                                 Fy ( u ) = Fy ( u ) - f 

03387      

03388      

03389                                 'energía entre nodos  

03390                                 En = En + r / dist ^ 2 

03391                             End If 

03392                         End If 

03393      

03394                         If BordeActivo Then 

03395                             'Energía respecto a los bordes  

03396                             'distancia entre nodo y bordes  

03397                             dx = Nodos ( v ) . X 

03398                             dist = Math . Sqrt ( dx ^ 2 ) 

03399                             If dist = 0 Then dist = 0.1 

03400                             f = r / dist ^ 2 

03401                             Fx ( v ) = Fx ( v ) + f 

03402                             En = En + r / dist ^ 2 

03403      

03404                             dy = Nodos ( v ) . Y 

03405                             dist = Math . Sqrt ( dy ^ 2 ) 

03406                             If dist = 0 Then dist = 0.1 

03407                             f = r / dist ^ 2 

03408                             Fy ( v ) = Fy ( v ) + f 

03409                             En = En + r / dist ^ 2 

03410      

03411                             dx = Nodos ( v ) . X - Grafico . TapizX 

03412                             dist = Math . Sqrt ( dx ^ 2 ) 

03413                             If dist = 0 Then dist = 0.1 

03414                             f = r / dist ^ 2 

03415                             Fx ( v ) = Fx ( v ) - f 

03416                             En = En + r / dist ^ 2 

03417      

03418                             dy = Nodos ( v ) . Y - Grafico . TapizY 

03419                             dist = Math . Sqrt ( dy ^ 2 ) 

03420                             If dist = 0 Then dist = 0.1 

03421                             f = r / dist ^ 2 

03422                             Fy ( v ) = Fy ( v ) - f 

03423                             En = En + r / dist ^ 2 

03424                         End If 

03425                     Next v 

03426                 Next u 

03427      

03428                 'cálculo de fuerzas de baricentro  

03429                 'tendencia a agruparse o dispersarse del centro de gravedad  

03430                 'baricentro  

03431                 bx = sumx / TotalNodos 

03432                 by = sumy / TotalNodos 

03433      

03434                 For v = 0 To TotalNodos - 1 

03435                     'distancia al baricentro  

03436                     dx = ( Nodos ( v ) . X - bx ) 

03437                     dy = ( Nodos ( v ) . Y - by ) 

03438                     dist = Math . Sqrt ( dx ^ 2 + dy ^ 2 ) 

03439                     If dist = 0 Then dist = 0.1 

03440      

03441                     'funcion fuerza atracción al baricentro en x  

03442                     f = g * dx / dist ^ 2 

03443                     Fx ( v ) = Fx ( v ) + f 

03444                     'funcion fuerza atracción al baricentro en y  

03445                     f = g * dy / dist ^ 2 

03446                     Fy ( v ) = Fy ( v ) + f 

03447      

03448                     'dx2 = (Grafico.TapizX / 2 - bx) - dx  

03449                     'dy2 = (Grafico.TapizY / 2 - by) - dy  

03450                     'dist2 = Math.Sqrt(dx2 ^ 2 + dy2 ^ 2)  

03451                     'If dist2 = 0 Then dist2 = 0.1  

03452      

03453                     'funcion fuerza atracción al centro tapiz en x  

03454                     'f2 = dx2 / dist2  

03455                     'Fx(v) = Fx(v) + f2  

03456                     'funcion fuerza atracción al centro tapiz en y  

03457                     'f2 = dy2 / dist2  

03458                     'Fy(v) = Fy(v) + f2  

03459      

03460                     'En = En + dist2  

03461                 Next v 

03462      

03463                 'cálculo de fuerzas de atracción  

03464                 'cada arco es equivalente a un muelle  

03465                 Ea = 0 

03466                 For i = 0 To TotalArcos - 1 

03467                     If Arcos ( i ) . Nd1 <> Arcos ( i ) . Nd2 Then 

03468                         'distancia entre nodos  

03469                         dx = Nodos ( Arcos ( i ) . Nd2 ) . X - Nodos ( Arcos ( i ) . Nd1 ) . X 

03470                         dy = Nodos ( Arcos ( i ) . Nd2 ) . Y - Nodos ( Arcos ( i ) . Nd1 ) . Y 

03471                         dist = Math . Sqrt ( dx ^ 2 + dy ^ 2 ) 

03472                         If dist = 0 Then dist = 0.1 

03473      

03474                         narcos = ExisteArcoReves ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) 

03475      

03476                         'gradiente de distancia  

03477                         dist = dist - Nodos ( Arcos ( i ) . Nd1 ) . Radio - Nodos ( Arcos ( i ) .  

       »                           Nd2 ) . Radio 

03478                         gdist = ( dist - l ) '## hacer opción contando radios de  

       »                           nodos  

03479                         'energía del arco  

03480                         Ea = Ea + Math . Abs ( gdist ) 

03481      

03482                         'funcion fuerza atracción en x  

03483                         f = a * ( dx / dist ) * gdist / l 

03484      

03485                         If narcos > 0 Then f = f / 2 

03486                         Fx ( Arcos ( i ) . Nd1 ) = Fx ( Arcos ( i ) . Nd1 ) + f 

03487                         Fx ( Arcos ( i ) . Nd2 ) = Fx ( Arcos ( i ) . Nd2 ) - f 

03488                         'funcion fuerza atracción en y  

03489                         f = a * ( dy / dist ) * gdist / l 

03490      

03491                         If narcos > 0 Then f = f / 2 

03492                         Fy ( Arcos ( i ) . Nd1 ) = Fy ( Arcos ( i ) . Nd1 ) + f 

03493                         Fy ( Arcos ( i ) . Nd2 ) = Fy ( Arcos ( i ) . Nd2 ) - f 

03494      

03495                         condicion = False 

03496                         For j = 0 To TotalArcos - 1 

03497                             If Arcos ( i ) . Nd1 = Arcos ( j ) . Nd1 Then condicion = True 

03498                             If Arcos ( i ) . Nd1 = Arcos ( j ) . Nd2 Then condicion = True 

03499                             If Arcos ( i ) . Nd2 = Arcos ( j ) . Nd1 Then condicion = True 

03500                             If Arcos ( i ) . Nd2 = Arcos ( j ) . Nd2 Then condicion = True 

03501                             If Arcos ( j ) . Nd2 = Arcos ( j ) . Nd1 Then condicion = True 

03502      

03503                             'entonces son arcos independientes  

03504                             If condicion = False Then 

03505                                 x1 = Nodos ( Arcos ( i ) . Nd1 ) . X 

03506                                 x2 = Nodos ( Arcos ( i ) . Nd2 ) . X 

03507                                 x3 = Nodos ( Arcos ( j ) . Nd1 ) . X 

03508                                 x4 = Nodos ( Arcos ( j ) . Nd2 ) . X 

03509                                 y1 = Nodos ( Arcos ( i ) . Nd1 ) . Y 

03510                                 y2 = Nodos ( Arcos ( i ) . Nd2 ) . Y 

03511                                 y3 = Nodos ( Arcos ( j ) . Nd1 ) . Y 

03512                                 y4 = Nodos ( Arcos ( j ) . Nd2 ) . Y 

03513      

03514                                 dx = x2 - x1 

03515                                 dy = y2 - y1 

03516                                 dx2 = x4 - x3 

03517                                 dy2 = y4 - y3 

03518      

03519                                 'comprueba si las rectas se cortan  

03520                                 If dx / dy <> dx2 / dy2 Then 

03521                                     'busca el punto de corte  

03522                                     'solo una solución, no puede ser la misma  

       »                                       recta  

03523                                     x0 = ( dy / dx - dy2 / dx2 ) / ( y3 - y1 ) 

03524                                     y0 = y1 + x0 * dx / dy 

03525      

03526                                     'mira si punto de corte esta dentro del  

       »                                       segmento  

03527                                     If x0 >= x1 And x0 <= x2 Then 

03528                                         If y0 >= y1 And y0 <= y2 Then 

03529                                             'si se cortan arcos suma energía  

03530                                             Ea = Ea * 1.2 

03531      

03532                                             'debe impulsar un nodo para dejar de  

       »                                               ser cortante  

03533                                             f = r * dx / - dy 

03534                                             Fx ( Arcos ( i ) . Nd1 ) = Fx ( Arcos ( i ) . Nd1 )  

       »                                               + f 

03535                                             Fx ( Arcos ( i ) . Nd2 ) = Fx ( Arcos ( i ) . Nd2 )  

       »                                               - f 

03536                                             Fy ( Arcos ( i ) . Nd1 ) = Fy ( Arcos ( i ) . Nd1 )  

       »                                               + f 

03537                                             Fy ( Arcos ( i ) . Nd2 ) = Fy ( Arcos ( i ) . Nd2 )  

       »                                               - f 

03538                                             'debe impulsar un nodo para dejar de  

       »                                               ser cortante  

03539                                             f = r * dx2 / dy2 + 0.5 

03540                                             Fx ( Arcos ( j ) . Nd1 ) = Fx ( Arcos ( j ) . Nd1 )  

       »                                               + f 

03541                                             Fx ( Arcos ( j ) . Nd2 ) = Fx ( Arcos ( j ) . Nd2 )  

       »                                               - f 

03542                                             Fy ( Arcos ( j ) . Nd1 ) = Fy ( Arcos ( j ) . Nd1 )  

       »                                               + f 

03543                                             Fy ( Arcos ( j ) . Nd2 ) = Fy ( Arcos ( j ) . Nd2 )  

       »                                               - f 

03544                                         End If 

03545                                     End If 

03546                                 End If 

03547                             End If 

03548                             condicion = False 

03549                         Next j 

03550      

03551      

03552                     End If 

03553                 Next i 

03554      

03555                 'Función Energía total  

03556                 E = Math . Abs ( Ea ) + Math . Abs ( En ) 

03557                 E1 = E 

03558                 'If E1 > 1.0E+20 Then E1 = 1.0E+19  

03559      

03560                 'temperatura es función de la energía total del sistema  

03561                 gradE = ( E1 - E0 ) 

03562                 temp = temp + gradE 

03563                 If temp <= 0 Then temp = 0.000000000000001 

03564                 E0 = E1 

03565      

03566                 'desplazamiento en función de la temperatura  

03567                 For v = 0 To TotalNodos - 1 

03568                     'vector fuerza  

03569                     f = Math . Sqrt ( Fx ( v ) ^ 2 + Fy ( v ) ^ 2 ) 

03570                     If f = 0 Then f = 0.1 

03571                     'movimiento de los nodos  

03572                     mx = ( Fx ( v ) / f ) + ( Fx ( v ) / f ) * Math . Abs (( gradE +  

       »                       0.000000000000001 ) / temp ) * Nodos ( v ) . Radio 

03573                     my = ( Fy ( v ) / f ) + ( Fy ( v ) / f ) * Math . Abs (( gradE +  

       »                       0.000000000000001 ) / temp ) * Nodos ( v ) . Radio 

03574                     'cambia posición de los nodos  

03575                     Nodos ( v ) . X = Nodos ( v ) . X + mx 

03576                     Nodos ( v ) . Y = Nodos ( v ) . Y + my 

03577      

03578                     'If Grafico.Iman Then  

03579                     'Nodos(v).X = Int((Nodos(v).X + Nodos(v).Radio) /  

       »                       Grafico.Rejilla) * Grafico.Rejilla  

03580                     'Nodos(v).Y = Int((Nodos(v).Y + Nodos(v).Radio) /  

       »                       Grafico.Rejilla) * Grafico.Rejilla  

03581                     'End If  

03582      

03583                     'evita que se salgan del marco  

03584                     If Nodos ( v ) . X - Nodos ( v ) . Radio <= 0 Then Nodos ( v ) . X = Nodos ( v )  

       »                       . Radio * 2 

03585                     If Nodos ( v ) . Y - Nodos ( v ) . Radio <= 0 Then Nodos ( v ) . Y = Nodos ( v )  

       »                       . Radio * 2 

03586      

03587                     If BordeActivo Then 

03588                         If Nodos ( v ) . X + Nodos ( v ) . Radio >= Grafico . TapizX Then  

       »                           Nodos ( v ) . X = Grafico . TapizX - Nodos ( v ) . Radio * 2 

03589                         If Nodos ( v ) . Y + Nodos ( v ) . Radio >= Grafico . TapizY Then  

       »                           Nodos ( v ) . Y = Grafico . TapizY - Nodos ( v ) . Radio * 2 

03590                     End If 

03591                 Next v 

03592      

03593                 'redibuja  

03594                 If k >= 50 Then 

03595                     k = 0 

03596                     'dibuja todo  

03597                     If BordeActivo Then 

03598                         FormatoAjustar ( True , True ) 

03599                     Else 

03600                         FormatoAjustar ( False , True ) 

03601                     End If 

03602      

03603                     PictureBox1 . Refresh () 

03604                 Else 

03605                     'Debug.Write(temp)  

03606                     'Debug.Write(vbCrLf)  

03607                 End If 

03608                 If temp = 0.000000000000001 Then Exit Sub 

03609                 'If Math.Abs((gradE + 0.000000000000001) / temp) <= 0.00001 Then  

       »                   Exit Sub  

03610             Next it 

03611             'fin de las iteraciones  

03612         End Sub 

03613         Sub OrdenaenTablero () 

03614             'redibuja en formato tablero  

03615      

03616             Dim i , j As Long 

03617             Dim n As Long = Int ( Math . Sqrt ( TotalNodos ) + 1 ) 

03618             Dim cx , cy As Single 

03619             cx = Grafico . TapizX / n 

03620             cy = Grafico . TapizY / n 

03621      

03622             For i = 0 To TotalNodos - 1 

03623                 j = Int ( i / n ) 

03624      

03625                 Nodos ( i ) . X = cx / 2 + cx * j 

03626                 Nodos ( i ) . Y = cy / 2 + ( i - j * n ) * cy 

03627             Next i 

03628         End Sub 

03629         Sub Matriz_Grafico () 

03630             'transforma los valores de matriz a valores de colección  

03631             'de nodos y arcos  

03632             Dim i As Long 

03633      

03634             TotalNodos = NodosMatriz 

03635             ReDim Preserve Nodos ( TotalNodos - 1 ) 

03636             'Dim c As Color  

03637             For i = 0 To TotalNodos - 1 

03638                 Nodos ( i ) . Texto = Cabecera1 ( i ) 

03639                 If Cabecera2 ( i ) = "" Then Cabecera2 ( i ) = "0" 

03640      

03641                 Nodos ( i ) . Valor = CSng ( Cabecera2 ( i )) 

03642                 'después asigna en ordenar  

03643                 ' Nodos(i).X = Grafico.TapizX * Rnd() ' 0 'calcular  

03644                 ' Nodos(i).Y = Grafico.TapizY * Rnd() '0 'calcular  

03645                 Nodos ( i ) . Z = 0 

03646      

03647                 'If Nodos(i).Radio = 0 Then  

03648                 Nodos ( i ) . Radio = Grafico . RadioNodo 

03649                 'End If  

03650                 'If Nodos(i).Grosor = 0 Then  

03651                 Nodos ( i ) . Grosor = Grafico . TrazoNodo 

03652                 'End If  

03653      

03654                 'If Nodos(i).Col.ToString = c.Empty.ToString Then  

03655                 Nodos ( i ) . Col = Grafico . ColNodo 

03656                 'End If  

03657             Next i 

03658      

03659             Dim s1 , s2 As Integer 

03660             Dim j As Integer 

03661             Dim min , max , cost As Single 

03662             Dim p1 , p2 , p3 As String 

03663             i = 0 

03664             Dim x , y As Long 

03665      

03666             'cuenta arcos  

03667             'For x = 0 To NodosMatriz - 1  

03668             'For y = 0 To NodosMatriz - 1  

03669             ' If Trim(Matriz(x, y)).Length > 0 And x <> y Then  

03670             ''existe arco  

03671             ' i = i + 1  

03672             ' End If  

03673             ' Next y  

03674             ' Next x  

03675             ' TotalArcos = i  

03676             ' ReDim Preserve Arcos(TotalArcos - 1)  

03677      

03678             i = 0 

03679             For x = 0 To NodosMatriz - 1 

03680                 For y = 0 To NodosMatriz - 1 

03681                     If Trim ( Matriz ( x , y )) . Length > 0 Then 'And x <> y Then  

03682                         'existe arco  

03683                         i = i + 1 

03684                         TotalArcos = i 

03685      

03686                         ReDim Preserve Arcos ( TotalArcos - 1 ) 

03687      

03688                         'ver si su información es coherente  

03689                         s1 = InStr ( Matriz ( x , y ), ";" , CompareMethod . Text ) 

03690      

03691                         If s1 > 0 And s1 <= Matriz ( x , y ) . Length Then 

03692                             s2 = InStr ( Microsoft . VisualBasic . Right ( Matriz ( x , y ),  

       »                               Matriz ( x , y ) . Length - s1 ), ";" , CompareMethod . Text ) 

03693                         End If 

03694      

03695                         p1 = "" 

03696                         p2 = "" 

03697                         p3 = "" 

03698      

03699                         If s1 > 1 Then 

03700                             p1 = Microsoft . VisualBasic . Left ( Matriz ( x , y ), s1 - 1 ) 

03701      

03702                             If s2 > 0 Then 

03703                                 p2 = Mid ( Matriz ( x , y ), s1 + 1 , s2 - 1 ) 

03704                                 p3 = Microsoft . VisualBasic . Right ( Matriz ( x , y ),  

       »                                   Matriz ( x , y ) . Length - s1 - s2 ) 

03705                             Else 

03706                                 p2 = Microsoft . VisualBasic . Right ( Matriz ( x , y ),  

       »                                   Matriz ( x , y ) . Length - s1 ) 

03707                                 p3 = "" 

03708                             End If 

03709                         Else 

03710                             If s1 = 1 Then 

03711                                 p1 = "" 

03712      

03713                                 If s2 > 0 Then 

03714                                     p2 = Mid ( Matriz ( x , y ), s1 + 1 , s2 - s1 ) 

03715                                     p3 = Microsoft . VisualBasic . Right ( Matriz ( x , y ) 

       »                                       , Matriz ( x , y ) . Length - s1 - s2 ) 

03716                                 Else 

03717                                     p2 = Microsoft . VisualBasic . Right ( Matriz ( x , y ) 

       »                                       , Matriz ( x , y ) . Length - s1 ) 

03718                                     p3 = "" 

03719                                 End If 

03720                             Else 

03721                                 's1=0  

03722                                 p1 = Matriz ( x , y ) 

03723                             End If 

03724                         End If 

03725      

03726      

03727                         'evita errores de conversión de cadena vacia a single  

03728                         If p1 = "" Then p1 = "0" 

03729                         If p2 = "" Then p2 = "0" 

03730                         If p3 = "" Then p3 = "0" 

03731                         'ver opciones de gráfico para asignar partes a  

       »                           min,max,cost  

03732                         '123 ok  

03733                         If Grafico . minArco And Grafico . maxArco And Grafico . costArco 

       »                           Then 

03734                             min = CSng ( p1 ) 

03735                             max = CSng ( p2 ) 

03736                             cost = CSng ( p3 ) 

03737                         End If 

03738                         '12  

03739                         If Grafico . minArco And Grafico . maxArco And Not Grafico .  

       »                           costArco Then 

03740                             min = CSng ( p1 ) 

03741                             max = CSng ( p2 ) 

03742                             cost = 0 

03743                         End If 

03744                         '13  

03745                         If Grafico . minArco And Not Grafico . maxArco And Grafico .  

       »                           costArco Then 

03746                             min = CSng ( p1 ) 

03747                             max = 0 

03748                             cost = CSng ( p2 ) 

03749                         End If 

03750                         '23  

03751                         If Not Grafico . minArco And Grafico . maxArco And Grafico .  

       »                           costArco Then 

03752                             min = 0 

03753                             max = CSng ( p1 ) 

03754                             cost = CSng ( p2 ) 

03755                         End If 

03756                         '2  

03757                         If Not Grafico . minArco And Grafico . maxArco And Not Grafico .  

       »                           costArco Then 

03758                             min = 0 

03759                             max = CSng ( p1 ) 

03760                             cost = 0 

03761                         End If 

03762                         '3  

03763                         If Not Grafico . minArco And Not Grafico . maxArco And Grafico .  

       »                           costArco Then 

03764                             min = 0 

03765                             max = 0 

03766                             cost = CSng ( p1 ) 

03767                         End If 

03768                         '1  

03769                         If Grafico . minArco And Not Grafico . maxArco And Not Grafico .  

       »                           costArco Then 

03770                             min = CSng ( p1 ) 

03771                             max = 0 

03772                             cost = 0 

03773                         End If 

03774      

03775                         'pone los datos en el arco  

03776                         Arcos ( i - 1 ) . Min = min 

03777                         Arcos ( i - 1 ) . Max = max 

03778                         Arcos ( i - 1 ) . Coste = cost 

03779      

03780                         Arcos ( i - 1 ) . Nd1 = y 'origen= fila =cabecera1  

03781                         Arcos ( i - 1 ) . Nd2 = x 'fin= columna  

03782                         Arcos ( i - 1 ) . B = False 'por defecto siempre false, se  

       »                           trata en DibujaGrafo  

03783                         Arcos ( i - 1 ) . Texto = "" 

03784      

03785                         'If Arcos(i - 1).ToString = c.Empty.ToString Then  

03786                         Arcos ( i - 1 ) . Col = Grafico . ColArco 

03787                         'End If  

03788                         'If Arcos(i - 1).Grosor = 0 Then  

03789                         Arcos ( i - 1 ) . Grosor = Grafico . TrazoArco 

03790                         'End If  

03791                     End If 

03792                 Next y 

03793             Next x 

03794         End Sub 

03795         Private Sub mnuFormatoOpciones_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoOpciones . Click 

03796             'Muestra el formulario de opciones del Grafo  

03797      

03798             CajaPropiedades . Visible = True 

03799             mnuFormatoOpciones . Enabled = False 

03800         End Sub 

03801         Private Sub Form1_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

03802             Dim f As Form 

03803             f = New Splash0 

03804      

03805             Dim version As String 

03806             version = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . FileMajorPart 

03807             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileMinorPart 

03808             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileBuildPart 

03809      

03810             Dim nombre As String 

03811             nombre = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . ProductName 

03812             Dim CopyR As String 

03813      

03814             CopyR = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . LegalCopyright 

03815      

03816             Me . Text = nombre & " - v. " & version & " " & CopyR 

03817      

03818             f . Visible = True 

03819      

03820             'valores por defecto  

03821             OpcionesporDefecto () 

03822         End Sub 

03823         Sub DibujaTabla () 

03824      

03825             TextBox1 . Visible = False 

03826             Me . Cursor = Cursors . WaitCursor 

03827             hfgTabla . Visible = False 

03828             hfgTabla . Dock = DockStyle . Fill 

03829             Dim x As Integer 

03830             Dim y As Integer 

03831      

03832      

03833             hfgTabla . Rows = NodosMatriz + 1 

03834             hfgTabla . Cols = NodosMatriz + 2 

03835             hfgTabla . FixedCols = 0 

03836             hfgTabla . FixedRows = 1 

03837      

03838             hfgTabla . Row = 0 

03839             hfgTabla . Col = 0 

03840             hfgTabla . Text = "N1\N2" 

03841      

03842             hfgTabla . Row = 0 

03843             hfgTabla . Col = 1 

03844             hfgTabla . Text = "Coste" 

03845      

03846             For x = 0 To NodosMatriz - 1 

03847                 hfgTabla . Col = 2 + x 

03848                 hfgTabla . Text = Cabecera1 ( x ) 

03849                 hfgTabla . CellBackColor = Color . LightGray 

03850             Next x 

03851      

03852             For y = 0 To NodosMatriz - 1 

03853                 hfgTabla . Row = 1 + y 

03854      

03855                 For x = - 2 To NodosMatriz - 1 

03856      

03857                     hfgTabla . Col = 2 + x 

03858      

03859                     If x = - 2 Then 

03860                         hfgTabla . Text = Cabecera1 ( y ) 

03861                         hfgTabla . CellBackColor = Color . LightGray 

03862                     End If 

03863                     If x = - 1 Then 

03864                         hfgTabla . Text = Cabecera2 ( y ) 

03865                         hfgTabla . CellBackColor = Color . Lavender 

03866                     End If 

03867                     If x >= 0 Then 

03868                         hfgTabla . Text = Matriz ( x , y ) 

03869                         hfgTabla . CellBackColor = Color . White 

03870                     End If 

03871      

03872                     If x = y Then hfgTabla . CellBackColor = Color . WhiteSmoke  

       »                       '.LightGray  

03873                 Next x 

03874             Next y 

03875      

03876             hfgTabla . Visible = True 

03877             Me . Cursor = Cursors . Default 

03878         End Sub 

03879         Sub RellenaMatrices () 

03880             'Esta rutina, lee los datos iniciales del grafo en formato gráfico  

03881             'y rellena las matrices que se usarán para la tabla  

03882             'existe otra rutina que hace lo inverso para luego dibujar y grabar  

03883             'el grafo.  

03884      

03885             NodosMatriz = TotalNodos 

03886      

03887             'define matrices  

03888             ReDim Matriz ( NodosMatriz - 1 , NodosMatriz - 1 ) 

03889             ReDim Cabecera1 ( NodosMatriz - 1 ) 

03890             ReDim Cabecera2 ( NodosMatriz - 1 ) 

03891             Dim x , y As Long 

03892      

03893             'x e y son coordenadas de la tabla  

03894             'x=horizontal=columna  

03895             'y=vertical=fila  

03896             'no confundir con i,j donde i=fila=y,j=columna=x  

03897             'toma valores iniciales  

03898             For x = 0 To NodosMatriz - 1 

03899                 Cabecera1 ( x ) = Nodos ( x ) . Texto 

03900                 Cabecera2 ( x ) = Nodos ( x ) . Valor . ToString 

03901      

03902                 For y = 0 To NodosMatriz - 1 

03903                     'If x <> y Then  

03904                     'relación de arco  

03905                     'nodo origen=y, nodo destino=x  

03906                     'nodo origen=i, nodo destino=j  

03907                     Matriz ( x , y ) = ContenidoCelda ( y , x ) 'pone datos del arco  

       »                       según opciones  

03908                     'End If  

03909                 Next y 

03910             Next x 

03911      

03912         End Sub 

03913         Function ContenidoCelda ( ByVal n1 As Long , ByVal n2 As Long ) As String 

03914             'Busca el arco que cumple las condiciones de origen-destino  

03915             'y coloca la información necesaria en la tabla según las opciones  

03916      

03917             Dim t As String 

03918      

03919             Dim i As Long 

03920             For i = 0 To TotalArcos - 1 

03921                 If Arcos ( i ) . Nd1 = n1 And Arcos ( i ) . Nd2 = n2 Then 

03922      

03923                     If Grafico . minArco Or Grafico . maxArco Or Grafico . costArco Then 

03924                         t = "" 

03925      

03926                         If Grafico . minArco Then 

03927                             t = t & Arcos ( i ) . Min . ToString 

03928                         End If 

03929      

03930                         If Grafico . maxArco Then 

03931                             If Grafico . minArco Then t = t & "; " 

03932                             t = t & Arcos ( i ) . Max . ToString 

03933                         End If 

03934      

03935                         If Grafico . costArco Then 

03936                             If ( Grafico . maxArco Or Grafico . minArco ) Then t = t &  

       »                               "; " 

03937                             t = t & Arcos ( i ) . Coste . ToString 

03938                         End If 

03939      

03940                         t = t & "" 

03941      

03942                     End If 

03943                     Return t 

03944                 End If 

03945             Next i 

03946         End Function 

03947         Shared Sub OpcionesporDefecto () 

03948             Dim f As Form1 

03949             f = New Form1 

03950      

03951             Grafico . Zoom = 1 

03952             Grafico . Rejilla = 40 

03953             Grafico . Iman = True 

03954             Grafico . MostrarRejilla = True 

03955      

03956             Grafico . TapizX = 1000 

03957             Grafico . TapizY = 1000 

03958      

03959             Grafico . ColorRejilla = Color . LightGray 

03960             Grafico . ColorTapiz = Color . White 

03961      

03962             Grafico . MostrarImagenTapiz = False 

03963             Grafico . ImagenTapiz = "" 

03964      

03965             'nodo  

03966             Grafico . Fuente = f . Panel1 . Font 'configurar en tiempo de diseño  

03967             Grafico . TrazoNodo = 1 

03968             Grafico . RadioNodo = 15 

03969             Grafico . ColNodo = Color . LightSteelBlue 

03970             Grafico . textoNodo = True 

03971             Grafico . costNodo = True 

03972      

03973             'arco  

03974             Grafico . minArco = True 

03975             Grafico . maxArco = True 

03976             Grafico . costArco = True 

03977             Grafico . TrazoArco = 1 

03978             Grafico . BArco = False 

03979             Grafico . ColArco = Color . Black 

03980      

03981             'extensión por defecto del formato de fichero  

03982             Grafico . Extension = ".grf" 

03983         End Sub 

03984         Function ExistenNodosSueltos () As Boolean 

03985             'Busca en el grafo nodos que estén sueltos y no tengan arcos asociados  

03986      

03987             Dim i , k As Long 

03988             Dim encontrado As Boolean 

03989      

03990             For i = 0 To TotalNodos - 1 

03991                 encontrado = False 

03992      

03993                 For k = 0 To TotalArcos - 1 

03994                     If Arcos ( k ) . Nd1 = i Or Arcos ( k ) . Nd2 = i And ( Arcos ( k ) . Nd1 <>  

       »                       Arcos ( k ) . Nd2 ) Then 

03995                         'además no es un arco de entrada y salida en el mismo nodo  

03996                         encontrado = True 

03997                         Exit For 

03998                     End If 

03999                 Next k 

04000      

04001                 If encontrado = False Then 'este nodo está suelto  

04002                     Return True 'si que existen notos sueltos  

04003                 End If 

04004             Next i 

04005             Return False 'no existen nodos sueltos  

04006         End Function 

04007         Function ExisteArco ( ByVal n1 As Long , ByVal n2 As Long ) As Long 

04008             'Cuenta cuantos arcos cumplen la condición de origen - destino  

04009             Dim i As Long 

04010             Dim contador As Long 

04011             contador = 0 

04012             For i = 0 To TotalArcos - 1 

04013                 If ( Arcos ( i ) . Nd1 = n1 And Arcos ( i ) . Nd2 = n2 ) Then 

04014                     contador = contador + 1 

04015      

04016                 End If 

04017             Next i 

04018             Return contador 

04019         End Function 

04020         Function ExisteArcoReves ( ByVal n1 As Long , ByVal n2 As Long ) As Long 

04021             'Cuenta cuantos arcos cumplen la condición de origen - destino  

04022             Dim i As Long 

04023             Dim contador As Long 

04024             contador = 0 

04025             For i = 0 To TotalArcos - 1 

04026                 If ( Arcos ( i ) . Nd1 = n2 And Arcos ( i ) . Nd2 = n1 ) Then  'aunque el  

       »                   usuario lo tome al revés  

04027                     contador = contador + 1 

04028      

04029                 End If 

04030             Next i 

04031             Return contador 

04032         End Function 

04033         Private Sub mnuEditarNodo_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuEditarNodo . Click 

04034             'Accede en modo diálogo al formulario de  

04035             'edición de nodos  

04036             Dim f As Form3 

04037             f = New Form3 

04038      

04039             f . ShowDialog () 

04040      

04041             DibujaGrafo () 

04042      

04043         End Sub 

04044         Private Sub mnuEditarArco_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuEditarArco . Click 

04045             'Accede en modo diálogo al formulario de  

04046             'edición de arcos  

04047             Dim f As Form4 

04048             f = New Form4 

04049      

04050             f . ShowDialog () 

04051      

04052             DibujaGrafo () 

04053         End Sub 

04054         Private Sub mnuArchivoGuardarComo_Click ( ByVal sender As System . Object , ByVal 

       »           e As System . EventArgs ) Handles mnuArchivoGuardarComo . Click 

04055      

04056             'Esta opción de menú muestra el cuadro de diálogo  

04057             'de grabar fichero de datos del gráfico  

04058             'luego llama al procedimiento de mnuArchivoGuardar  

04059      

04060             Dim saveFileDialog1 As New SaveFileDialog 

04061             saveFileDialog1 . AddExtension = True 

04062             saveFileDialog1 . DefaultExt = ".grf" 'en caso de no especificar, se toma  

       »               el formato propietario  

04063             saveFileDialog1 . Filter = "GraphML format (*.graphml)|*.graphml|Fichero  

       »               de Grafos (*.grf)|*.grf|Todos los archivos (*.*)|*.*" 

04064      

04065             'El cuadro de diálogo se personaliza en función del formato por defecto  

04066      

04067             Select Case Grafico . Extension 

04068                 Case ".graphML" 

04069                     'formato por defecto  

04070                     saveFileDialog1 . FilterIndex = 1 'formato .graphML  

04071                     Grafico . Extension = ".graphML" 

04072                 Case ".grf" 

04073                     saveFileDialog1 . FilterIndex = 2 'formato .grf  

04074                     Grafico . Extension = ".grf" 

04075                 Case Else 

04076                     saveFileDialog1 . FilterIndex = 2 'formato .grf  

04077                     Grafico . Extension = ".grf" 

04078             End Select 

04079      

04080             saveFileDialog1 . Title = "Guardar Archivo de Grafo" 

04081             saveFileDialog1 . RestoreDirectory = True 

04082      

04083             Try 

04084                 If saveFileDialog1 . ShowDialog () = DialogResult . OK Then 

04085      

04086                     Grafico . Fichero = saveFileDialog1 . FileName 

04087      

04088                     'llama al menu de guardar fichero  

04089                     'en función de la respuesta del usuario  

04090                     'respecto a la extensión (formato fichero)  

04091                     'seleccionado.  

04092      

04093                     'Guarda con formato XML  

04094                     'Extensión .graphML  

04095                     If saveFileDialog1 . FilterIndex = 1 Then 

04096                         Grafico . Extension = ".graphML" 

04097                         Me . mnuArchivoGuardar_Click ( sender , e ) 

04098                     End If 

04099                     'Guarda con formato propietario Grafos  

04100                     'Extensión .grf  

04101                     If saveFileDialog1 . FilterIndex = 2 Then 

04102                         Grafico . Extension = ".grf" 

04103                         Me . mnuArchivoGuardar_Click ( sender , e ) 

04104                     End If 

04105                     'Cualquier otra extensión .???  

04106                     'Guarda con formato propietario Grafos  

04107                     'Extensión .grf  

04108                     If saveFileDialog1 . FilterIndex = 3 Then 

04109                         Grafico . Extension = ".grf" 

04110                         Me . mnuArchivoGuardar_Click ( sender , e ) 

04111                     End If 

04112                 End If 

04113      

04114             Catch 

04115                 Exit Sub 

04116             End Try 

04117         End Sub 

04118         Private Sub mnuArchivoAbrir_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuArchivoAbrir . Click 

04119             If TotalNodos > 0 Or NodosMatriz > 0 Then 

04120                 Dim respuesta As MsgBoxResult 

04121                 respuesta = MsgBox ( " Si abre un fichero, perderá los datos  

       »                   actuales." & vbCrLf & "¿Desea realmente abrir un fichero?" ,  

       »                   MsgBoxStyle . OKCancel , ) 

04122                 If respuesta = MsgBoxResult . Cancel Then Exit Sub 

04123             End If 

04124      

04125             'Esta opción de menú muestra el cuadro de diálogo  

04126             'de abrir fichero de datos del gráfico  

04127             'luego lee el fichero  

04128      

04129             Dim openFileDialog1 As New OpenFileDialog 

04130             openFileDialog1 . AddExtension = True 

04131             openFileDialog1 . DefaultExt = ".grf" 'en caso de no especificar, se toma  

       »               el formato propietario  

04132             openFileDialog1 . Filter = "GraphML format (*.graphml)|*.graphml|Fichero  

       »               de Grafos (*.grf)|*.grf|Todos los archivos (*.*)|*.*" 

04133             openFileDialog1 . FilterIndex = 2 'formato por defecto .grf  

04134             openFileDialog1 . Title = "Abrir Archivo de Grafo" 

04135             openFileDialog1 . RestoreDirectory = True 

04136      

04137             'personaliza el formato de lectura en función del último fichero leído  

04138             Select Case Grafico . Extension 

04139                 Case ".graphML" 

04140                     'formato por defecto  

04141                     openFileDialog1 . FilterIndex = 1 'formato .graphML  

04142                     Grafico . Extension = ".graphML" 

04143                 Case ".grf" 

04144                     openFileDialog1 . FilterIndex = 2 'formato .grf  

04145                     Grafico . Extension = ".grf" 

04146                 Case Else 

04147                     openFileDialog1 . FilterIndex = 2 'formato .grf  

04148                     Grafico . Extension = ".grf" 

04149             End Select 

04150      

04151             If openFileDialog1 . ShowDialog () = DialogResult . OK Then 

04152                 Grafico . Fichero = openFileDialog1 . FileName 

04153             Else 

04154                 Exit Sub 

04155             End If 

04156      

04157             Me . Cursor = Cursors . WaitCursor 

04158      

04159             'proceso de lectura según el tipo de extensión elegido  

04160             Select Case openFileDialog1 . FilterIndex 

04161                 Case 1 

04162                     'formato por defecto  

04163                     'openFileDialog1.FilterIndex = 1 'formato .graphML  

04164                     Grafico . Extension = ".graphML" 

04165                     LeeFicheroGraphML ( Grafico . Fichero ) 

04166                 Case 2 

04167                     'openFileDialog1.FilterIndex = 2 'formato .grf  

04168                     Grafico . Extension = ".grf" 

04169                     LeeFicheroGRF ( Grafico . Fichero ) 

04170                 Case Else 

04171                     'openFileDialog1.FilterIndex = 3 '*.* = formato .grf  

04172                     Grafico . Extension = ".grf" 

04173                     LeeFicheroGRF ( Grafico . Fichero ) 

04174             End Select 

04175      

04176             Grafico . ImagenTapiz = "" 

04177             Grafico . MostrarImagenTapiz = False 

04178             'inicia la caja de propiedades con las opciones por defecto elegidas  

04179             CajaPropiedades . LeeOpciones () 

04180      

04181             'Cambia y posiciona el picturebox  

04182             PictureBox1 . Top = 0 

04183             PictureBox1 . Left = 0 

04184             PictureBox1 . Width = Grafico . TapizX * Grafico . Zoom 

04185             PictureBox1 . Height = Grafico . TapizX * Grafico . Zoom 

04186      

04187             'no selecciona ningún nodo  

04188             Nd1S = - 1 

04189             Nd2S = - 1 

04190             DibujaGrafo () 

04191      

04192             Me . StatusBar . Panels ( 6 ) . Text = Grafico . Fichero 

04193      

04194             PictureBox1 . Visible = True 

04195             ActivaMenus () 

04196             Me . mnuEdicionGrafica_Click ( Me , e ) 

04197             Me . Cursor = Cursors . Default 

04198         End Sub 

04199         Private Sub mnuEdicionTabular_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuEdicionTabular . Click 

04200             If mnuEdicionGrafica . Checked = True Then 

04201      

04202                 If CajaImportar . Visible = True Then CajaImportar . Visible = False 

04203                 If CajaExportar . Visible = True Then CajaExportar . Visible = False 

04204                 If CajaNuevoAleatorio . Visible = True Then CajaNuevoAleatorio . Visible 

       »                   = False 

04205      

04206                 If TotalNodos = 0 Then 'CREA TABLA NUEVA  

04207      

04208                     NuevoNodosMatriz = 1 

04209                     'muestra cuadro de diálogo de total nodos  

04210                     Dim midialogo As New Form5 

04211                     midialogo . ShowDialog () 

04212      

04213                     If midialogo . DialogResult = DialogResult . OK Then 

04214      

04215                         NodosMatriz = NuevoNodosMatriz 

04216                         ReDim Matriz ( NodosMatriz - 1 , NodosMatriz - 1 ) 

04217                         ReDim Cabecera1 ( NodosMatriz - 1 ) 

04218                         ReDim Cabecera2 ( NodosMatriz - 1 ) 

04219      

04220                         'Opción de renumerado automático  

04221                         Dim RenumNodos As Boolean 

04222                         RenumNodos = False 

04223                         Dim respuesta2 As MsgBoxResult 

04224                         respuesta2 = MsgBox ( "¿Desea renumerar automáticamente los  

       »                           nodos?" , MsgBoxStyle . OKCancel , ) 

04225                         If respuesta2 = MsgBoxResult . OK Then RenumNodos = True 

04226                         Dim x As Long 

04227                         'Renumeración automática de nodos  

04228                         If RenumNodos Then 

04229                             For x = 0 To NodosMatriz - 1 

04230                                 Cabecera1 ( x ) = x 

04231                             Next x 

04232                         End If 

04233      

04234                     Else 

04235                         Exit Sub 

04236                     End If 

04237                 Else 

04238                     'Sale del programa pidiendo antes confirmación  

04239                     Dim respuesta As MsgBoxResult 

04240                     respuesta = MsgBox ( "La edición tabular del grafo actual  

       »                       supondrá la pérdida de los estilos gráficos del mismo." &  

       »                       vbCrLf & "¿Desea realmente editar en formato tabular?" ,  

       »                       MsgBoxStyle . OKCancel , ) 

04241                     If respuesta = MsgBoxResult . Cancel Then Exit Sub 

04242      

04243                     'toma valores iniciales del gráfico  

04244                     RellenaMatrices () 

04245                 End If 

04246                 'pasa al formato tabla  

04247                 DibujaTabla () 

04248      

04249                 mnuEdicionTabular . Checked = True 

04250                 mnuEdicionGrafica . Checked = False 

04251      

04252                 mnuAnalisis . Enabled = False 

04253      

04254                 Me . mnuArchivoNuevoAleatorio . Enabled = False 

04255                 mnuArchivoGuardar . Enabled = False 

04256                 mnuArchivoGuardarComo . Enabled = False 

04257                 mnuArchivoExportarDatos . Enabled = False 

04258                 mnuArchivoImportarDatos . Enabled = False 

04259                 mnuArchivoImprimir . Enabled = False 

04260                 mnuArchivoExportarImg . Enabled = False 

04261                 mnuArchivoCopiarImg . Enabled = False 

04262                 mnuFormato . Enabled = False 

04263                 PictureBox1 . Visible = False 

04264             End If 

04265         End Sub 

04266         Private Sub mnuTablaBorrarNodo_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuTablaBorrarNodo . Click 

04267             'Opción del menú popup de la celda que se ocupa de borrar  

04268             'la fila y columna del nodo seleccionado  

04269      

04270             'Quita el foco al textbox para que no se  

04271             'quede grabado su antiguo valor que va a  

04272             'desaparecer con esta operación  

04273             TextBox1 . Visible = False 

04274             hfgTabla . Focus () 

04275      

04276             'Opción de renumerado automático  

04277             Dim RenumNodos As Boolean 

04278             RenumNodos = False 

04279             Dim respuesta2 As MsgBoxResult 

04280             respuesta2 = MsgBox ( "¿Desea renumerar automáticamente los nodos?" ,  

       »               MsgBoxStyle . OKCancel , ) 

04281             If respuesta2 = MsgBoxResult . OK Then RenumNodos = True 

04282      

04283      

04284      

04285             'Para ello deberá correr los datos hacia abajo de la matriz  

04286             'y la cabeceras y redimensionar todos los arrays a uno menos  

04287             If CeldaY >= 0 And NodosMatriz > 0 Then 

04288      

04289                 Dim x , y As Long 

04290      

04291                 If CeldaY < NodosMatriz - 1 Then 

04292                     'se corren los datos hacia abajo para guardar  

04293                     For y = CeldaY To NodosMatriz - 1 - 1 

04294                         Cabecera1 ( y ) = Cabecera1 ( y + 1 ) 

04295                         Cabecera2 ( y ) = Cabecera2 ( y + 1 ) 

04296                     Next y 

04297                     For x = 0 To NodosMatriz - 1 

04298                         For y = CeldaY To NodosMatriz - 1 - 1 

04299                             Matriz ( x , y ) = Matriz ( x , y + 1 ) 

04300                         Next y 

04301                     Next x 

04302                     For x = CeldaY To NodosMatriz - 1 - 1 

04303                         For y = 0 To NodosMatriz - 1 

04304                             Matriz ( x , y ) = Matriz ( x + 1 , y ) 

04305                         Next y 

04306                     Next x 

04307                 Else 

04308                     'no es necesario correr datos  

04309                     'se perderá la última fila y  

04310                     'columna  

04311                 End If 

04312                 'ahora hay uno menos  

04313                 NodosMatriz = NodosMatriz - 1 

04314      

04315                 'define matrices  

04316                 Dim MatTemp ( NodosMatriz - 1 , NodosMatriz - 1 ) As String 

04317                 'pasa los datos a una matriz temporal  

04318                 For x = 0 To NodosMatriz - 1 

04319                     For y = 0 To NodosMatriz - 1 

04320                         MatTemp ( x , y ) = Matriz ( x , y ) 

04321                     Next y 

04322                 Next x 

04323      

04324                 'redimensiona las dos dimensiones sin preservar  

04325                 'con preserve sólo puede cambiar la última dimensión  

04326                 ReDim Matriz ( NodosMatriz - 1 , NodosMatriz - 1 ) 

04327      



04328                 'devuelve los datos desde la matriz temporal  

04329                 For x = 0 To NodosMatriz - 1 

04330                     For y = 0 To NodosMatriz - 1 

04331                         Matriz ( x , y ) = MatTemp ( x , y ) 

04332                     Next y 

04333                 Next x 

04334                 'como tiene una sola dimensión si se puede redimensionar  

04335                 ReDim Preserve Cabecera1 ( NodosMatriz - 1 ) 

04336                 ReDim Preserve Cabecera2 ( NodosMatriz - 1 ) 

04337      

04338                 'Renumeración automática de nodos  

04339                 If RenumNodos Then 

04340                     For x = 0 To NodosMatriz - 1 

04341                         Cabecera1 ( x ) = x 

04342                     Next x 

04343                 End If 

04344      

04345                 'manda redibujar la tabla  

04346                 'con una fila y columna menos  

04347                 DibujaTabla () 

04348             End If 

04349         End Sub 

04350         Private Sub mnuTablaAñadirNodo_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuTablaAñadirNodo . Click 

04351      

04352      

04353             'Quita el foco al textbox para que no se  

04354             'quede grabado su antiguo valor que va a  

04355             'desaparecer con esta operación  

04356             TextBox1 . Visible = False 

04357             hfgTabla . Focus () 

04358      

04359             'Añade una única fila más a la tabla  

04360             Dim x , y As Long 

04361      

04362             'define matrices  

04363             Dim MatTemp ( NodosMatriz - 1 , NodosMatriz - 1 ) As String 

04364             'pasa los datos a una matriz temporal  

04365             For x = 0 To NodosMatriz - 1 

04366                 For y = 0 To NodosMatriz - 1 

04367                     MatTemp ( x , y ) = Matriz ( x , y ) 

04368                 Next y 

04369             Next x 

04370      

04371             'ahora hay uno más  

04372             NodosMatriz = NodosMatriz + 1 

04373      

04374             'redimensiona las dos dimensiones sin preservar  

04375             'con preserve sólo puede cambiar la última dimensión  

04376             ReDim Matriz ( NodosMatriz - 1 , NodosMatriz - 1 ) 

04377      

04378             'devuelve los datos desde la matriz temporal  

04379             'la nueva fila columna no tendrá datos heredados  

04380             For x = 0 To NodosMatriz - 1 - 1 

04381                 For y = 0 To NodosMatriz - 1 - 1 

04382                     Matriz ( x , y ) = MatTemp ( x , y ) 

04383                 Next y 

04384             Next x 

04385             'como tiene una sola dimensión si se puede redimensionar  

04386             ReDim Preserve Cabecera1 ( NodosMatriz - 1 ) 

04387             ReDim Preserve Cabecera2 ( NodosMatriz - 1 ) 

04388      

04389             Cabecera1 ( NodosMatriz - 1 ) = "Nuevo Nodo" 

04390             Cabecera2 ( NodosMatriz - 1 ) = 0 

04391      

04392      

04393             'manda redibujar la tabla  

04394             'con una fila y columna menos  

04395             DibujaTabla () 

04396      

04397      

04398         End Sub 

04399         Private Sub mnuTablaTotalNodos_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuTablaTotalNodos . Click 

04400             'Cambia el total de nodos de la matriz  

04401      

04402             'Quita el foco al textbox para que no se  

04403             'quede grabado su antiguo valor que va a  

04404             'desaparecer con esta operación  

04405             TextBox1 . Visible = False 

04406             hfgTabla . Focus () 

04407      

04408             NuevoNodosMatriz = NodosMatriz 

04409             'muestra cuadro de diálogo de total nodos  

04410             Dim midialogo As New Form5 

04411             midialogo . ShowDialog () 

04412      

04413             Dim RenumNodos As Boolean 

04414             RenumNodos = False 

04415      

04416      

04417             If midialogo . DialogResult = DialogResult . OK Then 

04418                 'en caso de reducción avisar al usuario que perderá las últimas  

       »                   filas columnas  

04419                 If NuevoNodosMatriz < NodosMatriz Then 

04420                     Dim respuesta As MsgBoxResult 

04421                     respuesta = MsgBox ( " El nuevo tamaño de matriz es más pequeño  

       »                       que antes." & vbCrLf & " Se perderán las últimas filas y  

       »                       columnas." & vbCrLf & " ¿Desea continuar con el  

       »                       redimensionamiento de la matriz?" , MsgBoxStyle . OKCancel , ) 

04422                     If respuesta = MsgBoxResult . Cancel Then Exit Sub 

04423                 End If 

04424                 If NuevoNodosMatriz = NodosMatriz Then 

04425                     Exit Sub 

04426                 End If 

04427                 Dim respuesta2 As MsgBoxResult 

04428                 respuesta2 = MsgBox ( "¿Desea renumerar automáticamente los nodos?" ,  

       »                   MsgBoxStyle . OKCancel , ) 

04429                 If respuesta2 = MsgBoxResult . OK Then RenumNodos = True 

04430             Else 

04431                 Exit Sub 

04432             End If 

04433      

04434             'comprobar si es una operación de ampliación  

04435             'o de reducción de la matriz  

04436      

04437             Dim x , y As Long 

04438      

04439             'diferencia el orden de las operaciones según se amplie  

04440             'o reduzca el tamaño de la matriz  

04441      

04442             'define matrices  

04443             Dim MatTemp ( NodosMatriz - 1 , NodosMatriz - 1 ) As String 

04444             'pasa los datos a una matriz temporal  

04445             For x = 0 To NodosMatriz - 1 

04446                 For y = 0 To NodosMatriz - 1 

04447                     MatTemp ( x , y ) = Matriz ( x , y ) 

04448                 Next y 

04449             Next x 

04450      

04451             'redimensiona las dos dimensiones sin preservar  

04452             'con preserve sólo puede cambiar la última dimensión  

04453             ReDim Matriz ( NuevoNodosMatriz - 1 , NuevoNodosMatriz - 1 ) 

04454      

04455             'devuelve los datos desde la matriz temporal  

04456             For x = 0 To NuevoNodosMatriz - 1 

04457                 For y = 0 To NuevoNodosMatriz - 1 

04458                     If NodosMatriz > NuevoNodosMatriz Then 

04459                         'pasa todos los datos antiguos  

04460                         'se perderán las ultimas filas y columnas  

04461                         Matriz ( x , y ) = MatTemp ( x , y ) 

04462                     Else 

04463                         'pasa los datos que tiene  

04464                         'pero las nuevas filas y columnas  

04465                         'estarán vacias  

04466                         If x <= NodosMatriz - 1 And y <= NodosMatriz - 1 Then 

04467                             Matriz ( x , y ) = MatTemp ( x , y ) 

04468                         End If 

04469      

04470                     End If 

04471                 Next y 

04472             Next x 

04473      

04474             'cambia total  

04475             NodosMatriz = NuevoNodosMatriz 

04476             'como tiene una sola dimensión si se puede redimensionar  

04477             ReDim Preserve Cabecera1 ( NodosMatriz - 1 ) 

04478             ReDim Preserve Cabecera2 ( NodosMatriz - 1 ) 

04479      

04480             'Renumeración automática de nodos  

04481             If RenumNodos Then 

04482                 For x = 0 To NodosMatriz - 1 

04483                     Cabecera1 ( x ) = x 

04484                 Next x 

04485             End If 

04486      

04487             'manda redibujar la tabla  

04488             'con una fila y columna menos  

04489             DibujaTabla () 

04490         End Sub 

04491         Sub EditaCelda () 

04492             'guarda posición de celda  

04493             CeldaX = hfgTabla . Col - 2 

04494             CeldaY = hfgTabla . Row - 1 

04495      

04496             'un nodo no puede tener un arco con si mismo  

04497             'If CeldaX >= 0 And CeldaY >= 0 And CeldaX = CeldaY Then Exit Sub  

04498      

04499             'configura el textbox  

04500             TextBox1 . Visible = False 

04501             TextBox1 . AutoSize = False 

04502             TextBox1 . BorderStyle = BorderStyle . None 

04503             'posiciona el textbox  

04504             TextBox1 . Top = hfgTabla . CellTop / 15 

04505             TextBox1 . Left = hfgTabla . CellLeft / 15 

04506             TextBox1 . Width = hfgTabla . CellWidth / 15 

04507             TextBox1 . Height = hfgTabla . CellHeight / 15 

04508             TextBox1 . Font = hfgTabla . Font 

04509             TextBox1 . BackColor = Color . LightBlue 'un azul muy molón!  

04510             TextBox1 . TextAlign = HorizontalAlignment . Right 

04511             'toma el texto a editar  

04512             TextBox1 . Text = hfgTabla . Text 

04513             'selecciona automáticamente su contenido  

04514             TextBox1 . SelectionStart = 0 

04515             TextBox1 . SelectionLength = TextBox1 . Text . Length 

04516             'Muestra el textbox de edición de celda  

04517             TextBox1 . Visible = True 

04518             TextBox1 . Focus () 'le pasa el foco!!  

04519         End Sub 

04520         Private Sub hfgTabla_KeyPressEvent ( ByVal sender As Object , ByVal e As  

       »           AxMSFlexGridLib . DMSFlexGridEvents_KeyPressEvent ) Handles hfgTabla .  

       »           KeyPressEvent 

04521             'Activa la edición de la celda actual  

04522             'al pulsar la tecla enter sobre la tabla  

04523             If e . keyAscii = 13 Then 

04524                 EditaCelda () 

04525             End If 

04526         End Sub 

04527         Private Sub TextBox1_Leave ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles TextBox1 . Leave 

04528             'Guarda los nuevos datos tanto en la matriz como en la tabla  

04529             'así no es necesario redibujar toda la tabla cada vez  

04530             If CeldaX > - 2 And CeldaY >= 0 Then 

04531                 FiltraTexto ( sender ) 

04532             End If 

04533      

04534             Dim x , y As Long 

04535             If CeldaX >= 0 And CeldaY >= 0 And NodosMatriz > 0 Then 

04536                 Matriz ( CeldaX , CeldaY ) = TextBox1 . Text 

04537      

04538                 x = CeldaX + 2 

04539                 y = CeldaY + 1 

04540      

04541                 hfgTabla . Row = y 

04542                 hfgTabla . Col = x 

04543                 hfgTabla . Text = TextBox1 . Text 

04544             End If 

04545             If CeldaX = - 2 And CeldaY >= 0 And NodosMatriz > 0 Then 

04546                 Cabecera1 ( CeldaY ) = TextBox1 . Text 

04547      

04548                 x = 0 

04549                 y = CeldaY + 2 

04550      

04551                 hfgTabla . Col = y 

04552                 hfgTabla . Row = x 

04553                 hfgTabla . Text = TextBox1 . Text 

04554      

04555                 hfgTabla . Col = 0 

04556                 hfgTabla . Row = y - 1 

04557                 hfgTabla . Text = TextBox1 . Text 

04558      

04559             End If 

04560             If CeldaX = - 1 And CeldaY >= 0 And NodosMatriz > 0 Then 

04561                 Cabecera2 ( CeldaY ) = TextBox1 . Text 

04562      

04563                 x = CeldaX + 2 

04564                 y = CeldaY + 1 

04565      

04566                 hfgTabla . Row = y 

04567                 hfgTabla . Col = x 

04568                 hfgTabla . Text = TextBox1 . Text 

04569             End If 

04570      

04571         End Sub 

04572         Private Sub TextBox1_KeyPress ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . KeyPressEventArgs ) Handles TextBox1 . KeyPress 

04573             'Si se pulsa enter finaliza la edición de la celda  

04574             If Asc ( e . KeyChar ) = 13 Then 

04575                 TextBox1_Leave ( sender , e ) 

04576                 TextBox1 . Visible = False 

04577             End If 

04578             'Interior de la matriz  

04579             If CeldaX > - 2 And CeldaY >= 0 Then 

04580                 'excepción separador ; a la función interceptateclas  

04581                 If e . KeyChar = ";" Then 

04582                     'caracter permitido  

04583                 Else 

04584                     InterceptaTeclas ( e ) 

04585                 End If 

04586             End If 

04587             'Cabecera 2  

04588             If CeldaX = - 1 And CeldaY >= 0 Then 

04589                 InterceptaTeclas ( e ) 

04590             End If 

04591         End Sub 

04592         Private Sub hfgTabla_EnterCell ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles hfgTabla . EnterCell 

04593             'marca la celda que está en edición e informa al usuario  

04594             'en el statusbar  

04595      

04596             CeldaX = hfgTabla . Col - 2 

04597             CeldaY = hfgTabla . Row - 1 

04598             'status bar panel  

04599             If CeldaY >= 0 Then 

04600                 StatusBar . Panels ( 0 ) . Text = "N1=" & Cabecera1 ( CeldaY ) 

04601             Else 

04602                 StatusBar . Panels ( 0 ) . Text = "" 

04603             End If 

04604             If CeldaX >= 0 Then 

04605                 StatusBar . Panels ( 1 ) . Text = "N2=" & Cabecera1 ( CeldaX ) 

04606             Else 

04607                 StatusBar . Panels ( 1 ) . Text = "" 

04608             End If 

04609             'Opciones del menú popup  

04610             If CeldaX = - 2 And CeldaY >= 0 And NodosMatriz > 1 Then 

04611                 mnuTablaBorrarNodo . Enabled = True 

04612             Else 

04613                 mnuTablaBorrarNodo . Enabled = False 

04614             End If 

04615      

04616         End Sub 

04617         Private Sub hfgTabla_ClickEvent ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles hfgTabla . ClickEvent 

04618             'Se activa la edición de la celda  

04619             'al hacer clic sobre la tabla  

04620             TextBox1 . Visible = False 

04621             EditaCelda () 

04622      

04623         End Sub 

04624         Private Sub mnuFormatoCircular_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoCircular . Click 

04625             mnuFormatoAleatorio . Checked = False 

04626             mnuFormatoTablero . Checked = False 

04627             mnuFormatoCircular . Checked = True 

04628             mnuFormatoFlujo . Checked = False 

04629             mnuFormatoOrganico . Checked = False 

04630      

04631             If TotalNodos = 0 Then Exit Sub 

04632      

04633             'pide antes confirmación  

04634             Dim respuesta As MsgBoxResult 

04635             respuesta = MsgBox ( "Esta opción cambiará la ubicación de los nodos en  

       »               forma de estrella." & vbCrLf & "¿Desea realmente reordenar los  

       »               nodos?" , MsgBoxStyle . OKCancel , ) 

04636             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

04637      

04638             Me . Cursor = Cursors . WaitCursor 

04639             OrdenaenEstrella () 

04640      

04641             If Grafico . Iman Then Imantar () 

04642             DibujaGrafo () 

04643             Me . Cursor = Cursors . Default 

04644         End Sub 

04645         Private Sub mnuFormatoAleatorio_Click ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles mnuFormatoAleatorio . Click 

04646      

04647             mnuFormatoAleatorio . Checked = True 

04648             mnuFormatoTablero . Checked = False 

04649             mnuFormatoCircular . Checked = False 

04650             mnuFormatoFlujo . Checked = False 

04651             mnuFormatoOrganico . Checked = False 

04652      

04653             If TotalNodos = 0 Then Exit Sub 

04654      

04655      

04656             'pide antes confirmación  

04657             Dim respuesta As MsgBoxResult 

04658             respuesta = MsgBox ( "Esta opción cambiará la ubicación de los nodos de  

       »               manera aleatoria." & vbCrLf & "¿Desea realmente reordenar los nodos?"  

       »               , MsgBoxStyle . OKCancel , ) 

04659             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

04660             Me . Cursor = Cursors . WaitCursor 

04661             OrdenaAleatorio () 

04662      

04663             If Grafico . Iman Then Imantar () 

04664             DibujaGrafo () 

04665             Me . Cursor = Cursors . Default 

04666         End Sub 

04667         Private Sub mnuFormatoTablero_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoTablero . Click 

04668      

04669             mnuFormatoAleatorio . Checked = False 

04670             mnuFormatoTablero . Checked = True 

04671             mnuFormatoCircular . Checked = False 

04672             mnuFormatoFlujo . Checked = False 

04673             mnuFormatoOrganico . Checked = False 

04674             If TotalNodos = 0 Then Exit Sub 

04675      

04676             'pide antes confirmación  

04677             Dim respuesta As MsgBoxResult 

04678             respuesta = MsgBox ( "Esta opción cambiará la ubicación de los nodos en  

       »               forma de cuadrícula." & vbCrLf & " ¿Desea realmente reordenar los  

       »               nodos?" , MsgBoxStyle . OKCancel , ) 

04679             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

04680             Me . Cursor = Cursors . WaitCursor 

04681             OrdenaenTablero () 

04682      

04683             If Grafico . Iman Then Imantar () 

04684             DibujaGrafo () 

04685             Me . Cursor = Cursors . Default 

04686         End Sub 

04687         Private Sub mnuFormato_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuFormato . Click 

04688      

04689         End Sub 

04690         Private Sub mnuTablaCopiarTabla_Click ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles mnuTablaCopiarTabla . Click 

04691             'copia el contenido de toda la tabla al portapapeles  

04692      

04693             'Quita el foco al textbox para que no se  

04694             'quede grabado su antiguo valor que va a  

04695             'desaparecer con esta operación  

04696             TextBox1 . Visible = False 

04697             hfgTabla . Focus () 

04698      

04699             Dim cadena As String 

04700             Dim campo As String 

04701             Dim x , y As Long 

04702      

04703             cadena = "" 

04704             For y = - 1 To NodosMatriz - 1 

04705                 campo = "" 

04706                 For x = - 2 To NodosMatriz - 1 

04707                     If y = - 1 Then 

04708                         If x = - 2 Then 

04709                             campo = campo & "N1\N2" & vbTab 

04710                         End If 

04711                         If x = - 1 Then 

04712                             campo = campo & "Coste" & vbTab 

04713                         End If 

04714                         If x > - 1 Then 

04715                             campo = campo & Cabecera1 ( x ) & vbTab 

04716                         End If 

04717                     End If 

04718                     If y > - 1 Then 

04719                         If x = - 2 Then 

04720                             campo = campo & Cabecera1 ( y ) & vbTab 

04721                         End If 

04722                         If x = - 1 Then 

04723                             campo = campo & Cabecera2 ( y ) & vbTab 

04724                         End If 

04725                         If x > - 1 Then 

04726                             campo = campo & Matriz ( x , y ) & vbTab 

04727                         End If 

04728                     End If 

04729                 Next x 

04730                 cadena = cadena + campo & vbCrLf 

04731             Next y 

04732      

04733             Clipboard . SetDataObject ( cadena ) 

04734         End Sub 

04735         Private Sub mnuAlinearNodosH_Click ( ByVal sender As System . Object , ByVal e As 

       »           System . EventArgs ) Handles mnuAlinearNodosH . Click 

04736             'Iguala la coordenada Y de los dos nodos seleccionados  

04737             If Nodos ( Nd1S ) . Y < Nodos ( Nd2S ) . Y Then 

04738                 Nodos ( Nd2S ) . Y = Nodos ( Nd1S ) . Y 

04739             Else 

04740                 Nodos ( Nd1S ) . Y = Nodos ( Nd2S ) . Y 

04741             End If 

04742      

04743             If Grafico . Iman Then 

04744                 Nodos ( Nd1S ) . X = Int ( Nodos ( Nd1S ) . X / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04745                 Nodos ( Nd1S ) . Y = Int ( Nodos ( Nd1S ) . Y / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04746      

04747                 Nodos ( Nd2S ) . X = Int ( Nodos ( Nd2S ) . X / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04748                 Nodos ( Nd2S ) . Y = Int ( Nodos ( Nd2S ) . Y / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04749             End If 

04750      

04751             DibujaGrafo () 

04752      

04753         End Sub 

04754         Private Sub mnuAlinearNodosV_Click ( ByVal sender As System . Object , ByVal e As 

       »           System . EventArgs ) Handles mnuAlinearNodosV . Click 

04755             'Iguala la coordenada X de los dos nodos seleccionados  

04756             If Nodos ( Nd1S ) . X < Nodos ( Nd2S ) . X Then 

04757                 Nodos ( Nd2S ) . X = Nodos ( Nd1S ) . X 

04758             Else 

04759                 Nodos ( Nd1S ) . X = Nodos ( Nd2S ) . X 

04760             End If 

04761      

04762             If Grafico . Iman Then 

04763                 Nodos ( Nd1S ) . X = Int ( Nodos ( Nd1S ) . X / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04764                 Nodos ( Nd1S ) . Y = Int ( Nodos ( Nd1S ) . Y / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04765      

04766                 Nodos ( Nd2S ) . X = Int ( Nodos ( Nd2S ) . X / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04767                 Nodos ( Nd2S ) . Y = Int ( Nodos ( Nd2S ) . Y / Grafico . Rejilla ) * Grafico .  

       »                   Rejilla 

04768             End If 

04769      

04770             DibujaGrafo () 

04771         End Sub 

04772         Private Sub mnuAlinearNodos_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuAlinearNodos . Click 

04773      

04774         End Sub 

04775         Private Sub Dijkstra1_Fallo ( ByVal TextoError As String ) Handles Dijkstra1 .  

       »           Fallo 

04776             'Este evento salta en caso de un error en el proceso de Dijstra  

04777             MsgBox ( TextoError , MsgBoxStyle . Exclamation , "Error en el proceso  

       »               Dijkstra" ) 

04778         End Sub 

04779         Private Sub mnuAnalisisDijkstra_Click ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles mnuAnalisisDijkstra . Click 

04780      

04781             If Nd1S = - 1 Then 

04782                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Árbol mínimo) debe  

       »                   seleccionar" & vbCrLf & "un nodo con el botón izquierdo del  

       »                   ratón." , MsgBoxStyle . Information , "Algoritmo de Dijkstra" ) 

04783                 Exit Sub 

04784             End If 

04785      

04786             If Grafico . costArco = False Then 

04787                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Árbol mínimo) debe  

       »                   activar la opción Coste" & vbCrLf & "de los arcos del grafo en el 

       »                   menú Formato/Opciones/Arcos." , MsgBoxStyle . Information ,  

       »                   "Algoritmo de Dijkstra" ) 

04788                 Exit Sub 

04789             End If 

04790      

04791             '----------------------------------------------------  

04792             'A la dll se le debe pasar un array de strings  

04793             'de dimensión totalnodos-1 ya que empieza en 0  

04794             'con el nombre o etiqueta de los nodos  

04795             '----------------------------------------------------  

04796      

04797             'Dim prueba() As String  

04798             'ReDim prueba(4)  

04799             'prueba(0) = "Nodo 0"  

04800             'prueba(1) = "Nodo 1"  

04801             'prueba(2) = "Nodo 2"  

04802             'prueba(3) = "Nodo 3"  

04803             'prueba(4) = "Nodo 4"  

04804      

04805      

04806             Dim i , j As Long 

04807             Dim MatrizNodos ( TotalNodos - 1 ) As String 

04808             For i = 0 To TotalNodos - 1 

04809                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

04810             Next i 

04811      

04812             '----------------------------------------------------  

04813             'a la dll se le debe pasar las relaciones de arco en  

04814             'matriz(i,j) donde i=nodo origen, j=nodo destino  

04815             'de dimensiones de 0 a totalnodos-1 para i y para j  

04816             'contendrá un single >=0  

04817             'recuerda que después del proceso RellenaMatrices  

04818             'se dispone de un array de relación de arco que es  

04819             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

04820             '----------------------------------------------------  

04821      

04822             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

04823             'pone toda la matriz a -1  

04824             For i = 0 To TotalNodos - 1 

04825                 For j = 0 To TotalNodos - 1 

04826                     MatrizArcos ( i , j ) = - 1 

04827                 Next j 

04828             Next i 

04829             'marca los arcos existentes, pero no los de un mismo nodo  

04830             For i = 0 To TotalArcos - 1 

04831                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

04832                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = - 1 

04833                 Else 

04834                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

04835                 End If 

04836             Next i 

04837      

04838             'si no existe relación marcar como -1  

04839             ' Dim prueba2(0, 0) As Single  

04840             ' ReDim prueba2(4, 4)  

04841             ' prueba2(0, 0) = -1  

04842             ' prueba2(0, 1) = 10  

04843             ' prueba2(0, 2) = -1  

04844             ' prueba2(0, 3) = 5  

04845             ' prueba2(0, 4) = -1  

04846             '  

04847             ' prueba2(1, 0) = -1  

04848             ' prueba2(1, 1) = -1  

04849             ' prueba2(1, 2) = 1  

04850             ' prueba2(1, 3) = 2  

04851             ' prueba2(1, 4) = -1  

04852             '  

04853             ' prueba2(2, 0) = -1  

04854             ' prueba2(2, 1) = -1  

04855             ' prueba2(2, 2) = -1  

04856             ' prueba2(2, 3) = -1  

04857             ' prueba2(2, 4) = 4  

04858             '  

04859             ' prueba2(3, 0) = -1  

04860             ' prueba2(3, 1) = 3  

04861             ' prueba2(3, 2) = 9  

04862             ' prueba2(3, 3) = -1  

04863             ' prueba2(3, 4) = 2  

04864      

04865             'prueba2(4, 0) = 7  

04866             'prueba2(4, 1) = -1  

04867             'prueba2(4, 2) = 6  

04868             'prueba2(4, 3) = -1  

04869             'prueba2(4, 4) = -1  

04870      

04871             'Establece propiedades de la DLL  

04872             'con los datos del problema  

04873             'Dijkstra1.MatrizNodos = prueba  

04874             'Dijkstra1.MatrizArcos = prueba2  

04875      

04876             Dijkstra1 . MatrizNodos = MatrizNodos 

04877             Dijkstra1 . MatrizArcos = MatrizArcos 

04878      

04879             'Comienza el uso de la DLL  

04880             'indicándole el nodo seleccionado como parámetro nodo inicial  

04881             'y no a árbol máximo  

04882             Dijkstra1 . Inicio ( Nd1S , , ) 

04883         End Sub 

04884         Private Sub Dijkstra1_Fin ( ByVal TextoRespuesta As String , ByVal  

       »           MatrizArcosMinimos As System . Array ) Handles Dijkstra1 . Fin 

04885             'El proceso ha finalizado al parecer correctamente  

04886             'lee los parámetros de vuelta con la solución los muestra  

04887      

04888             txtResultadosAlgoritmo = "" 

04889             txtResultadosAlgoritmo = TextoRespuesta 

04890             AlgoritmoMILP = False 

04891      

04892             CopiaGrafoPrevio () 

04893      

04894             'Dibuja la solución y construye texto  

04895             '------------------------------------  

04896             Dim i , j As Integer 

04897             Dim arc As Integer 

04898      

04899             For arc = 0 To TotalArcos - 1 

04900                 Arcos ( arc ) . Col = Color . Black 

04901                 Arcos ( arc ) . Grosor = Grafico . TrazoArco 

04902             Next arc 

04903             'para mostrar el detalle de los arcos  

04904             Grafico . BArco = False 

04905      

04906             For i = 0 To UBound ( MatrizArcosMinimos , 1 ) 

04907                 For j = 0 To UBound ( MatrizArcosMinimos , 2 ) 

04908                     If MatrizArcosMinimos ( i , j ) = 1 Then 

04909                         For arc = 0 To TotalArcos - 1 

04910                             If Arcos ( arc ) . Nd1 = i And Arcos ( arc ) . Nd2 = j Then 

04911                                 Arcos ( arc ) . Col = Color . Green 

04912                                 Arcos ( arc ) . Grosor = Grafico . TrazoArco + 1 

04913                                 Exit For 

04914                             End If 

04915                         Next arc 

04916                     End If 

04917                 Next j 

04918             Next i 

04919      

04920             DibujaGrafo () 

04921             '------------------------------------  

04922             CopiaGrafoSolucion () 

04923             MuestraCajaSolucion () 

04924         End Sub 

04925         Private Sub mnuAnalisis_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuAnalisis . Click 

04926      

04927         End Sub 

04928         Private Sub mnuAnalisisDijkstraMax_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuAnalisisDijkstraMax . Click 

04929             If Nd1S = - 1 Then 

04930                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Árbol máximo) debe  

       »                   seleccionar" & vbCrLf & "un nodo con el botón izquierdo del  

       »                   ratón." , MsgBoxStyle . Information , "Algoritmo de Dijkstra" ) 

04931                 Exit Sub 

04932             End If 

04933      

04934             If Grafico . costArco = False Then 

04935                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Árbol máximo) debe  

       »                   activar la opción Coste" & vbCrLf & "de los arcos del grafo en el 

       »                   menú Formato/Opciones/Arcos." , MsgBoxStyle . Information ,  

       »                   "Algoritmo de Dijkstra" ) 

04936                 Exit Sub 

04937             End If 

04938      

04939             '----------------------------------------------------  

04940             'A la dll se le debe pasar un array de strings  

04941             'de dimensión totalnodos-1 ya que empieza en 0  

04942             'con el nombre o etiqueta de los nodos  

04943             '----------------------------------------------------  

04944      

04945             Dim i , j As Long 

04946             Dim MatrizNodos ( TotalNodos - 1 ) As String 

04947             For i = 0 To TotalNodos - 1 

04948                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

04949             Next i 

04950      

04951             '----------------------------------------------------  

04952             'a la dll se le debe pasar las relaciones de arco en  

04953             'matriz(i,j) donde i=nodo origen, j=nodo destino  

04954             'de dimensiones de 0 a totalnodos-1 para i y para j  

04955             'contendrá un single >=0  

04956             'recuerda que después del proceso RellenaMatrices  

04957             'se dispone de un array de relación de arco que es  

04958             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

04959             '----------------------------------------------------  

04960      

04961             'si no existe relación marcar como -1  

04962      

04963             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

04964             'pone toda la matriz a -1  

04965             For i = 0 To TotalNodos - 1 

04966                 For j = 0 To TotalNodos - 1 

04967                     MatrizArcos ( i , j ) = - 1 

04968                 Next j 

04969             Next i 

04970             'marca los arcos existentes, pero no los de un mismo nodo  

04971             For i = 0 To TotalArcos - 1 

04972                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

04973                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = - 1 

04974                 Else 

04975                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

04976                 End If 

04977             Next i 

04978      

04979             'Establece propiedades de la DLL  

04980             'con los datos del problema  

04981             Dijkstra1 . MatrizNodos = MatrizNodos 

04982             Dijkstra1 . MatrizArcos = MatrizArcos 

04983      

04984             'Comienza el uso de la DLL  

04985             'indicándole el nodo seleccionado como parámetro nodo inicial  

04986             'y sí a árbol máximo  

04987             Dijkstra1 . Inicio ( Nd1S , , True ) 

04988         End Sub 

04989         Private Sub mnuAnalisisDijkstraCC_Click ( ByVal sender As System . Object , ByVal 

       »           e As System . EventArgs ) Handles mnuAnalisisDijkstraCC . Click 

04990             If Nd1S = - 1 Then 

04991                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Camino crítico -  

       »                   máximo) debe seleccionar" & vbCrLf & "un nodo inicio con el botón 

       »                   izquierdo del ratón." , MsgBoxStyle . Information , "Algoritmo de  

       »                   Dijkstra" ) 

04992                 Exit Sub 

04993             End If 

04994             If Nd2S = - 1 Then 

04995                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Camino crítico -  

       »                   máximo) debe seleccionar" & vbCrLf & "un nodo fin con el botón  

       »                   derecho del ratón." , MsgBoxStyle . Information , "Algoritmo de  

       »                   Dijkstra" ) 

04996                 Exit Sub 

04997             End If 

04998             If Grafico . costArco = False Then 

04999                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Camino crítico -  

       »                   máximo) debe activar la opción Coste" & vbCrLf & "de los arcos  

       »                   del grafo en el menú Formato/Opciones/Arcos." , MsgBoxStyle .  

       »                   Information , "Algoritmo de Dijkstra" ) 

05000                 Exit Sub 

05001             End If 

05002      

05003             '----------------------------------------------------  

05004             'A la dll se le debe pasar un array de strings  

05005             'de dimensión totalnodos-1 ya que empieza en 0  

05006             'con el nombre o etiqueta de los nodos  

05007             '----------------------------------------------------  

05008      

05009             Dim i , j As Long 

05010             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05011             For i = 0 To TotalNodos - 1 

05012                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05013             Next i 

05014      

05015             '----------------------------------------------------  

05016             'a la dll se le debe pasar las relaciones de arco en  

05017             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05018             'de dimensiones de 0 a totalnodos-1 para i y para j  

05019             'contendrá un single >=0  

05020             'recuerda que después del proceso RellenaMatrices  

05021             'se dispone de un array de relación de arco que es  

05022             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05023             '----------------------------------------------------  

05024      

05025             'si no existe relación marcar como -1  

05026      

05027             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05028             'pone toda la matriz a -1  

05029             For i = 0 To TotalNodos - 1 

05030                 For j = 0 To TotalNodos - 1 

05031                     MatrizArcos ( i , j ) = - 1 

05032                 Next j 

05033             Next i 

05034             'marca los arcos existentes, pero no los de un mismo nodo  

05035             For i = 0 To TotalArcos - 1 

05036                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05037                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = - 1 

05038                 Else 

05039                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05040                 End If 

05041             Next i 

05042      

05043             'Establece propiedades de la DLL  

05044             'con los datos del problema  

05045             Dijkstra1 . MatrizNodos = MatrizNodos 

05046             Dijkstra1 . MatrizArcos = MatrizArcos 

05047      

05048             'Comienza el uso de la DLL  

05049             'indicándole el nodo seleccionado como parámetro nodo inicial  

05050             'nodo final y sí a camino crítico  

05051             Dijkstra1 . Inicio ( Nd1S , Nd2S , True ) 

05052      

05053         End Sub 

05054         Private Sub mnuAnalisisDijkstraCM_Click ( ByVal sender As System . Object , ByVal 

       »           e As System . EventArgs ) Handles mnuAnalisisDijkstraCM . Click 

05055             If Nd1S = - 1 Then 

05056                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Camino mínimo) debe  

       »                   seleccionar" & vbCrLf & "un nodo inicio con el botón izquierdo  

       »                   del ratón." , MsgBoxStyle . Information , "Algoritmo de Dijkstra" ) 

05057                 Exit Sub 

05058             End If 

05059             If Nd2S = - 1 Then 

05060                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Camino mínimo) debe  

       »                   seleccionar" & vbCrLf & "un nodo fin con el botón derecho del  

       »                   ratón." , MsgBoxStyle . Information , "Algoritmo de Dijkstra" ) 

05061                 Exit Sub 

05062             End If 

05063             If Grafico . costArco = False Then 

05064                 MsgBox ( "Para ejecutar el Algoritmo de Dijkstra (Camino mínimo) debe  

       »                   activar la opción Coste" & vbCrLf & "de los arcos del grafo en el 

       »                   menú Formato/Opciones/Arcos." , MsgBoxStyle . Information ,  

       »                   "Algoritmo de Dijkstra" ) 

05065                 Exit Sub 

05066             End If 

05067      

05068             '----------------------------------------------------  

05069             'A la dll se le debe pasar un array de strings  

05070             'de dimensión totalnodos-1 ya que empieza en 0  

05071             'con el nombre o etiqueta de los nodos  

05072             '----------------------------------------------------  

05073      

05074             Dim i , j As Long 

05075             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05076             For i = 0 To TotalNodos - 1 

05077                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05078             Next i 

05079      

05080      

05081             '----------------------------------------------------  

05082             'a la dll se le debe pasar las relaciones de arco en  

05083             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05084             'de dimensiones de 0 a totalnodos-1 para i y para j  

05085             'contendrá un single >=0  

05086             'recuerda que después del proceso RellenaMatrices  

05087             'se dispone de un array de relación de arco que es  

05088             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05089             '----------------------------------------------------  

05090      

05091             'si no existe relación marcar como -1  

05092      

05093             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05094             'pone toda la matriz a -1  

05095             For i = 0 To TotalNodos - 1 

05096                 For j = 0 To TotalNodos - 1 

05097                     MatrizArcos ( i , j ) = - 1 

05098                 Next j 

05099             Next i 

05100             'marca los arcos existentes, pero no los de un mismo nodo  

05101             For i = 0 To TotalArcos - 1 

05102                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05103                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = - 1 

05104                 Else 

05105                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05106                 End If 

05107             Next i 

05108      

05109             'Establece propiedades de la DLL  

05110             'con los datos del problema  

05111             Dijkstra1 . MatrizNodos = MatrizNodos 

05112             Dijkstra1 . MatrizArcos = MatrizArcos 

05113      

05114             'Comienza el uso de la DLL  

05115             'indicándole el nodo seleccionado como parámetro  

05116             'nodo inicial,nodo final y no a camino crítico  

05117             Dijkstra1 . Inicio ( Nd1S , Nd2S , False ) 

05118         End Sub 

05119         Private Sub mnuAnalisisBellmanFordCmin_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuAnalisisBellmanFordCmin . Click 

05120      

05121             If Nd1S = - 1 Then 

05122                 MsgBox ( "Para ejecutar el Algoritmo de BellmanFord (camino mínimo)  

       »                   debe seleccionar" & vbCrLf & "un nodo inicial con el botón  

       »                   izquierdo del ratón." , MsgBoxStyle . Information , "Algoritmo de  

       »                   BellmanFord" ) 

05123                 Exit Sub 

05124             End If 

05125      

05126             If Nd2S = - 1 Then 

05127                 MsgBox ( "Para ejecutar el Algoritmo de BellmanFord (camino mínimo)  

       »                   debe seleccionar" & vbCrLf & "un nodo final con el botón derecho  

       »                   del ratón." , MsgBoxStyle . Information , "Algoritmo de BellmanFord" ) 

05128                 Exit Sub 

05129             End If 

05130      

05131             If Grafico . costArco = False Then 

05132                 MsgBox ( "Para ejecutar el Algoritmo de BellmanFord (camino mínimo)  

       »                   debe activar la opción Coste" & vbCrLf & "de los arcos del grafo  

       »                   en el menú Formato/Opciones/Arcos." , MsgBoxStyle . Information ,  

       »                   "Algoritmo de BellmanFord" ) 

05133                 Exit Sub 

05134             End If 

05135      

05136             '----------------------------------------------------  

05137             'A la dll se le debe pasar un array de strings  

05138             'de dimensión totalnodos-1 ya que empieza en 0  

05139             'con el nombre o etiqueta de los nodos  

05140             '----------------------------------------------------  

05141             Dim i , j As Long 

05142             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05143             For i = 0 To TotalNodos - 1 

05144                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05145             Next i 

05146      

05147             '----------------------------------------------------  

05148             'a la dll se le debe pasar las relaciones de arco en  

05149             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05150             'de dimensiones de 0 a totalnodos-1 para i y para j  

05151             'contendrá un single >=0  

05152             'recuerda que después del proceso RellenaMatrices  

05153             'se dispone de un array de relación de arco que es  

05154             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05155             '----------------------------------------------------  

05156             Const cMaximo As Single = 999999999999999999 

05157             Const cMinimo As Single = - 999999999999999999 

05158      

05159             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05160             'pone toda la matriz sin relación de arcos  

05161             For i = 0 To TotalNodos - 1 

05162                 For j = 0 To TotalNodos - 1 

05163                     MatrizArcos ( i , j ) = cMaximo 

05164                 Next j 

05165             Next i 

05166             'marca los arcos existentes, pero no los de un mismo nodo  

05167             For i = 0 To TotalArcos - 1 

05168                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05169                     '  

05170                 Else 

05171                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05172                 End If 

05173             Next i 

05174      

05175             'Establece propiedades de la DLL  

05176             'con los datos del problema  

05177             BellmanFord1 . MatrizNodos = MatrizNodos 

05178             BellmanFord1 . MatrizArcos = MatrizArcos 

05179      

05180             'Comienza el uso de la DLL  

05181             'indicándole el nodo seleccionado como parámetro nodo inicial  

05182             'nodo final y no al cálculo de camino máximo  

05183             BellmanFord1 . Inicio ( Nd1S , Nd2S , ) 

05184      

05185         End Sub 

05186         Private Sub BellmanFord1_Fallo ( ByVal TextoError As String ) Handles  

       »           BellmanFord1 . Fallo 

05187             'Este evento salta en caso de un error en el proceso de BellmanFord  

05188             MsgBox ( TextoError , MsgBoxStyle . Exclamation , "Error en el proceso  

       »               BellmanFord" ) 

05189         End Sub 

05190         Private Sub BellmanFord1_Fin ( ByVal TextoRespuesta As String , ByVal  

       »           MatrizArcosMinimos As System . Array ) Handles BellmanFord1 . Fin 

05191      

05192             'El proceso ha finalizado al parecer correctamente  

05193             'lee los parámetros de vuelta con la solución los muestra  

05194             txtResultadosAlgoritmo = "" 

05195             txtResultadosAlgoritmo = TextoRespuesta 

05196             AlgoritmoMILP = False 

05197      

05198             CopiaGrafoPrevio () 

05199      

05200      

05201             'Dibuja la solución  

05202             '------------------------------------  

05203             Dim i , j As Integer 

05204             Dim arc As Integer 

05205      

05206             For arc = 0 To TotalArcos - 1 

05207                 Arcos ( arc ) . Col = Color . Black 

05208                 Arcos ( arc ) . Grosor = Grafico . TrazoArco 

05209             Next arc 

05210             'para mostrar el detalle de los arcos  

05211             Grafico . BArco = False 

05212      

05213             For i = 0 To UBound ( MatrizArcosMinimos , 1 ) 

05214                 For j = 0 To UBound ( MatrizArcosMinimos , 2 ) 

05215                     If MatrizArcosMinimos ( i , j ) = 1 Then 

05216                         For arc = 0 To TotalArcos - 1 

05217                             If Arcos ( arc ) . Nd1 = i And Arcos ( arc ) . Nd2 = j Then 

05218                                 Arcos ( arc ) . Col = Color . Green 

05219                                 Arcos ( arc ) . Grosor = Grafico . TrazoArco + 1 

05220                                 Exit For 

05221                             End If 

05222                         Next arc 

05223                     End If 

05224                 Next j 

05225             Next i 

05226      

05227             DibujaGrafo () 

05228             '------------------------------------  

05229      

05230             CopiaGrafoSolucion () 

05231             MuestraCajaSolucion () 

05232         End Sub 

05233      



05234         Public Sub CopiaGrafoSolucion () 

05235             'hace copia del estado posterior del grafo  

05236             ReDim NodosSol ( TotalNodos - 1 ) 

05237             ReDim ArcosSol ( TotalArcos - 1 ) 

05238      

05239             Dim i , j As Long 

05240             For i = 0 To TotalNodos - 1 

05241                 NodosSol ( i ) = Nodos ( i ) 

05242             Next i 

05243             For j = 0 To TotalArcos - 1 

05244                 ArcosSol ( j ) = Arcos ( j ) 

05245             Next j 

05246         End Sub 

05247         Public Sub CopiaGrafoPrevio () 

05248             'hace copia del estado posterior del grafo  

05249             ReDim NodosPrev ( TotalNodos - 1 ) 

05250             ReDim ArcosPrev ( TotalArcos - 1 ) 

05251      

05252             Dim i , j As Long 

05253             For i = 0 To TotalNodos - 1 

05254                 NodosPrev ( i ) = Nodos ( i ) 

05255             Next i 

05256             For j = 0 To TotalArcos - 1 

05257                 ArcosPrev ( j ) = Arcos ( j ) 

05258             Next j 

05259         End Sub 

05260      



05261         Private Sub mnuAnalisisBellmanFordCmax_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuAnalisisBellmanFordCmax . Click 

05262      

05263             If Nd1S = - 1 Then 

05264                 MsgBox ( "Para ejecutar el Algoritmo de BellmanFord (camino máximo)  

       »                   debe seleccionar" & vbCrLf & "un nodo inicial con el botón  

       »                   izquierdo del ratón." , MsgBoxStyle . Information , "Algoritmo de  

       »                   BellmanFord" ) 

05265                 Exit Sub 

05266             End If 

05267      

05268             If Nd2S = - 1 Then 

05269                 MsgBox ( "Para ejecutar el Algoritmo de BellmanFord (camino máximo)  

       »                   debe seleccionar" & vbCrLf & "un nodo final con el botón derecho  

       »                   del ratón." , MsgBoxStyle . Information , "Algoritmo de BellmanFord" ) 

05270                 Exit Sub 

05271             End If 

05272      

05273             If Grafico . costArco = False Then 

05274                 MsgBox ( "Para ejecutar el Algoritmo de BellmanFord (camino máximo)  

       »                   debe activar la opción Coste" & vbCrLf & "de los arcos del grafo  

       »                   en el menú Formato/Opciones/Arcos." , MsgBoxStyle . Information ,  

       »                   "Algoritmo de BellmanFord" ) 

05275                 Exit Sub 

05276             End If 

05277      

05278             '----------------------------------------------------  

05279             'A la dll se le debe pasar un array de strings  

05280             'de dimensión totalnodos-1 ya que empieza en 0  

05281             'con el nombre o etiqueta de los nodos  

05282             '----------------------------------------------------  

05283             Dim i , j As Long 

05284             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05285             For i = 0 To TotalNodos - 1 

05286                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05287             Next i 

05288      

05289             '----------------------------------------------------  

05290             'a la dll se le debe pasar las relaciones de arco en  

05291             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05292             'de dimensiones de 0 a totalnodos-1 para i y para j  

05293             'contendrá un single >=0  

05294             'recuerda que después del proceso RellenaMatrices  

05295             'se dispone de un array de relación de arco que es  

05296             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05297             '----------------------------------------------------  

05298             Const cMaximo As Single = 999999999999999999 

05299             Const cMinimo As Single = - 999999999999999999 

05300      

05301             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05302             'pone toda la matriz sin relación de arcos  

05303             For i = 0 To TotalNodos - 1 

05304                 For j = 0 To TotalNodos - 1 

05305                     MatrizArcos ( i , j ) = cMinimo 

05306                 Next j 

05307             Next i 

05308             'marca los arcos existentes, pero no los de un mismo nodo  

05309             For i = 0 To TotalArcos - 1 

05310                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05311                     '  

05312                 Else 

05313                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05314                 End If 

05315             Next i 

05316      

05317             'Establece propiedades de la DLL  

05318             'con los datos del problema  

05319             BellmanFord1 . MatrizNodos = MatrizNodos 

05320             BellmanFord1 . MatrizArcos = MatrizArcos 

05321      

05322             'Comienza el uso de la DLL  

05323             'indicándole el nodo seleccionado como parámetro nodo inicial  

05324             'nodo final y si al cálculo de camino máximo  

05325             BellmanFord1 . Inicio ( Nd1S , Nd2S , True ) 

05326         End Sub 

05327         Private Sub Kruskal1_Fallo ( ByVal TextoError As String ) Handles Kruskal1 .  

       »           Fallo 

05328             'Este evento salta en caso de un error en el proceso de Kruskal  

05329             MsgBox ( TextoError , MsgBoxStyle . Exclamation , "Error en el proceso  

       »               Kruskal" ) 

05330         End Sub 

05331         Private Sub mnuAnalisisKruskalmin_Click ( ByVal sender As System . Object , ByVal 

       »           e As System . EventArgs ) Handles mnuAnalisisKruskalmin . Click 

05332      

05333             If Grafico . costArco = False Then 

05334                 MsgBox ( "Para ejecutar el Algoritmo de Kruskal (árbol de coste total  

       »                   mínimo) debe activar la opción Coste" & vbCrLf & "de los arcos  

       »                   del grafo en el menú Formato/Opciones/Arcos." , MsgBoxStyle .  

       »                   Information , "Algoritmo de Kruskal" ) 

05335                 Exit Sub 

05336             End If 

05337      

05338             '----------------------------------------------------  

05339             'A la dll se le debe pasar un array de strings  

05340             'de dimensión totalnodos-1 ya que empieza en 0  

05341             'con el nombre o etiqueta de los nodos  

05342             '----------------------------------------------------  

05343             Dim i , j As Long 

05344             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05345             For i = 0 To TotalNodos - 1 

05346                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05347             Next i 

05348      

05349             '----------------------------------------------------  

05350             'a la dll se le debe pasar las relaciones de arco en  

05351             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05352             'de dimensiones de 0 a totalnodos-1 para i y para j  

05353             'contendrá un single >=0  

05354             'recuerda que después del proceso RellenaMatrices  

05355             'se dispone de un array de relación de arco que es  

05356             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05357             '----------------------------------------------------  

05358             Const cMaximo As Single = 999999999999999999 

05359             Const cMinimo As Single = - 999999999999999999 

05360      

05361             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05362             'pone toda la matriz sin relación de arcos  

05363             For i = 0 To TotalNodos - 1 

05364                 For j = 0 To TotalNodos - 1 

05365                     MatrizArcos ( i , j ) = cMaximo 

05366                 Next j 

05367             Next i 

05368             'marca los arcos existentes, pero no los de un mismo nodo  

05369             For i = 0 To TotalArcos - 1 

05370                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05371                     '  

05372                 Else 

05373                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05374                 End If 

05375             Next i 

05376      

05377             'Establece propiedades de la DLL  

05378             'con los datos del problema  

05379             Kruskal1 . MatrizNodos = MatrizNodos 

05380             Kruskal1 . MatrizArcos = MatrizArcos 

05381      

05382             'Comienza el uso de la DLL  

05383             'busca el mínimo  

05384             Kruskal1 . Inicio ( False ) 

05385      

05386      

05387         End Sub 

05388         Private Sub Kruskal1_Fin ( ByVal TextoRespuesta As String , ByVal  

       »           MatrizArcosMinimos As System . Array ) Handles Kruskal1 . Fin 

05389             'El proceso ha finalizado al parecer correctamente  

05390             'lee los parámetros de vuelta con la solución los muestra  

05391      

05392             txtResultadosAlgoritmo = "" 

05393             txtResultadosAlgoritmo = TextoRespuesta 

05394             AlgoritmoMILP = False 

05395      

05396             CopiaGrafoPrevio () 

05397      

05398             'Dibuja la solución y construye texto  

05399             '------------------------------------  

05400             Dim i , j , k As Integer 

05401             Dim arc As Integer 

05402      

05403             For arc = 0 To TotalArcos - 1 

05404                 Arcos ( arc ) . Col = Color . Black 

05405                 Arcos ( arc ) . Grosor = Grafico . TrazoArco 

05406             Next arc 

05407             'para mostrar el detalle de los arcos  

05408             Grafico . BArco = True 

05409      

05410             For i = 0 To UBound ( MatrizArcosMinimos , 1 ) 

05411                 For j = 0 To UBound ( MatrizArcosMinimos , 2 ) 

05412                     If MatrizArcosMinimos ( i , j ) = 1 Then 

05413                         For arc = 0 To TotalArcos - 1 

05414                             If Arcos ( arc ) . Nd1 = i And Arcos ( arc ) . Nd2 = j Then 

05415                                 Arcos ( arc ) . Col = Color . Green 

05416                                 Arcos ( arc ) . Grosor = Grafico . TrazoArco + 1 

05417      

05418      

05419                                 k = BuscaArcoSimetrico ( arc ) 

05420                                 If k > 0 Then 

05421                                     Arcos ( k ) . Col = Color . Green 

05422                                     Arcos ( k ) . Grosor = Grafico . TrazoArco + 1 

05423                                 End If 

05424      

05425                                 Exit For 

05426                             End If 

05427                         Next arc 

05428                     End If 

05429                 Next j 

05430             Next i 

05431      

05432             DibujaGrafo () 

05433             '------------------------------------  

05434      

05435             CopiaGrafoSolucion () 

05436             MuestraCajaSolucion () 

05437      

05438         End Sub 

05439         Private Sub mnuAnalisisKruskalmax_Click ( ByVal sender As System . Object , ByVal 

       »           e As System . EventArgs ) Handles mnuAnalisisKruskalmax . Click 

05440      

05441             If Grafico . costArco = False Then 

05442                 MsgBox ( "Para ejecutar el Algoritmo de Kruskal (árbol de coste total  

       »                   máximo) debe activar la opción Coste" & vbCrLf & "de los arcos  

       »                   del grafo en el menú Formato/Opciones/Arcos." , MsgBoxStyle .  

       »                   Information , "Algoritmo de Kruskal" ) 

05443                 Exit Sub 

05444             End If 

05445      

05446             '----------------------------------------------------  

05447             'A la dll se le debe pasar un array de strings  

05448             'de dimensión totalnodos-1 ya que empieza en 0  

05449             'con el nombre o etiqueta de los nodos  

05450             '----------------------------------------------------  

05451             Dim i , j As Long 

05452             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05453             For i = 0 To TotalNodos - 1 

05454                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05455             Next i 

05456      

05457             '----------------------------------------------------  

05458             'a la dll se le debe pasar las relaciones de arco en  

05459             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05460             'de dimensiones de 0 a totalnodos-1 para i y para j  

05461             'contendrá un single >=0  

05462             'recuerda que después del proceso RellenaMatrices  

05463             'se dispone de un array de relación de arco que es  

05464             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05465             '----------------------------------------------------  

05466             Const cMaximo As Single = 999999999999999999 

05467             Const cMinimo As Single = - 999999999999999999 

05468      

05469             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05470             'pone toda la matriz sin relación de arcos  

05471             For i = 0 To TotalNodos - 1 

05472                 For j = 0 To TotalNodos - 1 

05473                     MatrizArcos ( i , j ) = cMaximo 

05474                 Next j 

05475             Next i 

05476             'marca los arcos existentes, pero no los de un mismo nodo  

05477             For i = 0 To TotalArcos - 1 

05478                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05479                     '  

05480                 Else 

05481                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05482                 End If 

05483             Next i 

05484      

05485             'Establece propiedades de la DLL  

05486             'con los datos del problema  

05487             Kruskal1 . MatrizNodos = MatrizNodos 

05488             Kruskal1 . MatrizArcos = MatrizArcos 

05489      

05490             'Comienza el uso de la DLL  

05491             'busca el mínimo  

05492             Kruskal1 . Inicio ( True ) 

05493         End Sub 

05494         Private Sub mnuFormatoFlujo_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuFormatoFlujo . Click 

05495             'ordena el grafo en formato flujo  

05496      

05497             mnuFormatoAleatorio . Checked = False 

05498             mnuFormatoTablero . Checked = False 

05499             mnuFormatoCircular . Checked = False 

05500             mnuFormatoFlujo . Checked = True 

05501             mnuFormatoOrganico . Checked = False 

05502      

05503             If TotalNodos = 0 Then Exit Sub 

05504      

05505             'pide antes confirmación  

05506             Dim respuesta As MsgBoxResult 

05507             respuesta = MsgBox ( "Esta opción cambiará la ubicación de los nodos en  

       »               forma de flujo." & vbCrLf & "¿Desea realmente reordenar los nodos?" ,  

       »               MsgBoxStyle . OKCancel , ) 

05508             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

05509      

05510             Me . Cursor = Cursors . WaitCursor 

05511             OrdenaenFlujo () 

05512             If Grafico . Iman Then Imantar () 

05513             DibujaGrafo () 

05514             Me . Cursor = Cursors . Default 

05515         End Sub 

05516         Sub OrdenaenFlujo () 

05517             'Esta rutina intenta ordenar la posición de los nodos de modo que el  

05518             'nodo con más arcos salientes quede a la izqda de la pantalla, mientras  

05519             'que el nodo con más arcos entrantes, quede a la derecha.  

05520      

05521             'si no hay suficientes nodos va a otra ordenación  

05522      

05523             If TotalNodos < 3 Or TotalArcos < 1 Then 

05524                 OrdenaenEstrella () 

05525                 Exit Sub 

05526             End If 

05527      

05528             Dim VArcos ( TotalNodos - 1 ) As Integer 

05529             Dim i , j As Integer 

05530             Dim n1 , n2 As Integer 

05531      

05532             Dim MArcos ( TotalArcos - 1 ) As Boolean 

05533             Dim MNodos ( TotalNodos - 1 ) As Boolean 

05534             Dim explorados , capas As Long 

05535             Dim CNodos ( TotalNodos - 1 ) As Integer 

05536             Dim TotalCapa ( TotalArcos + 1 ) As Long 

05537      

05538             'valora todos los nodos según arcos entrantes y salientes  

05539             For i = 0 To TotalArcos - 1 

05540                 n1 = Arcos ( i ) . Nd1 

05541                 n2 = Arcos ( i ) . Nd2 

05542                 'el positivo es el saliente  

05543                 VArcos ( n1 ) = VArcos ( n1 ) + 100 

05544                 'el negativo es el entrante  

05545                 VArcos ( n2 ) = VArcos ( n2 ) - 50 

05546      

05547             Next i 

05548      

05549             Dim Col As Integer 

05550      

05551      

05552             'Ordena los nodos y busca el de más arcos salientes (max)  

05553             Dim Nmax As Integer 

05554             Dim VAmax As Long 

05555      

05556             VAmax = - 999999999999999999 

05557             Nmax = - 1 

05558      

05559             'cuenta nodos con arcos susceptibles de ser ordenados en capas  

05560             Dim TotNodosconArco As Long = 0 

05561      

05562             For j = 0 To TotalArcos - 1 

05563                 n1 = Arcos ( j ) . Nd1 

05564                 n2 = Arcos ( j ) . Nd2 

05565      

05566                 If MNodos ( n1 ) = False Then 

05567                     MNodos ( n1 ) = True 

05568                     TotNodosconArco = TotNodosconArco + 1 

05569                 End If 

05570                 If MNodos ( n2 ) = False Then 

05571                     MNodos ( n2 ) = True 

05572                     TotNodosconArco = TotNodosconArco + 1 

05573                 End If 

05574             Next j 

05575      

05576             For i = 0 To TotalNodos - 1 

05577                 If VArcos ( i ) > VAmax Then 

05578                     Nmax = i 

05579                     VAmax = VArcos ( i ) 

05580                 End If 

05581                 MNodos ( i ) = False 

05582             Next i 

05583      

05584             explorados = 1 

05585             capas = 1 

05586             TotalCapa ( capas ) = 1 

05587             CNodos ( Nmax ) = capas 

05588             MNodos ( Nmax ) = True 

05589             Dim alguno As Long 

05590      

05591             Do While ( explorados < TotNodosconArco ) 

05592                 alguno = 0 

05593                 For i = 0 To TotalArcos - 1 

05594                     n1 = Arcos ( i ) . Nd1 

05595                     n2 = Arcos ( i ) . Nd2 

05596                     If MArcos ( i ) = False Then 

05597                         If CNodos ( n1 ) = capas Then 

05598      

05599                             If CNodos ( n2 ) = 0 Then 

05600                                 CNodos ( n2 ) = capas + 1 

05601                                 MNodos ( n2 ) = True 

05602      

05603                                 TotalCapa ( capas + 1 ) = TotalCapa ( capas + 1 ) + 1 

05604                                 explorados = explorados + 1 

05605                                 MArcos ( i ) = True 

05606                                 alguno = 1 

05607                             End If 

05608                         End If 

05609                     End If 

05610                 Next i 

05611                 If alguno = 0 Then Exit Do 

05612                 capas = capas + 1 

05613             Loop 

05614      

05615             'ahora opera con los nodos que no tienen arco  

05616             'los que no tienen arcos al final  

05617             For i = 0 To TotalNodos - 1 

05618                 If MNodos ( i ) = False Then 

05619                     CNodos ( i ) = capas 

05620                     MNodos ( i ) = True 

05621                     TotalCapa ( capas ) = TotalCapa ( capas ) + 1 

05622                 End If 

05623             Next i 

05624      

05625             'Recorre la estructura de capas y determina sus coordenadas  

05626             Dim c As Long 

05627             Dim NodosEnCapa As Long 

05628             Dim cx , cy As Single 

05629      

05630             cx = Grafico . TapizX / capas 

05631      

05632             For c = 1 To capas 

05633                 NodosEnCapa = 0 

05634      

05635                 If TotalCapa ( c ) > 0 Then 

05636                     cy = Grafico . TapizY / ( TotalCapa ( c )) 

05637      

05638                     For i = 0 To TotalNodos - 1 

05639                         If CNodos ( i ) = c Then 

05640                             Nodos ( i ) . X = cx / 2 + cx * ( c - 1 ) 

05641                             Nodos ( i ) . Y = cy / 2 + cy * ( NodosEnCapa ) 

05642                             NodosEnCapa = NodosEnCapa + 1 

05643                         End If 

05644                     Next i 

05645                 End If 

05646             Next c 

05647         End Sub 

05648         Private Sub mnuAnalisisPrimMin_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuAnalisisPrimMin . Click 

05649             If Grafico . costArco = False Then 

05650                 MsgBox ( "Para ejecutar el Algoritmo de Prim (árbol de coste total  

       »                   mínimo) debe activar la opción Coste" & vbCrLf & "de los arcos  

       »                   del grafo en el menú Formato/Opciones/Arcos." , MsgBoxStyle .  

       »                   Information , "Algoritmo de Prim" ) 

05651                 Exit Sub 

05652             End If 

05653      

05654             '----------------------------------------------------  

05655             'A la dll se le debe pasar un array de strings  

05656             'de dimensión totalnodos-1 ya que empieza en 0  

05657             'con el nombre o etiqueta de los nodos  

05658             '----------------------------------------------------  

05659             Dim i , j As Long 

05660             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05661             For i = 0 To TotalNodos - 1 

05662                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05663             Next i 

05664      

05665             '----------------------------------------------------  

05666             'a la dll se le debe pasar las relaciones de arco en  

05667             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05668             'de dimensiones de 0 a totalnodos-1 para i y para j  

05669             'contendrá un single >=0  

05670             'recuerda que después del proceso RellenaMatrices  

05671             'se dispone de un array de relación de arco que es  

05672             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05673             '----------------------------------------------------  

05674             Const cMaximo As Single = 999999999999999999 

05675             Const cMinimo As Single = - 999999999999999999 

05676      

05677             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05678             'pone toda la matriz sin relación de arcos  

05679             For i = 0 To TotalNodos - 1 

05680                 For j = 0 To TotalNodos - 1 

05681                     MatrizArcos ( i , j ) = cMaximo 

05682                 Next j 

05683             Next i 

05684             'marca los arcos existentes, pero no los de un mismo nodo  

05685             For i = 0 To TotalArcos - 1 

05686                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05687                     '  

05688                 Else 

05689                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05690                 End If 

05691             Next i 

05692      

05693             'Establece propiedades de la DLL  

05694             'con los datos del problema  

05695             Prim1 . MatrizNodos = MatrizNodos 

05696             Prim1 . MatrizArcos = MatrizArcos 

05697      

05698             'Comienza el uso de la DLL  

05699             'busca el mínimo  

05700             Prim1 . Inicio ( False ) 

05701         End Sub 

05702         Private Sub Prim1_Fallo ( ByVal TextoError As String ) Handles Prim1 . Fallo 

05703             'Este evento salta en caso de un error en el proceso de Prim  

05704             MsgBox ( TextoError , MsgBoxStyle . Exclamation , "Error en el proceso Prim" ) 

05705         End Sub 

05706         Private Sub Prim1_Fin ( ByVal TextoRespuesta As String , ByVal  

       »           MatrizArcosMinimos As System . Array ) Handles Prim1 . Fin 

05707             'El proceso ha finalizado al parecer correctamente  

05708             'lee los parámetros de vuelta con la solución los muestra  

05709      

05710             txtResultadosAlgoritmo = "" 

05711             txtResultadosAlgoritmo = TextoRespuesta 

05712             AlgoritmoMILP = False 

05713      

05714             CopiaGrafoPrevio () 

05715      

05716      

05717             'Dibuja la solución y construye texto  

05718             '------------------------------------  

05719             Dim i , j , k As Integer 

05720             Dim arc As Integer 

05721      

05722             For arc = 0 To TotalArcos - 1 

05723                 Arcos ( arc ) . Col = Color . Black 

05724                 Arcos ( arc ) . Grosor = Grafico . TrazoArco 

05725             Next arc 

05726             'para mostrar el detalle de los arcos  

05727             Grafico . BArco = True 

05728      

05729             For i = 0 To UBound ( MatrizArcosMinimos , 1 ) 

05730                 For j = 0 To UBound ( MatrizArcosMinimos , 2 ) 

05731                     If MatrizArcosMinimos ( i , j ) = 1 Then 

05732                         For arc = 0 To TotalArcos - 1 

05733                             If Arcos ( arc ) . Nd1 = i And Arcos ( arc ) . Nd2 = j Then 

05734                                 Arcos ( arc ) . Col = Color . Green 

05735                                 Arcos ( arc ) . Grosor = Grafico . TrazoArco + 1 

05736      

05737      

05738                                 k = BuscaArcoSimetrico ( arc ) 

05739                                 If k > 0 Then 

05740                                     Arcos ( k ) . Col = Color . Green 

05741                                     Arcos ( k ) . Grosor = Grafico . TrazoArco + 1 

05742                                 End If 

05743      

05744                                 Exit For 

05745                             End If 

05746                         Next arc 

05747                     End If 

05748                 Next j 

05749             Next i 

05750      

05751             DibujaGrafo () 

05752             '------------------------------------  

05753      

05754             CopiaGrafoSolucion () 

05755             MuestraCajaSolucion () 

05756      

05757         End Sub 

05758         Private Sub mnuAnalisisPrimMax_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuAnalisisPrimMax . Click 

05759             If Grafico . costArco = False Then 

05760                 MsgBox ( "Para ejecutar el Algoritmo de Prim (árbol de coste total  

       »                   máximo) debe activar la opción Coste" & vbCrLf & "de los arcos  

       »                   del grafo en el menú Formato/Opciones/Arcos." , MsgBoxStyle .  

       »                   Information , "Algoritmo de Prim" ) 

05761                 Exit Sub 

05762             End If 

05763      

05764             '----------------------------------------------------  

05765             'A la dll se le debe pasar un array de strings  

05766             'de dimensión totalnodos-1 ya que empieza en 0  

05767             'con el nombre o etiqueta de los nodos  

05768             '----------------------------------------------------  

05769             Dim i , j As Long 

05770             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05771             For i = 0 To TotalNodos - 1 

05772                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05773             Next i 

05774      

05775             '----------------------------------------------------  

05776             'a la dll se le debe pasar las relaciones de arco en  

05777             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05778             'de dimensiones de 0 a totalnodos-1 para i y para j  

05779             'contendrá un single >=0  

05780             'recuerda que después del proceso RellenaMatrices  

05781             'se dispone de un array de relación de arco que es  

05782             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05783             '----------------------------------------------------  

05784             Const cMaximo As Single = 999999999999999999 

05785             Const cMinimo As Single = - 999999999999999999 

05786      

05787             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05788             'pone toda la matriz sin relación de arcos  

05789             For i = 0 To TotalNodos - 1 

05790                 For j = 0 To TotalNodos - 1 

05791                     MatrizArcos ( i , j ) = cMinimo 

05792                 Next j 

05793             Next i 

05794             'marca los arcos existentes, pero no los de un mismo nodo  

05795             For i = 0 To TotalArcos - 1 

05796                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05797                     '  

05798                 Else 

05799                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

05800                 End If 

05801             Next i 

05802      

05803             'Establece propiedades de la DLL  

05804             'con los datos del problema  

05805             Prim1 . MatrizNodos = MatrizNodos 

05806             Prim1 . MatrizArcos = MatrizArcos 

05807      

05808             'Comienza el uso de la DLL  

05809             'busca el máximo  

05810             Prim1 . Inicio ( True ) 

05811         End Sub 

05812         Private Sub mnuFormatoCentrar_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoCentrar . Click 

05813             Me . Cursor = Cursors . WaitCursor 

05814             FormatoAjustar ( True , True ) 

05815             Me . Cursor = Cursors . Default 

05816         End Sub 

05817         Private Sub mnuFormatoAjustar_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoAjustar . Click 

05818             Me . Cursor = Cursors . WaitCursor 

05819             FormatoAjustar ( False , True ) 

05820             Me . Cursor = Cursors . Default 

05821         End Sub 

05822         Sub FormatoAjustar ( ByVal Centrado As Boolean , ByVal Redibuja As Boolean ) 

05823             If TotalNodos < 2 Then Exit Sub 

05824      

05825             Dim i As Integer 

05826      

05827             Dim Xmin , Ymin , Xmax , Ymax As Single 

05828             Const cMaximo As Single = 999999999999999999 

05829             Const cMinimo As Single = - 999999999999999999 

05830      

05831             'busca contorno  

05832      

05833             Xmin = cMaximo 

05834             Ymin = cMaximo 

05835             Xmax = cMinimo 

05836             Ymax = cMinimo 

05837      

05838             For i = 0 To TotalNodos - 1 

05839                 If Nodos ( i ) . X - Nodos ( i ) . Radio < Xmin Then 

05840                     Xmin = Nodos ( i ) . X - Nodos ( i ) . Radio 

05841                 End If 

05842                 If Nodos ( i ) . Y - Nodos ( i ) . Radio < Ymin Then 

05843                     Ymin = Nodos ( i ) . Y - Nodos ( i ) . Radio 

05844                 End If 

05845                 If Nodos ( i ) . X + Nodos ( i ) . Radio > Xmax Then 

05846                     Xmax = Nodos ( i ) . X + Nodos ( i ) . Radio 

05847                 End If 

05848                 If Nodos ( i ) . Y + Nodos ( i ) . Radio > Ymax Then 

05849                     Ymax = Nodos ( i ) . Y + Nodos ( i ) . Radio 

05850                 End If 

05851             Next i 

05852      

05853      

05854             Dim MargenX , MargenY As Single 

05855      

05856             Dim Ax , Ay , Ax2 , Ay2 As Single 

05857             MargenX = 50 

05858             MargenY = 50 

05859             'Recorta contorno  

05860             Ax = Xmin - MargenX 

05861             Ay = Ymin - MargenY 

05862      

05863      

05864      

05865             If Centrado Then 

05866                 Ax2 = ( Grafico . TapizX - ( Xmax - Xmin + 2 * MargenX )) / 2 

05867                 Ay2 = ( Grafico . TapizY - ( Ymax - Ymin + 2 * MargenY )) / 2 

05868      

05869                 Ax = Ax - Ax2 

05870                 Ay = Ay - Ay2 

05871             End If 

05872      

05873             'Desplaza nodos  

05874             For i = 0 To TotalNodos - 1 

05875                 Nodos ( i ) . X = Nodos ( i ) . X - Ax 

05876                 Nodos ( i ) . Y = Nodos ( i ) . Y - Ay 

05877             Next i 

05878      

05879             'Recorta tapiz  

05880             If Centrado = False Then 

05881                 If ( Xmax - Xmin ) + 2 * MargenX >= 100 Then 

05882                     Grafico . TapizX = ( Xmax - Xmin ) + 2 * MargenX 

05883                 Else 

05884                     Grafico . TapizX = 100 

05885                 End If 

05886      

05887                 If ( Ymax - Ymin ) + 2 * MargenY >= 100 Then 

05888                     Grafico . TapizY = ( Ymax - Ymin ) + 2 * MargenY 

05889                 Else 

05890                     Grafico . TapizY = 100 

05891                 End If 

05892             End If 

05893             If Redibuja Then DibujaGrafo () 

05894      

05895      

05896      

05897         End Sub 

05898         Private Sub mnuAnalisisFordFulkersonMax_Click ( ByVal sender As System . Object , 

       »           ByVal e As System . EventArgs ) Handles mnuAnalisisFordFulkersonMax . Click 

05899      

05900             If Nd1S = - 1 Then 

05901                 MsgBox ( "Para ejecutar el Algoritmo de FordFulkerson (flujo máximo)  

       »                   debe seleccionar" & vbCrLf & "un nodo inicial con el botón  

       »                   izquierdo del ratón." , MsgBoxStyle . Information , "Algoritmo de  

       »                   FordFulkerson" ) 

05902                 Exit Sub 

05903             End If 

05904      

05905             If Nd2S = - 1 Then 

05906                 MsgBox ( "Para ejecutar el Algoritmo de FordFulkerson (flujo máximo)  

       »                   debe seleccionar" & vbCrLf & "un nodo final con el botón derecho  

       »                   del ratón." , MsgBoxStyle . Information , "Algoritmo de  

       »                   FordFulkerson" ) 

05907                 Exit Sub 

05908             End If 

05909      

05910             If Grafico . maxArco = False Then 

05911                 MsgBox ( "Para ejecutar el Algoritmo de FordFulkerson (flujo máximo)  

       »                   debe activar la opción Máximo" & vbCrLf & "de los arcos del grafo 

       »                   en el menú Formato/Opciones/Arcos." , MsgBoxStyle . Information ,  

       »                   "Algoritmo de FordFulkerson" ) 

05912                 Exit Sub 

05913             End If 

05914      

05915             '----------------------------------------------------  

05916             'A la dll se le debe pasar un array de strings  

05917             'de dimensión totalnodos-1 ya que empieza en 0  

05918             'con el nombre o etiqueta de los nodos  

05919             '----------------------------------------------------  

05920             Dim i , j As Long 

05921             Dim MatrizNodos ( TotalNodos - 1 ) As String 

05922             For i = 0 To TotalNodos - 1 

05923                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

05924             Next i 

05925      

05926             '----------------------------------------------------  

05927             'a la dll se le debe pasar las relaciones de arco en  

05928             'matriz(i,j) donde i=nodo origen, j=nodo destino  

05929             'de dimensiones de 0 a totalnodos-1 para i y para j  

05930             'contendrá un single >=0  

05931             'recuerda que después del proceso RellenaMatrices  

05932             'se dispone de un array de relación de arco que es  

05933             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

05934             '----------------------------------------------------  

05935             Const cMaximo As Single = 999999999999999999 

05936             Const cMinimo As Single = - 999999999999999999 

05937      

05938             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

05939             'pone toda la matriz sin relación de arcos  

05940             For i = 0 To TotalNodos - 1 

05941                 For j = 0 To TotalNodos - 1 

05942                     MatrizArcos ( i , j ) = cMinimo 

05943                 Next j 

05944             Next i 

05945             'marca los arcos existentes, pero no los de un mismo nodo  

05946             For i = 0 To TotalArcos - 1 

05947                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

05948                     '  

05949                 Else 'le pasa el valor de flujo máximo o capacidad del arco  

05950                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Max 

05951                 End If 

05952             Next i 

05953      

05954             'Establece propiedades de la DLL  

05955             'con los datos del problema  

05956             FordFulkerson1 . MatrizNodos = MatrizNodos 

05957             FordFulkerson1 . MatrizArcos = MatrizArcos 

05958      

05959             'Comienza el uso de la DLL  

05960             'indicándole el nodo seleccionado como parámetro nodo inicial  

05961             'nodo final y si al cálculo de flujo máximo  

05962             FordFulkerson1 . Inicio ( Nd1S , Nd2S , True ) 

05963         End Sub 

05964         Private Sub FordFulkerson1_Fallo ( ByVal TextoError As String ) Handles  

       »           FordFulkerson1 . Fallo 

05965             'Este evento salta en caso de un error en el proceso de FordFulkerson  

05966             MsgBox ( TextoError , MsgBoxStyle . Exclamation , "Error en el proceso  

       »               FordFulkerson" ) 

05967         End Sub 

05968         Private Sub FordFulkerson1_Fin ( ByVal TextoRespuesta As String , ByVal  

       »           MatrizArcosMinimos As System . Array ) Handles FordFulkerson1 . Fin 

05969             'El proceso ha finalizado al parecer correctamente  

05970             'lee los parámetros de vuelta con la solución los muestra  

05971      

05972             txtResultadosAlgoritmo = "" 

05973             txtResultadosAlgoritmo = TextoRespuesta 

05974             AlgoritmoMILP = False 

05975      

05976             CopiaGrafoPrevio () 

05977      

05978             'Dibuja la solución y construye texto  

05979             '------------------------------------  

05980             Dim i , j As Integer 

05981             Dim arc As Integer 

05982      

05983             For arc = 0 To TotalArcos - 1 

05984                 Arcos ( arc ) . Col = Color . Black 

05985                 Arcos ( arc ) . Grosor = Grafico . TrazoArco 

05986             Next arc 

05987             'para mostrar el detalle de los arcos  

05988             Grafico . BArco = False 

05989             Grafico . minArco = True 

05990             Grafico . costArco = False 

05991      

05992             For i = 0 To UBound ( MatrizArcosMinimos , 1 ) 

05993                 For j = 0 To UBound ( MatrizArcosMinimos , 2 ) 

05994                     'If MatrizArcosMinimos(i, j) = 1 Then  

05995                     For arc = 0 To TotalArcos - 1 

05996                         If Arcos ( arc ) . Nd1 = i And Arcos ( arc ) . Nd2 = j Then 

05997      

05998                             Arcos ( arc ) . Min = MatrizArcosMinimos ( i , j ) 

05999                             'un trazo claro para arcos con flujo y capacidad  

       »                               residual  

06000                             If Arcos ( arc ) . Min > 0 Then 

06001                                 Arcos ( arc ) . Col = Color . LightGreen 

06002                                 Arcos ( arc ) . Grosor = Grafico . TrazoArco + 1 

06003                             End If 

06004                             'un trazo oscuro para arcos con flujo y sin capacidad  

       »                               residual  

06005                             If Arcos ( arc ) . Min = Arcos ( arc ) . Max Then 

06006                                 Arcos ( arc ) . Col = Color . Green 

06007                             End If 

06008      

06009                             Exit For 

06010                         End If 

06011                     Next arc 

06012                     'End If  

06013                 Next j 

06014             Next i 

06015      

06016             DibujaGrafo () 

06017             '------------------------------------  

06018      

06019             CopiaGrafoSolucion () 

06020             MuestraCajaSolucion () 

06021         End Sub 

06022         Private Sub mnuAnalisisFloydWarshallmin_Click ( ByVal sender As System . Object , 

       »           ByVal e As System . EventArgs ) Handles mnuAnalisisFloydWarshallmin . Click 

06023      

06024             If Grafico . costArco = False Then 

06025                 MsgBox ( "Para ejecutar el Algoritmo de FloydWarshall (todos los  

       »                   camino mínimos) debe activar la opción Coste" & vbCrLf & "de los  

       »                   arcos del grafo en el menú Formato/Opciones/Arcos." , MsgBoxStyle .  

       »                   Information , "Algoritmo de FloydWarshall" ) 

06026                 Exit Sub 

06027             End If 

06028      

06029             '----------------------------------------------------  

06030             'A la dll se le debe pasar un array de strings  

06031             'de dimensión totalnodos-1 ya que empieza en 0  

06032             'con el nombre o etiqueta de los nodos  

06033             '----------------------------------------------------  

06034             Dim i , j As Long 

06035             Dim MatrizNodos ( TotalNodos - 1 ) As String 

06036             For i = 0 To TotalNodos - 1 

06037                 MatrizNodos ( i ) = Nodos ( i ) . Texto 

06038             Next i 

06039      

06040             '----------------------------------------------------  

06041             'a la dll se le debe pasar las relaciones de arco en  

06042             'matriz(i,j) donde i=nodo origen, j=nodo destino  

06043             'de dimensiones de 0 a totalnodos-1 para i y para j  

06044             'contendrá un single >=0  

06045             'recuerda que después del proceso RellenaMatrices  

06046             'se dispone de un array de relación de arco que es  

06047             'Matriz(x,y) donde x=columna=j,y=fila=i (traspuesta)  

06048             '----------------------------------------------------  

06049             Const cMaximo As Single = 999999999999999999 

06050             Const cMinimo As Single = - 999999999999999999 

06051      

06052             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Single 

06053             'pone toda la matriz sin relación de arcos  

06054             For i = 0 To TotalNodos - 1 

06055                 For j = 0 To TotalNodos - 1 

06056                     MatrizArcos ( i , j ) = cMaximo 

06057                 Next j 

06058             Next i 

06059             'marca los arcos existentes, pero no los de un mismo nodo  

06060             For i = 0 To TotalArcos - 1 

06061                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

06062                     '  

06063                 Else 

06064                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = Arcos ( i ) . Coste 

06065                 End If 

06066             Next i 

06067      

06068             'Establece propiedades de la DLL  

06069             'con los datos del problema  

06070             FloydWarshall1 . MatrizNodos = MatrizNodos 

06071             FloydWarshall1 . MatrizArcos = MatrizArcos 

06072      

06073             'Comienza el uso de la DLL  

06074             'indicándole como parámetro  

06075             'camino máximo = false --> camino mínimo  

06076             FloydWarshall1 . Inicio ( False ) 

06077         End Sub 

06078         Private Sub FloydWarshall1_Fallo ( ByVal TextoError As String ) Handles  

       »           FloydWarshall1 . Fallo 

06079             'Este evento salta en caso de un error en el proceso de FloydWarshall  

06080             MsgBox ( TextoError , MsgBoxStyle . Exclamation , "Error en el proceso  

       »               FloydWarshall" ) 

06081         End Sub 

06082         Private Sub FloydWarshall1_Fin ( ByVal TextoRespuesta As String , ByVal  

       »           MatrizArcosMinimos As System . Array ) Handles FloydWarshall1 . Fin 

06083             'El proceso ha finalizado al parecer correctamente  

06084             'lee los parámetros de vuelta con la solución los muestra  

06085      

06086             txtResultadosAlgoritmo = "" 

06087             txtResultadosAlgoritmo = TextoRespuesta 

06088             AlgoritmoMILP = False 

06089      

06090             CopiaGrafoPrevio () 

06091      

06092      

06093             'Dibuja la solución y construye texto  

06094             '------------------------------------  

06095             Dim i , j As Integer 

06096             Dim arc As Integer 

06097      

06098             For arc = 0 To TotalArcos - 1 

06099                 Arcos ( arc ) . Col = Color . Black 

06100                 Arcos ( arc ) . Grosor = Grafico . TrazoArco 

06101             Next arc 

06102             'para mostrar el detalle de los arcos  

06103             Grafico . BArco = False 

06104             Grafico . costArco = True 

06105      

06106             For i = 0 To UBound ( MatrizArcosMinimos , 1 ) 

06107                 For j = 0 To UBound ( MatrizArcosMinimos , 2 ) 

06108                     If MatrizArcosMinimos ( i , j ) = 1 Then 

06109                         For arc = 0 To TotalArcos - 1 

06110                             If Arcos ( arc ) . Nd1 = i And Arcos ( arc ) . Nd2 = j Then 

06111      

06112                                 Arcos ( arc ) . Grosor = Grafico . TrazoArco + 1 

06113                                 Arcos ( arc ) . Col = Color . Green 

06114      

06115                                 Exit For 

06116                             End If 

06117                         Next arc 

06118                     End If 

06119                 Next j 

06120             Next i 

06121      

06122             DibujaGrafo () 

06123             '------------------------------------  

06124      

06125             CopiaGrafoSolucion () 

06126             MuestraCajaSolucion () 

06127         End Sub 

06128         Private Sub mnuAnalisis_Transbordo_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuAnalisis_Transbordo . Click 

06129             'Lanza rutina para el Problema de Transbordo  

06130             Transbordo () 

06131         End Sub 

06132         Sub Transbordo () 

06133      

06134             'PROBLEMA DEL TRANSBORDO CAPACITADO  

06135             'Modelado LP del Problema del Transbordo Capacitado  

06136      

06137             'El modelo en formato .lp se resolverá mediante la libreria  

06138             'lp_solve 5.0.0.0 bajo licencia LGPL  

06139      

06140      

06141             Dim i , j , k As Integer 

06142      

06143             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Long 

06144             Dim SumSal ( TotalNodos - 1 ) As Long 

06145             Dim SumEnt ( TotalNodos - 1 ) As Long 

06146             Dim ContadorArcosReales As Long 

06147             ContadorArcosReales = 0 

06148      

06149             'pone toda la matriz sin relación de arcos  

06150             For i = 0 To TotalNodos - 1 

06151                 SumSal ( i ) = 0 

06152                 SumEnt ( i ) = 0 

06153                 For j = 0 To TotalNodos - 1 

06154                     MatrizArcos ( i , j ) = - 1 

06155                 Next j 

06156             Next i 

06157             'marca los arcos existentes, pero no los de un mismo nodo  

06158             For i = 0 To TotalArcos - 1 

06159                 'If Arcos(i).Nd1 = Arcos(i).Nd2 Then  

06160                 '  

06161                 'Else 'le pasa el valor del indice del array de arcos  

06162                 MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = i 

06163                 SumSal ( Arcos ( i ) . Nd1 ) += 1 

06164                 SumEnt ( Arcos ( i ) . Nd2 ) += 1 

06165                 'End If  

06166             Next i 

06167      

06168      

06169             '------------------------------------  

06170             'FASE 0: CONDICIONES DE INTEGRIDAD  

06171             '------------------------------------  

06172             'no permitir nodos sueltos sin arcos  

06173             'If ExistenNodosSueltos() Then  

06174             For i = 0 To TotalNodos - 1 

06175                 ContadorArcosReales += SumSal ( i ) 

06176      

06177                 If SumSal ( i ) = 0 And SumEnt ( i ) = 0 Then 

06178                     MsgBox ( "En este grafo existen nodos no conectados." & vbCrLf &  

       »                       "Elimine los nodos sueltos o conéctelos." , MsgBoxStyle .  

       »                       Information , "Problema de Transbordo" ) 

06179                     Me . Cursor = Cursors . Arrow 

06180                     Exit Sub 

06181                 End If 

06182             Next i 

06183      

06184      

06185             '### no permitir arcos que entren y salgan de un mismo nodo???  

06186             'de momento se tienen en cuenta!!  

06187      

06188      

06189             'comprobar las opciones de coste nodo, coste arco, min arco y max arco  

       »               activadas  

06190             If Grafico . costArco = False Then 

06191                 MsgBox ( "Para resolver el problema de Transbordo (coste mínimo)  

       »                   mediante LP" & vbCrLf & "debe activar las opciones de Coste, de  

       »                   los arcos del grafo en " & vbCrLf & "el menú  

       »                   Formato/Opciones/Arcos." , MsgBoxStyle . Information , "Transbordo -  

       »                   LP" ) 

06192                 Exit Sub 

06193             End If 

06194             If Grafico . costNodo = False Then 

06195                 MsgBox ( "Para resolver el problema de Transbordo (coste mínimo)  

       »                   mediante LP" & vbCrLf & "debe activar la opción Valor de los  

       »                   nodos del grafo en el menú " & vbCrLf & "Formato/Opciones/Nodos."  

       »                   , MsgBoxStyle . Information , "Transbordo - LP" ) 

06196                 Exit Sub 

06197             End If 

06198      

06199             '### arcos con costes negativos?  

06200      

06201      

06202             '--------------------------------------  

06203             'FASE 0B: ALTERNATIVAS DE PROBLEMA  

06204             '--------------------------------------  

06205             Me . Cursor = Cursors . WaitCursor 

06206      

06207             'Comprueba si se trata de un problema equilibrado  

06208             'que es aquel cuyo suministro total es igual a la demanda total  

06209             Dim suministro As Single 

06210             Dim demanda As Single 

06211             For i = 0 To TotalNodos - 1 

06212                 If Nodos ( i ) . Valor < 0 Then 

06213                     suministro = suministro - Nodos ( i ) . Valor 

06214                 End If 

06215                 If Nodos ( i ) . Valor > 0 Then 

06216                     demanda = demanda + Nodos ( i ) . Valor 

06217                 End If 

06218             Next i 

06219             'no equilibrado  

06220             If suministro < demanda Then 

06221                 MsgBox ( "Parece que este problema de Transbordo no está equilibrado.  

       »                   Recuerde que:" & vbCrLf & "El suministro total debe ser >=  

       »                   demanda total." & vbCrLf & "El suministro se indica como valor  

       »                   del nodo con signo menos (-)." & vbCrLf & "La demanda se indica  

       »                   como valor del nodo con signo más (+)." & vbCrLf & "El transbordo 

       »                   se indica como valor del nodo con un cero (0)." , MsgBoxStyle .  

       »                   Information , "Transbordo - LP" ) 

06222                 Me . Cursor = Cursors . Arrow 

06223                 Exit Sub 

06224             End If 

06225      

06226             'equilibrado  

06227      

06228             'capacitado  

06229             'no capacitado  

06230             'Opciones de capacidad para determinar las restricciones  

06231             If Grafico . minArco = False Then 

06232                 MsgBox ( "En este problema de Transbordo (coste mínimo) mediante LP" & 

       »                   vbCrLf & "no se considerará la restricción de flujo mínimo en  

       »                   los arcos." , MsgBoxStyle . Information , "Transbordo - LP" ) 

06233             End If 

06234             If Grafico . maxArco = False Then 

06235                 MsgBox ( "En este problema de Transbordo (coste mínimo) mediante LP" & 

       »                   vbCrLf & "no se considerará la restricción de flujo máximo en  

       »                   los arcos." , MsgBoxStyle . Information , "Transbordo - LP" ) 

06236             End If 

06237      

06238             '------------------  

06239             'FASE 1: MODELADO  

06240             '------------------  

06241             'Inicio tiempo  

06242             Dim TInicio As Date = Now 

06243      

06244             Dim TextoModelo As String 

06245      

06246      

06247             'Función Objetivo (a minimizar)  

06248             '--------------------------------------------  

06249             'El sumatorio para todos los arcos de los costes por los flujos  

06250             'minimiza costes totales de Transbordo  

06251             'Variables de decisión (flujos de los arcos)  

06252             Dim operador As String 

06253      

06254             TextoModelo = "min: " 

06255             For k = 0 To TotalArcos - 1 

06256                 If Arcos ( k ) . Coste >= 0 Then 

06257                     'el operador >= 0 indica que se incluye el flujo de  

06258                     'arcos con coste cero como variables de decisión  

06259                     operador = " +" & Arcos ( k ) . Coste . ToString 

06260                 End If 

06261                 If Arcos ( k ) . Coste < 0 Then 

06262                     'no es necesario anteponer el signo menos  

06263                     operador = Arcos ( k ) . Coste . ToString 

06264                     'operador = "- " & Arcos(k).Coste.ToString  

06265                 End If 

06266      

06267                 TextoModelo & = operador & DaNombreArco ( k ) 

06268             Next k 

06269             TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06270             TextoModelo & = vbCrLf 'salto de línea  

06271      

06272             Dim nr As Long 'contador de restricciones  

06273             nr = 0 

06274      

06275      

06276             'Restricciones de Continuidad  

06277             '--------------------------------------------  

06278             'tantas restricciones como nodos  

06279             'el total de flujo de entrada - el total de salida  

06280             'debe ser mayor o igual  

06281             '-capacidad o +demanda  

06282      

06283             'la demanda y capacidad mantienen su signo  

06284             '(convención de signos en ayuda: demanda positiva y capacidad negativa)  

06285      

06286      

06287             For i = 0 To TotalNodos - 1 

06288                 nr = nr + 1 

06289                 TextoModelo & = "r" & nr . ToString & ": " 'indicador de restricción  

06290      

06291                 '###(falta pensar!!!)) con nodos de transbordo sin residuo??????  

06292      

06293                 'Para todos los arcos de ese nodo  

06294                 For j = 0 To TotalNodos - 1 

06295                     'arcos de entrada  

06296                     If MatrizArcos ( j , i ) > - 1 Then 

06297                         TextoModelo & = " +" & DaNombreArco ( MatrizArcos ( j , i )) 

06298                     End If 

06299                     'arcos de salida  

06300                     If MatrizArcos ( i , j ) > - 1 Then 

06301                         TextoModelo & = " -" & DaNombreArco ( MatrizArcos ( i , j )) 

06302                     End If 

06303                 Next j 

06304      

06305      



06306                 'condición  

06307                 TextoModelo & = " >= " & Nodos ( i ) . Valor . ToString 

06308      

06309                 '###Ver capacidad residual y su condición (=?)  

06310                 'If Nodos(i).Valor >= 0 Then  

06311                 ' 'si es una capacidad, se resta la capacidad_sobrante  

06312                 ' TextoModelo &= " +CS_" & Nodos(i).Texto  

06313                 'End If  

06314                 'If Nodos(i).Valor < 0 Then  

06315                 ' 'si es una demanda, se suma la demanda_insatisfecha  

06316                 ' TextoModelo &= " -DI_" & Nodos(i).Texto  

06317                 'End If  

06318      

06319                 TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06320      

06321             Next i 

06322             TextoModelo & = vbCrLf 'salto de línea  

06323      

06324      

06325             'Restricciones de Flujo  

06326             '--------------------------------------------  

06327             'para todos los arcos del modelo  

06328      

06329             For k = 0 To TotalArcos - 1 

06330      

06331                 'comprobar que flujo mínimo es menor que flujo máximo  

06332                 If Arcos ( k ) . Min > Arcos ( k ) . Max Then 

06333                     MsgBox ( "Asegúrese de que para todos los arcos del grafo, las "  

       »                       & vbCrLf & "capacidades mínimas sean <= capacidades máximas."  

       »                       , MsgBoxStyle . Information , "Problema de Transbordo" ) 

06334                     Exit Sub 

06335                 End If 

06336      

06337                 If Arcos ( k ) . Min = Arcos ( k ) . Max Then 

06338                     'Entonces es una restricción de igualdad, obligatoriedad de  

       »                       flujo  

06339                     'nr = nr + 1  

06340                     'TextoModelo &= "r" & nr.ToString & ": " 'indicador de  

       »                       restricción  

06341                     TextoModelo & = DaNombreArco ( k ) & " =" & Arcos ( k ) . Min . ToString 

06342                     TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06343                 Else 

06344      

06345                     If Grafico . minArco = True Then 

06346                         'Flujo >= mínimo  

06347                         'nr = nr + 1  

06348                         'TextoModelo &= "r" & nr.ToString & ": " 'indicador de  

       »                           restricción  

06349                         TextoModelo & = DaNombreArco ( k ) & " >=" & Arcos ( k ) . Min .  

       »                           ToString 

06350                         TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06351                     End If 

06352      

06353                     If Grafico . maxArco = True Then 

06354                         'Flujo <= máximo  

06355                         'nr = nr + 1  

06356                         'TextoModelo &= "r" & nr.ToString & ": " 'indicador de  

       »                           restricción  

06357                         TextoModelo & = DaNombreArco ( k ) & " <=" & Arcos ( k ) . Max .  

       »                           ToString 

06358                         TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06359                     End If 

06360                 End If 

06361             Next k 

06362             TextoModelo & = vbCrLf 'salto de línea  

06363      

06364      

06365             'Restricciones de no negatividad  

06366             '--------------------------------------------  

06367             'tantas restricciones como arcos  

06368             'el flujo de cada arco es mayor o igual a cero  

06369             'ya que sigue el sentido del arco (flecha)  

06370             For k = 0 To TotalArcos - 1 

06371                 'nr = nr + 1  

06372                 'TextoModelo &= "r" & nr.ToString & ": " 'indicador de restricción  

06373                 TextoModelo & = DaNombreArco ( k ) & " >=0;" & vbCrLf 'fin línea y  

       »                   salto  

06374             Next k 

06375      

06376      

06377             'El punto decimal se expresa como un punto en el fichero .lp  

06378             'Por ello cambia las comas de Grafos por puntos.  

06379             TextoModelo = TextoModelo . Replace ( "," , "." ) 

06380      

06381             'Enseña el modelo para debugging  

06382             'MsgBox(TextoModelo, MsgBoxStyle.Information, "Modelo .LP")  

06383      

06384             'fin tiempo  

06385             Dim Tiempo As System . TimeSpan = Now . Subtract ( TInicio ) 

06386             TiempoModelado = Tiempo . Milliseconds 

06387      

06388             '-------------------------------  

06389             'FASE 2: GRABA FICHERO .LP  

06390             '-------------------------------  

06391             EscribeFicheroTexto ( CurDir () & "\GrafosLP~.lp" , "" ) 

06392             EscribeFicheroTexto ( CurDir () & "\GrafosLP~.lp" , TextoModelo ) 

06393      

06394             'FASE 2_ALT: MODELO EN MEMORIA  

06395             ' - de momento descartado -  

06396      

06397             '---------------------------  

06398             'FASE 3: RESOLVER  

06399             'FASE 4: GUARDAR SOLUCIÓN  

06400             'FASE 4B: TRADUCIR SOLUCIÓN  

06401             '---------------------------  

06402             ResuelveFichero_GrafosLP ( CurDir () & "\GrafosLP~.lp" , "PROBLEMA DEL  

       »               TRANSBORDO" ) 

06403      

06404             '---------------------------------------  

06405             'FASE 5:MOSTRAR AL USUARIO SOLUCIÓN  

06406             '---------------------------------------  

06407             '### pensar en posible representación gráfica  

06408             'Representación gráfica del recorrido solución  

06409             AlgoritmoMILP = True 

06410      

06411             CopiaGrafoPrevio () 

06412      

06413             Dim vd As Long 

06414             vd = 0 

06415             For k = 0 To TotalArcos - 1 

06416                 Arcos ( k ) . Col = Color . Black 

06417                 Arcos ( k ) . Grosor = Grafico . TrazoArco 

06418      

06419                 'Se ignoran arcos que entren y salgan de un mismo nodo  

06420                 'If Arcos(k).Nd1 <> Arcos(k).Nd2 Then  

06421                 vd = vd + 1 

06422                 If SolucionModeloLP ( vd ) > 0 Then 

06423                     Arcos ( k ) . Col = Color . Green 

06424                     Arcos ( k ) . Grosor = Arcos ( k ) . Grosor + 1 

06425                 End If 

06426                 'End If  

06427             Next k 

06428             DibujaGrafo () 

06429      

06430             CopiaGrafoSolucion () 

06431             MuestraCajaSolucion () 

06432             Me . Cursor = Cursors . Default 

06433         End Sub 

06434         Function DaNombreArco ( ByVal k As Long ) As String 

06435             'Crea una etiqueta para el arco en función de las etiquetas  

06436             'del arco origen y destino  

06437             ' Return "x_" & Nodos(Arcos(k).Nd1).Texto & "_" &  

       »               Nodos(Arcos(k).Nd2).Texto  

06438      

06439             'no se utiliza los nombres de los nodos en la nomenclatura de las  

       »               variables  

06440             'ya que sino, se genera un error en el lp_solve si existen caracteres  

       »               extraños  

06441             Return "x_" & Arcos ( k ) . Nd1 & "_" & Arcos ( k ) . Nd2 

06442         End Function 

06443         Private Function abortfunc ( ByVal lp As Integer , ByVal aborthandle As Integer  

       »           ) As Integer 

06444             'En esta rutina se podría controlar el proceso de resolución  

       »               periódicamente  

06445             'y detenerlo en caso de necesidad, controlando por ejemplo una  

       »               pulsación de tecla  

06446      

06447             'con valor = 1 se detiene el proceso  

06448             abortfunc = 0 

06449      

06450         End Function 

06451         Private Sub Traduce ( ByVal FicheroOriginal As String , ByVal FicheroTraducido  

       »           As String ) 

06452      

06453             Dim TextoCompleto As String 

06454             'Lee un fichero plano y lo pone en una variable  

06455             LeeFicheroTexto ( FicheroOriginal , TextoCompleto ) 

06456      

06457             'Proceso de Traducción  

06458             Dim Buscar As String 

06459             Dim Reemplazar As String 

06460      

06461             Buscar = "Model name" 

06462             Reemplazar = "Nombre del modelo" 

06463             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06464      

06465             Buscar = "Value of objective function:" 

06466             Reemplazar = "Valor de la función objetivo =" 

06467             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06468      

06469             Buscar = "Actual values of the variables:" 

06470             Reemplazar = "Valor actual de las variables:" & vbCrLf 

06471             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06472      

06473             Buscar = "Actual values of the constraints:" 

06474             Reemplazar = "Valor actual de las restricciones:" & vbCrLf 

06475             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06476      

06477             Buscar = "Objective function limits:" 

06478             Reemplazar = "Sensibilidad de los coeficientes de la función objetivo:"  

       »               & vbCrLf 

06479             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06480      

06481             Buscar = "Dual values with from - till limits:" 

06482             Reemplazar = "Sensibilidad RHS de las restricciones:" & vbCrLf 

06483             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06484      

06485             Buscar = "Infinite" 

06486             Reemplazar = "Infinito" 

06487             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06488      

06489             Buscar = "Type" 

06490             Reemplazar = "Tipo" 

06491             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06492      

06493             Buscar = "upbo " 

06494             Reemplazar = "lim_Sup" 

06495             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06496      

06497             Buscar = "lowbo " 

06498             Reemplazar = "lim_Inf" 

06499             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06500      

06501             Buscar = "Minimize " 

06502             Reemplazar = "Minimizar" 

06503             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06504      

06505             Buscar = "Maximize " 

06506             Reemplazar = "Maximizar" 

06507             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06508      

06509             Buscar = "From " 

06510             Reemplazar = " Desde" 

06511             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06512      



06513             Buscar = "Till" 

06514             Reemplazar = "Hasta" 

06515             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06516      

06517             Buscar = " FromValue" 

06518             Reemplazar = "Coste reducido" 

06519             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06520      

06521             Buscar = " Dual value" 

06522             Reemplazar = "Precio sombra" 

06523             TextoCompleto = TextoCompleto . Replace ( Buscar , Reemplazar ) 

06524      

06525      

06526             'Guarda el resultado de la traducción  

06527             '--------------------------------------  

06528             'Escribe en un fichero plano un texto  

06529             EscribeFicheroTexto ( FicheroTraducido , TextoCompleto ) 

06530             FileClose () 

06531             'Guarda la solución en la variable para mostrar en pantalla  

06532             Form1 . txtResultadosAlgoritmo = "" 

06533             Form1 . txtResultadosAlgoritmo = TextoCompleto 

06534      

06535         End Sub 

06536         Public Sub ResuelveFichero_GrafosLP ( ByVal TrayectoriaFichero As String ,  

       »           ByVal TituloProblema As String ) 

06537      

06538             'declaración para lp_solve 5  

06539             Dim lpsolve As lpsolve51 

06540             'Inicialización del Solver lp_solver 5  

06541             lpsolve = New lpsolve51 

06542             lpsolve . Init ( "." ) 

06543      

06544             '---------------------------------------  

06545             'Declaración de variables para lp_solve  

06546             '---------------------------------------  

06547             Dim lp1 As Integer 

06548             Dim lp2 As Integer 

06549             Dim Row () As Double 

06550             Dim Lower () As Double 

06551             Dim Upper () As Double 

06552             Dim Col () As Double 

06553             Dim Arry () As Double 

06554             Dim Buf As String 

06555      

06556      

06557             'prueba QSopt  

06558             ' lp1 = QSopt1.QSopt.QSread_prob("c:\GrafosLP.mps", "MPS")  

06559             ' lp1 = QSopt1.QSopt.QSopt_primal(lp1, 1)  

06560             ' qssolver -O problema.mps >sol.txt  

06561      

06562      

06563             '---------------------------------------  

06564             'Fichero de entrada en formato .lp  

06565             lp1 = lpsolve . read_LP ( TrayectoriaFichero , False , TituloProblema ) 

06566             If lp1 = 0 Then 

06567                 Beep () 

06568             End If 

06569             '---------------------------------------  

06570             'Ficheros de salida (log, resultados y modelo en formato .mps)  

06571             'Indica nombre y trayectoria del fichero log  

06572             'lpsolve.log_file(CurDir() & "\log.txt")  

06573      

06574             'Indica nombre y trayectoria del fichero de resultados  

06575             'versión 5  

06576      

06577             EscribeFicheroTexto ( CurDir () & "\GrafosLP_results.txt" , "" ) 

06578             EscribeFicheroTexto ( CurDir () & "\GrafosLP_results_es.txt" , "" ) 

06579      

06580             lpsolve . set_outputfile ( lp1 , CurDir () & "\GrafosLP_results.txt" ) 

06581      

06582             'escribe el problema en formato mps  

06583             lpsolve . write_mps ( lp1 , CurDir () & "\GrafosLP~.mps" ) 

06584      

06585             'escribe el problema también en formato CPLEX  

06586             lpsolve . write_lp ( lp1 , CurDir () & "\GrafosLP~.lp" ) 

06587      

06588      

06589      

06590             '---------------------------------------  

06591             'Crea una referencia a la rutina de abortar  

06592             'desde dicha rutina 'abortfunc' se puede controlar el proceso  

06593             'de resolución y parar controlando pulsaciones de tecla por ejemplo.  

06594             'lpsolve.put_abortfunc(lp1, AddressOf abortfunc, 0)  

06595      

06596             'Establece el tiempo de timeout (en segundos) para parar el proceso  

06597             'en caso de no encontrar solución factible  

06598             'con valor = 0 no hay tiempo límite  

06599             lpsolve . set_timeout ( lp1 , 0 ) 

06600      

06601      

06602             lpsolve . print_str ( lp1 , TituloProblema & vbLf ) 

06603             lpsolve . print_str ( lp1 , "---------------------------------------" & vbLf ) 

06604             lpsolve . print_str ( lp1 , vbLf ) 

06605      

06606             'Inicio tiempo  

06607             Dim TInicio As Date = Now 

06608      

06609             'Cálculo propiamente dicho  

06610             Dim optimo As Integer 

06611             'opción de selección de rama en branch & bound  

06612             'automatic por defecto  

06613             'lpsolve.set_bb_floorfirst(lp1, lpsolve_branch.BRANCH_AUTOMATIC)  

06614             'opción de regla de branch & bound  

06615             lpsolve . set_bb_rule ( lp1 , lpsolve_BBstrategies . NODE_PSEUDORATIOSELECT ) '  

       »               lpsolve_BBstrategies.NODE_PSEUDONONINTSELECT)  

06616             'opción de descomposición LU  

06617             optimo = lpsolve . set_BFP ( lp1 , "bfp_LUSOL" ) '"bfp_GLPK")  

06618             'opción de escalado  

06619             lpsolve . set_scaling ( lp1 , lpsolve_scales . SCALE_CURTISREID Or  

       »               lpsolve_scales . SCALE_INTEGERS ) 

06620             'opción de selección de pivote en simplex (devex por defecto)  

06621             lpsolve . set_pivoting ( lp1 , lpsolve_piv_rules . PRICER_DEVEX ) 

06622             'soluciona  

06623             optimo = lpsolve . solve ( lp1 ) 

06624      

06625             'fin tiempo  

06626             Dim tiempoproceso As Long 

06627             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

06628      

06629             'Escribe el tiempo de proceso  

06630             lpsolve . print_str ( lp1 , " Tiempo de modelado = " & TiempoModelado .  

       »               ToString & " segundos" & vbLf ) 

06631             lpsolve . print_str ( lp1 , " Tiempo de proceso = " & tiempoproceso . ToString 

       »               & " segundos" & vbLf ) 

06632             lpsolve . print_str ( lp1 , vbLf ) 

06633      

06634             'comprueba si la solución encontrada es óptima  

06635      

06636             Select Case optimo 

06637      

06638                 Case 0 'Solución óptima  

06639                     lpsolve . print_str ( lp1 , " SOLUCIÓN ÓPTIMA " & vbLf ) 

06640                     'Escribe valor devuelto por solver  

06641                     lpsolve . print_str ( lp1 , " lp_solve -> " & optimo & vbLf ) 

06642                     lpsolve . print_str ( lp1 , vbLf ) 

06643                 Case 1 'Solución subóptima  

06644                     lpsolve . print_str ( lp1 , " SOLUCIÓN SUB-ÓPTIMA " & vbLf ) 

06645                     'Escribe valor devuelto por solver  

06646                     lpsolve . print_str ( lp1 , " lp_solve -> " & optimo & vbLf ) 

06647                     lpsolve . print_str ( lp1 , vbLf ) 

06648      

06649                 Case Is >= 2 'infactible, ilimitado  

06650      

06651                     lpsolve . print_str ( lp1 , " PROBLEMA NO FACTIBLE " & vbLf ) 

06652                     'Escribe valor devuelto por solver  

06653                     lpsolve . print_str ( lp1 , " lp_solve -> " & optimo & vbLf ) 

06654                     lpsolve . print_str ( lp1 , vbLf ) 

06655      

06656                     MsgBox ( "LP Solver ha detectado un problema no factible." ,  

       »                       MsgBoxStyle . Exclamation , "LP Solver" ) 

06657      



06658             End Select 

06659      

06660      

06661             'Escribe el modelo  

06662             lpsolve . print_lp ( lp1 ) 

06663             lpsolve . print_str ( lp1 , vbLf ) 

06664      

06665             'Incluye el modelo en formato lp  

06666             lpsolve . print_str ( lp1 , "Modelo en formato (.LP):" & vbLf ) 

06667             lpsolve . print_str ( lp1 , vbLf ) 

06668             Dim modelo As String 

06669             LeeFicheroTexto ( CurDir () & "\GrafosLP~.lp" , modelo ) 

06670             lpsolve . print_str ( lp1 , modelo ) 

06671      

06672             'Toma datos  

06673             ReDim Col ( lpsolve . get_Ncolumns ( lp1 )) 

06674             lpsolve . get_variables ( lp1 , Col ( 1 )) 

06675      

06676      

06677             '------------  

06678             'Recorre la solución y la guarda en este array para su posible  

06679             'representación gráfica  

06680             ReDim SolucionModeloLP ( lpsolve . get_Ncolumns ( lp1 )) 

06681             Dim s As Long 

06682             For s = 1 To lpsolve . get_Ncolumns ( lp1 ) 

06683                 SolucionModeloLP ( s ) = Col ( s ) 

06684                 'Debug.Write(s & "...." & SolucionModeloLP(s))  

06685                 'Debug.Write(vbCrLf)  

06686             Next s 

06687             '------------  

06688      

06689      

06690             ReDim Row ( lpsolve . get_Nrows ( lp1 )) 

06691             lpsolve . get_constraints ( lp1 , Row ( 1 )) 

06692      

06693             ReDim Arry ( lpsolve . get_Ncolumns ( lp1 ) + lpsolve . get_Nrows ( lp1 )) 

06694             lpsolve . get_dual_solution ( lp1 , Arry ( 0 )) 

06695      

06696             ReDim Arry ( lpsolve . get_Ncolumns ( lp1 ) + lpsolve . get_Nrows ( lp1 )) 

06697             ReDim Lower ( lpsolve . get_Ncolumns ( lp1 ) + lpsolve . get_Nrows ( lp1 )) 

06698             ReDim Upper ( lpsolve . get_Ncolumns ( lp1 ) + lpsolve . get_Nrows ( lp1 )) 

06699             lpsolve . get_sensitivity_rhs ( lp1 , Arry ( 1 ), Lower ( 1 ), Upper ( 1 )) 

06700      

06701             ReDim Lower ( lpsolve . get_Ncolumns ( lp1 )) 

06702             ReDim Upper ( lpsolve . get_Ncolumns ( lp1 )) 

06703             lpsolve . get_sensitivity_obj ( lp1 , Lower ( 0 ), Upper ( 0 )) 

06704      

06705             'Escribe la función objetivo  

06706             lpsolve . print_objective ( lp1 ) 

06707             'Escribe la solución para las variables de decisión  

06708             lpsolve . print_solution ( lp1 , 1 ) 

06709             'Escribe el resultado de las restricciones  

06710             lpsolve . print_constraints ( lp1 , 1 ) 

06711      

06712      

06713             'Escribe el análisis de sensibilidad  

06714             lpsolve . print_duals ( lp1 ) 

06715      

06716             'Borra el problema en memoria  

06717             lpsolve . delete_lp ( lp1 ) 

06718      

06719             'Cierra y guarda ficheros  

06720             'lpsolve.print_file(vbNullString)  

06721             'lpsolve.log_file(vbNullString)  

06722             lpsolve . set_outputfile ( lp1 , CurDir () & "\fin.txt" ) 

06723      

06724      

06725      

06726             lpsolve = Nothing 

06727      

06728             'Llama a la función de traducción del fichero de resultados  

06729             Traduce ( CurDir () & "\GrafosLP_results.txt" , CurDir () &  

       »               "\GrafosLP_results_es.txt" ) 

06730      

06731      

06732         End Sub 

06733         Private Sub mnuAnalisis_TSP_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles mnuAnalisis_TSP . Click 

06734             'Lanza rutina de Viajante de Comercio  

06735             TSP () 

06736      

06737         End Sub 

06738         Sub TSP () 

06739             'PROBLEMA DEL VIAJANTE DE COMERCIO  

06740             'Modelado MILP del Problema del Viajante de Comercio  

06741      

06742             'El modelo en formato .lp se resolverá mediante la libreria  

06743             'lp_solve 5.0.0.0 bajo licencia LGPL  

06744      

06745             Me . Cursor = Cursors . WaitCursor 

06746             Dim i , j , k As Integer 

06747      

06748             Dim MatrizArcos ( TotalNodos - 1 , TotalNodos - 1 ) As Long 

06749             Dim SumSal ( TotalNodos - 1 ) As Long 

06750             Dim SumEnt ( TotalNodos - 1 ) As Long 

06751             Dim ContadorArcosReales As Long 

06752             ContadorArcosReales = 0 

06753      

06754             'pone toda la matriz sin relación de arcos  

06755             For i = 0 To TotalNodos - 1 

06756                 SumSal ( i ) = 0 

06757                 SumEnt ( i ) = 0 

06758                 For j = 0 To TotalNodos - 1 

06759                     MatrizArcos ( i , j ) = - 1 

06760                 Next j 

06761             Next i 

06762             'marca los arcos existentes, pero no los de un mismo nodo  

06763             For i = 0 To TotalArcos - 1 

06764                 If Arcos ( i ) . Nd1 = Arcos ( i ) . Nd2 Then 

06765                     '  

06766                 Else 'le pasa el valor del indice del array de arcos  

06767                     MatrizArcos ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = i 

06768                     SumSal ( Arcos ( i ) . Nd1 ) += 1 

06769                     SumEnt ( Arcos ( i ) . Nd2 ) += 1 

06770                 End If 

06771             Next i 

06772      

06773      

06774      

06775             '------------------------------------  

06776             'FASE 0: CONDICIONES DE INTEGRIDAD  

06777             '------------------------------------  

06778             'no permitir nodos sueltos sin arcos  

06779             'If ExistenNodosSueltos() Then  

06780             For i = 0 To TotalNodos - 1 

06781                 ContadorArcosReales += SumSal ( i ) 

06782      

06783                 If SumSal ( i ) = 0 And SumEnt ( i ) = 0 Then 

06784                     MsgBox ( "En este grafo existen nodos no conectados." & vbCrLf &  

       »                       "Elimine los nodos sueltos o conéctelos." , MsgBoxStyle .  

       »                       Information , "Problema del Viajante de Comercio" ) 

06785                     Me . Cursor = Cursors . Arrow 

06786                     Exit Sub 

06787                 End If 

06788             Next i 

06789      

06790             '### no permitir arcos que entren y salgan de un mismo nodo???  

06791             'Se ignoran más abajo  

06792      

06793             'comprobar las opciones de coste nodo, coste arco, min arco y max arco  

       »               activadas  

06794             If Grafico . costArco = False Then 

06795                 MsgBox ( "Para resolver el Problema del Viajante de Comercio  

       »                   (distancia mínima) mediante" & vbCrLf & "MILP debe activar las  

       »                   opciones de Coste, de los arcos del grafo en el menú" & vbCrLf &  

       »                   " Formato/Opciones/Arcos." , MsgBoxStyle . Information , "Problema  

       »                   del Viajante de Comercio" ) 

06796                 Exit Sub 

06797             End If 

06798      

06799      

06800             '### arcos con costes negativos?  

06801      

06802      

06803             '--------------------------------------  

06804             'FASE 0B: ALTERNATIVAS DE PROBLEMA  

06805             '--------------------------------------  

06806      

06807      

06808      

06809             'capacitado  

06810      

06811             'Opciones de capacidad para determinar las restricciones  

06812             'If Grafico.minArco = False Then  

06813             'MsgBox("En este problema de Transbordo (coste mínimo) mediante LP" &  

       »               vbCrLf & "no se considerará la restricción de flujo mínimo en los  

       »               arcos.", MsgBoxStyle.Information, "Transbordo - LP")  

06814             'End If  

06815             'If Grafico.maxArco = False Then  

06816             'MsgBox("En este problema de Transbordo (coste mínimo) mediante LP" &  

       »               vbCrLf & "no se considerará la restricción de flujo máximo en los  

       »               arcos.", MsgBoxStyle.Information, "Transbordo - LP")  

06817             'End If  

06818      

06819             'no capacitado  

06820      

06821             '------------------  

06822             'FASE 1: MODELADO  

06823             '------------------  

06824             'Inicio tiempo  

06825             Dim TInicio As Date = Now 

06826      

06827             Dim TextoModelo As String 

06828      

06829      

06830             'Función Objetivo (a minimizar)  

06831             '--------------------------------------------  

06832             'El sumatorio para todos los arcos de las distancias entre nodos  

06833             'minimiza distancia total de Recorrido  

06834             'Variables de decisión (arco seleccionado 1 , 0)  

06835             Dim operador As String 

06836      

06837             TextoModelo = "min: " 

06838             For k = 0 To TotalArcos - 1 

06839                 'Se ignoran arcos que entren y salgan de un mismo nodo  

06840                 If Arcos ( k ) . Nd1 <> Arcos ( k ) . Nd2 Then 

06841                     'ContadorArcosReales = ContadorArcosReales + 1  

06842      

06843                     If Arcos ( k ) . Coste >= 0 Then 

06844                         'el operador >= 0 indica que se incluye el flujo de  

06845                         'arcos con coste cero como variables de decisión  

06846                         operador = " +" & Arcos ( k ) . Coste . ToString 

06847                     End If 

06848                     If Arcos ( k ) . Coste < 0 Then 

06849                         'no es necesario anteponer el signo menos  

06850                         operador = Arcos ( k ) . Coste . ToString 

06851                         'operador = "- " & Arcos(k).Coste.ToString  

06852                     End If 

06853      

06854                     TextoModelo & = operador & DaNombreArco ( k ) 

06855                 End If 

06856             Next k 

06857             TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06858             TextoModelo & = vbCrLf 'salto de línea  

06859      

06860             Dim nr As Long 'contador de restricciones  

06861             nr = 0 

06862      

06863      

06864             'Restricciones de Ruta  

06865             '--------------------------------------------  

06866             'tantas restricciones como nodos  

06867             'el total de arcos de entrada debe ser igual a 1  

06868             'el total de arcos de salida debe ser igual a 1  

06869             'se garantiza un que el nodo sólo aparece una vez en el recorrido  

06870      

06871             For i = 0 To TotalNodos - 1 

06872                 'Para todos los arcos ENTRANTES de ese nodo  

06873                 If SumEnt ( i ) > 0 Then 

06874                     nr = nr + 1 

06875                     TextoModelo & = "r" & nr . ToString & ": " 

06876                     For j = 0 To TotalNodos - 1 

06877                         If MatrizArcos ( j , i ) > - 1 Then 

06878                             TextoModelo & = " +" & DaNombreArco ( MatrizArcos ( j , i ))  

       »                               'siempre suma  

06879                         End If 

06880                     Next j 

06881                     'condición  

06882                     TextoModelo & = " = 1" 

06883                     TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06884                 End If 

06885      

06886                 'Para todos los arcos SALIENTES de ese nodo  

06887                 If SumSal ( i ) > 0 Then 

06888                     nr = nr + 1 

06889                     TextoModelo & = "r" & nr . ToString & ": " 

06890                     For j = 0 To TotalNodos - 1 

06891                         If MatrizArcos ( i , j ) > - 1 Then 

06892                             TextoModelo & = " +" & DaNombreArco ( MatrizArcos ( i , j ))  

       »                               'siempre suma  

06893                         End If 

06894                     Next j 

06895                     'condición  

06896                     TextoModelo & = " = 1" 

06897                     TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06898                 End If 

06899             Next i 

06900             TextoModelo & = vbCrLf 'salto de línea  

06901      

06902      

06903             'Condiciones de Tucker  

06904             '--------------------------------------------  

06905             'para todos los nodos (2...n) del modelo, el primero no  

06906             'Garantizan que no existen subrutas  

06907             '(hace uso del número real de arcos, no aquellos de un mismo nodo)  

06908      

06909             For i = 1 To TotalNodos - 1 

06910                 'Se ignoran arcos que entren y salgan de un mismo nodo  

06911                 'arcos de salida pertenece al nodo  

06912      

06913                 If SumSal ( i ) > 0 Then 

06914                     For j = 0 To TotalNodos - 1 

06915                         If MatrizArcos ( i , j ) > - 1 Then 

06916                             k = MatrizArcos ( i , j ) 

06917                             nr = nr + 1 

06918                             TextoModelo & = "r" & nr . ToString & ": " 'indicador de  

       »                               restricción  

06919      

06920                             TextoModelo & = "u" & Arcos ( k ) . Nd1 . ToString 

06921                             TextoModelo & = " -u" & Arcos ( k ) . Nd2 . ToString 

06922                             TextoModelo & = " +" & ContadorArcosReales . ToString &  

       »                               DaNombreArco ( k ) 

06923                             TextoModelo & = " <= " 

06924                             TextoModelo & = ContadorArcosReales - 1 

06925                             TextoModelo & = ";" & vbCrLf 'fin línea y salto de  

       »                               línea  

06926                         End If 

06927                     Next j 

06928                 End If 

06929      

06930             Next i 

06931             TextoModelo & = vbCrLf 'salto de línea  

06932      

06933             'El punto decimal se expresa como un punto en el fichero .lp  

06934             'Por ello cambia las comas de Grafos por puntos.  

06935             'Además en este caso se sustituye antes de declarar con comas  

06936             'la lista de variables enteras  

06937             TextoModelo = TextoModelo . Replace ( "," , "." ) 

06938      

06939             'Restricciones de variables enteras  

06940             '--------------------------------------------  

06941             'tantas restricciones como arcos  

06942             TextoModelo & = "int " 

06943             Dim cont As Long 

06944             cont = 0 

06945             For k = 0 To TotalArcos - 1 

06946                 'Se ignoran arcos que entren y salgan de un mismo nodo  

06947                 If Arcos ( k ) . Nd1 <> Arcos ( k ) . Nd2 Then 

06948                     cont = cont + 1 

06949                     TextoModelo & = DaNombreArco ( k ) 

06950      

06951                     If cont < ContadorArcosReales Then 

06952                         TextoModelo & = ", " 

06953                     Else 

06954                         'llegó al último y no necesita coma separadora  

06955                     End If 

06956      

06957                 End If 

06958             Next k 

06959             TextoModelo & = ";" & vbCrLf 'fin línea y salto de línea  

06960      

06961             'Enseña el modelo para debugging  

06962             'MsgBox(TextoModelo, MsgBoxStyle.Information, "Modelo .LP")  

06963      

06964             'fin tiempo  

06965             Dim Tiempo As System . TimeSpan = Now . Subtract ( TInicio ) 

06966             'TiempoModelado = Tiempo.Milliseconds  

06967      

06968             TiempoModelado = DateDiff ( DateInterval . Second , TInicio , Now ) 

06969      

06970             '-------------------------------  

06971             'FASE 2: GRABA FICHERO .LP  

06972             '-------------------------------  

06973      

06974             EscribeFicheroTexto ( CurDir () & "\GrafosLP~.lp" , "" ) 

06975             EscribeFicheroTexto ( CurDir () & "\GrafosLP~.lp" , TextoModelo ) 

06976      

06977             'FASE 2_ALT: MODELO EN MEMORIA  

06978             ' - de momento descartado -  

06979      

06980             '---------------------------  

06981             'FASE 3: RESOLVER  

06982             'FASE 4: GUARDAR SOLUCIÓN  

06983             'FASE 4B: TRADUCIR SOLUCIÓN  

06984             '---------------------------  

06985             ResuelveFichero_GrafosLP ( CurDir () & "\GrafosLP~.lp" , "PROBLEMA DEL  

       »               VIAJANTE DE COMERCIO" ) 

06986      

06987      

06988             '---------------------------------------  

06989             'FASE 5:MOSTRAR AL USUARIO SOLUCIÓN  

06990             '---------------------------------------  

06991             'Representación gráfica del recorrido solución  

06992             AlgoritmoMILP = True 

06993      

06994             CopiaGrafoPrevio () 

06995      

06996             Dim vd As Long 

06997             vd = 0 

06998             For k = 0 To TotalArcos - 1 

06999                 Arcos ( k ) . Col = Color . Black 

07000                 Arcos ( k ) . Grosor = Grafico . TrazoArco 

07001      

07002                 'Se ignoran arcos que entren y salgan de un mismo nodo  

07003                 If Arcos ( k ) . Nd1 <> Arcos ( k ) . Nd2 Then 

07004                     vd = vd + 1 

07005                     If SolucionModeloLP ( vd ) = 1 Then 

07006                         Arcos ( k ) . Col = Color . Green 

07007                         Arcos ( k ) . Grosor = Arcos ( k ) . Grosor + 1 

07008                     End If 

07009                 End If 

07010             Next k 

07011             DibujaGrafo () 

07012      

07013             CopiaGrafoSolucion () 

07014             MuestraCajaSolucion () 

07015             Me . Cursor = Cursors . Default 

07016         End Sub 

07017         Protected Overrides Sub Finalize () 

07018             ' lpsolve = Nothing  

07019             MyBase . Finalize () 

07020         End Sub 

07021      

07022      



07023         Sub MuestraCajaSolucion () 

07024             'variable que será leída por form6  

07025             txtResultadosAlgoritmo = txtResultadosAlgoritmo & vbCrLf & "(cc)  

       »               2003..2005 - Alejandro Rodríguez Villalobos" 

07026             'Muestra el formulario de respuesta  

07027             CajaSolucion . txtResultados . Text = txtResultadosAlgoritmo 

07028             CajaSolucion . txtResultados . SelectionLength = 0 

07029             CajaSolucion . WindowState = FormWindowState . Normal 

07030             CajaSolucion . StartPosition = FormStartPosition . CenterParent 

07031             'Pulsador de mostrar solución gráfica por defecto activado  

07032             CajaSolucion . btnSolucionGrafo . Pushed = True 

07033             'Pulsador de resultados  

07034             CajaSolucion . btnVerResultados . Pushed = True 

07035             CajaSolucion . btnVerLP . Pushed = False 

07036             CajaSolucion . btnVerMPS . Pushed = False 

07037      

07038             'habilita o deshabilita ver los modelos LP  

07039             If AlgoritmoMILP = True Then 

07040                 CajaSolucion . btnVerLP . Enabled = True 

07041                 CajaSolucion . btnVerMPS . Enabled = True 

07042             Else 

07043                 CajaSolucion . btnVerLP . Enabled = False 

07044                 CajaSolucion . btnVerMPS . Enabled = False 

07045             End If 

07046      

07047             'la caja solución está por encima del resto de controles  

07048             CajaSolucion . TopMost = True 

07049             CajaSolucion . Visible = True 

07050         End Sub 

07051      

07052         Private Sub mnuFormatoOrganico_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoOrganico . Click 

07053      

07054             mnuFormatoAleatorio . Checked = False 

07055             mnuFormatoTablero . Checked = False 

07056             mnuFormatoCircular . Checked = False 

07057             mnuFormatoFlujo . Checked = False 

07058             mnuFormatoOrganico . Checked = True 

07059             If TotalNodos < 2 Or TotalArcos < 1 Then Exit Sub 

07060      

07061             'pide antes confirmación  

07062             Dim respuesta As MsgBoxResult 

07063             respuesta = MsgBox ( "Esta opción cambiará la ubicación de los nodos hacia 

       »               una representación orgánica." & vbCrLf & "¿Desea realmente reordenar 

       »               los nodos?" , MsgBoxStyle . OKCancel , ) 

07064             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

07065             Me . Cursor = Cursors . WaitCursor 

07066             OrdenaenForceDirect () 

07067             If Grafico . Iman Then Imantar () 

07068             DibujaGrafo () 

07069             Me . Cursor = Cursors . Default 

07070         End Sub 

07071         Private Sub CajaPropiedades_ActualizaGrafo ( ByVal valor As Boolean ) Handles  

       »           CajaPropiedades . ActualizaGrafo 

07072             'si se aplican cambios en las opciones de formato gráfico  

07073             'se debe redibujar el grafo  

07074             If valor = True Then DibujaGrafo () 

07075         End Sub 

07076         Private Sub CajaPropiedades_ActualizaMenu () Handles CajaPropiedades .  

       »           ActualizaMenu 

07077             'cuando se 'cierra' = invisible la caja de propiedades  

07078             'se debe actualizar su menú  

07079             If CajaPropiedades . Visible = False Then 

07080                 mnuFormatoOpciones . Enabled = True 

07081             Else 

07082                 mnuFormatoOpciones . Enabled = False 

07083             End If 

07084      

07085             mnuFormatoIman . Checked = Grafico . Iman 

07086             mnuFormatoRejilla . Checked = Grafico . MostrarRejilla 

07087      

07088         End Sub 

07089         Private Sub mnuFormatoImantar_Click ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles mnuFormatoImantar . Click 

07090             'Ajusta la distribución de los nodos del grafo  

07091             'a la configuración de la rejilla  

07092             'moviendo en x e y cada nodo para que coincida  

07093             'con la rejilla  

07094             Imantar () 

07095             DibujaGrafo () 

07096         End Sub 

07097         Sub Imantar () 

07098             'Ajusta la distribución de los nodos del grafo  

07099             'a la configuración de la rejilla  

07100             'moviendo en x e y cada nodo para que coincida  

07101             'con la rejilla  

07102             Dim u As Long 

07103             For u = 0 To TotalNodos - 1 

07104                 Nodos ( u ) . X = Int (( Nodos ( u ) . X + Nodos ( u ) . Radio ) / Grafico . Rejilla )  

       »                   * Grafico . Rejilla 

07105                 Nodos ( u ) . Y = Int (( Nodos ( u ) . Y + Nodos ( u ) . Radio ) / Grafico . Rejilla )  

       »                   * Grafico . Rejilla 

07106             Next u 

07107         End Sub 

07108         Private Sub mnuArchivoExportarDatos_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuArchivoExportarDatos . Click 

07109             'Muestra el formulario de opciones de Exportar datos  

07110             If mnuEdicionTabular . Checked = False Then 

07111                 'si hay datos para exportar  

07112                 If TotalNodos = 0 Then 

07113                     'no podemos exportar nada si no hay nodos  

07114                     MsgBox ( "No existen datos del grafo para exportar. Primero debe  

       »                       crear al menos un nodo del grafo." , MsgBoxStyle . Exclamation ,  

       »                       "Grafos - Información" ) 

07115                     Exit Sub 

07116                 End If 

07117      

07118                 CajaExportar . Visible = True 

07119             End If 

07120         End Sub 

07121         Private Sub mnuArchivoImportarDatos_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuArchivoImportarDatos . Click 

07122             'menu archivo exportar datos  

07123             If mnuEdicionTabular . Checked = False Then 

07124                 CajaImportar . Visible = True 

07125             End If 

07126         End Sub 

07127         Private Sub CajaImportar_ActualizaGrafo ( ByVal valor As Boolean ) Handles  

       »           CajaImportar . ActualizaGrafo 

07128             'si se importan datos  

07129             'se debe redibujar el grafo  

07130             If valor = True Then DibujaGrafo () 

07131         End Sub 

07132         Private Sub mnuArchivoNuevoAleatorio_Click ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles mnuArchivoNuevoAleatorio . Click 

07133             If TotalNodos > 0 Or NodosMatriz > 0 Then 

07134                 Dim respuesta As MsgBoxResult 

07135                 respuesta = MsgBox ( " Si no ha grabado las últimas modificaciones,  

       »                   perderá los datos actuales." & vbCrLf & " ¿Desea realmente crear  

       »                   un nuevo grafo?" , MsgBoxStyle . OKCancel , ) 

07136                 If respuesta = MsgBoxResult . Cancel Then Exit Sub 

07137             End If 

07138      

07139      

07140             CajaNuevoAleatorio . Visible = True 

07141      

07142      

07143         End Sub 

07144         Private Sub CajaNuevoAleatorio_ActualizaGrafo ( ByVal valor As Boolean , ByVal  

       »           n As Long , ByVal a As Long , ByVal r As Boolean ) Handles  

       »           CajaNuevoAleatorio . ActualizaGrafo 

07145      

07146             If valor = False Then Exit Sub 

07147      

07148             'Crea nuevo grafo aleatorio  

07149      

07150             'nombre del fichero en estatus bar  

07151             Me . StatusBar . Panels ( 6 ) . Text = "" 

07152      

07153             'lee las opciones por defecto  

07154             OpcionesporDefecto () 

07155      

07156             'Cambia y posiciona el picturebox  

07157             PictureBox1 . Top = 0 

07158             PictureBox1 . Left = 0 

07159             PictureBox1 . Width = Grafico . TapizX * Grafico . Zoom 

07160             PictureBox1 . Height = Grafico . TapizX * Grafico . Zoom 

07161      

07162             TotalNodos = 0 

07163             TotalArcos = 0 

07164             NodosMatriz = 0 

07165             CreaGrafoAleatorio ( n , a , r ) 

07166      

07167             'no selecciona ningún nodo  

07168             Nd1S = - 1 

07169             Nd2S = - 1 

07170      

07171             'Llama al proceso principal de dibujar grafo  

07172             DibujaGrafo () 

07173             Grafico . Fichero = "" 

07174             Grafico . Extension = ".graphML" 'extensión por defecto .graphML  

07175      

07176             PictureBox1 . Visible = True 

07177             ActivaMenus () 

07178      

07179         End Sub 

07180         Private Sub LeeFicheroGRF ( ByVal fichero As String ) 

07181             'Esta rutina es la encargada de leer el fichero de extensión .grf  

07182             'e introducir los datos en las colecciones del grafo  

07183      

07184             'Abre el fichero para leer  

07185             Try 

07186                 FileOpen ( 1 , fichero , OpenMode . Input , OpenAccess . Read ) 

07187      

07188                 Dim A , R , G , B As Integer 

07189                 Dim CADENA As String 

07190      

07191                 Input ( 1 , CADENA ) 'copyright  

07192                 Input ( 1 , CADENA ) 'versión del fichero  

07193      

07194                 'Opciones generales  

07195                 Input ( 1 , Grafico . Zoom ) 

07196                 Input ( 1 , Grafico . Rejilla ) 

07197                 Input ( 1 , Grafico . TapizX ) 

07198                 Input ( 1 , Grafico . TapizY ) 

07199      

07200                 Input ( 1 , A ) 

07201                 Input ( 1 , R ) 

07202                 Input ( 1 , G ) 

07203                 Input ( 1 , B ) 

07204                 Grafico . ColorRejilla = Color . FromArgb ( A , R , G , B ) 

07205      

07206                 Input ( 1 , A ) 

07207                 Input ( 1 , R ) 

07208                 Input ( 1 , G ) 

07209                 Input ( 1 , B ) 

07210                 Grafico . ColorTapiz = Color . FromArgb ( A , R , G , B ) 

07211      

07212                 'nodo  

07213                 Dim n As String 

07214                 Dim t As Single 

07215                 Dim v As Integer 

07216      

07217                 Input ( 1 , n ) 

07218                 Input ( 1 , t ) 

07219                 Input ( 1 , v ) 

07220      

07221                 Dim F As New Font ( n , t , v , GraphicsUnit . Pixel ) 

07222      

07223                 Grafico . Fuente = F 

07224      

07225                 Input ( 1 , Grafico . TrazoNodo ) 

07226                 Input ( 1 , Grafico . RadioNodo ) 

07227      

07228                 Input ( 1 , A ) 

07229                 Input ( 1 , R ) 

07230                 Input ( 1 , G ) 

07231                 Input ( 1 , B ) 

07232                 Grafico . ColNodo = Color . FromArgb ( A , R , G , B ) 

07233      

07234      

07235                 Input ( 1 , Grafico . textoNodo ) 

07236                 Input ( 1 , Grafico . costNodo ) 

07237      

07238                 'arco  

07239                 Input ( 1 , Grafico . minArco ) 

07240                 Input ( 1 , Grafico . maxArco ) 

07241                 Input ( 1 , Grafico . costArco ) 

07242                 Input ( 1 , Grafico . TrazoArco ) 

07243                 Input ( 1 , Grafico . BArco ) 

07244      

07245                 Input ( 1 , A ) 

07246                 Input ( 1 , R ) 

07247                 Input ( 1 , G ) 

07248                 Input ( 1 , B ) 

07249                 Grafico . ColArco = Color . FromArgb ( A , R , G , B ) 

07250      

07251      

07252                 '---------  

07253                 Input ( 1 , TotalNodos ) 'número de nodos  

07254                 Input ( 1 , TotalArcos ) 'número de arcos  

07255                 ReDim Nodos ( TotalNodos - 1 ) 

07256                 ReDim Arcos ( TotalArcos - 1 ) 

07257      

07258                 Dim i As Long 

07259      

07260                 For i = 0 To TotalNodos - 1 

07261                     Input ( 1 , Nodos ( i ) . Texto ) 

07262                     Input ( 1 , Nodos ( i ) . X ) 

07263                     Input ( 1 , Nodos ( i ) . Y ) 

07264                     Input ( 1 , Nodos ( i ) . Valor ) 

07265                     Input ( 1 , Nodos ( i ) . Radio ) 

07266                     Input ( 1 , Nodos ( i ) . Grosor ) 

07267      

07268                     Input ( 1 , A ) 

07269                     Input ( 1 , R ) 

07270                     Input ( 1 , G ) 

07271                     Input ( 1 , B ) 

07272                     Nodos ( i ) . Col = Color . FromArgb ( A , R , G , B ) 

07273      

07274                 Next i 

07275                 For i = 0 To TotalArcos - 1 

07276                     Input ( 1 , Arcos ( i ) . Min ) 

07277                     Input ( 1 , Arcos ( i ) . Max ) 

07278                     Input ( 1 , Arcos ( i ) . Coste ) 

07279                     Input ( 1 , Arcos ( i ) . Nd1 ) 

07280                     Input ( 1 , Arcos ( i ) . Nd2 ) 

07281                     Input ( 1 , Arcos ( i ) . B ) 

07282                     Input ( 1 , Arcos ( i ) . Texto ) 

07283      

07284                     Input ( 1 , A ) 

07285                     Input ( 1 , R ) 

07286                     Input ( 1 , G ) 

07287                     Input ( 1 , B ) 

07288                     Arcos ( i ) . Col = Color . FromArgb ( A , R , G , B ) 

07289      

07290                     Input ( 1 , Arcos ( i ) . Grosor ) 

07291                 Next i 

07292                 'Extensión del fichero en formato propietario .grf  

07293                 Grafico . Extension = ".grf" 

07294                 'Intercepción de posibles errores en el fichero  

07295             Catch ex As Exception 

07296                 Me . Cursor = Cursors . Default 

07297                 MsgBox ( "Ha fallado la operación de abrir fichero .grf" & vbCrLf & ex  

       »                   . Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

07298                 Exit Sub 

07299             Finally 

07300                 FileClose ( 1 ) 

07301      

07302             End Try 

07303      

07304         End Sub 

07305         Private Sub LeeFicheroGraphML ( ByVal fichero As String ) 

07306             'Esta rutina es la encargada de leer el fichero de extensión .graphML  

07307             'con una estructura de datos XML  

07308             'e introducir los datos en las colecciones del grafo  

07309      

07310             'Define varibles de lectura del fichero y de validación  

07311             Dim reader As XmlTextReader = New XmlTextReader ( fichero ) 

07312      

07313             '------------------------------------------------------------------  

07314             'VALIDACIÓN  

07315             '------------------------------------------------------------------  

07316             ''Este trozo de código y el EventoValidacionXML  

07317             ''Son necesarios para la validación del XML  

07318             ''### Está deshabilitado ya que posiblemente son más problemas que  

07319             ''### ventajas  

07320             'Dim v As New XmlValidatingReader(reader)  

07321             ''Define evento de validación  

07322             'AddHandler v.ValidationEventHandler, AddressOf EventoValidacionXML  

07323             ''tipo de validación por esquema  

07324             'v.ValidationType = ValidationType.Schema  

07325             ''Abre el fichero para leerlo  

07326             ''Es válido por defecto  

07327             'XMLValido = True  

07328             ''Intento de validación a través de la web  

07329             'While v.Read  

07330             ' 'aquí se podría añadir código para procesar el contenido  

07331             ' 'si el documento no es válido se generará el evento de error  

07332             ' 'donde se cambia el valor por defecto de XMLValido  

07333             'End While  

07334             'v.Close()  

07335             ''Comprobación validación final  

07336             'If XMLValido Then  

07337             ' 'xml es válido  

07338             'Else  

07339             ' 'xml no es válido  

07340             ' 'en la consola aparecen los errores  

07341             'End If  

07342      

07343             '------------------------------------------------------------------  

07344             'LECTURA E INTERPRETACIÓN  

07345             '------------------------------------------------------------------  

07346             'Variables de estado en el árbol xml  

07347             Dim DNodo As Boolean = False 

07348             Dim DArco As Boolean = False 

07349             Dim DGrafo As Boolean = False 

07350             Dim DGrafico As Boolean = True 

07351             'para el tipo de letra  

07352             Dim n As String 

07353             Dim t As Single 

07354             Dim v As Integer 

07355             'para el color  

07356             Dim A , R , G , B As Integer 

07357             'para pasar el valor  

07358             Dim valor As String 

07359      

07360             'Comienza el proceso de lectura del  

07361             Try 

07362                 Do While ( reader . Read ()) 

07363                     Select Case reader . NodeType 

07364                         Case XmlNodeType . Element 

07365                             'Muestra el comienzo de un elemento.  

07366                             'Console.Write("<" + reader.Name)  

07367      

07368                             'Se detecta el comienzo de la definición  

07369                             If reader . Name = "graph" Then 

07370                                 DGrafo = True 

07371                                 DGrafico = False 

07372                                 'Borra el grafo actual  

07373                                 TotalNodos = 0 

07374                                 TotalArcos = 0 

07375                                 ReDim Arcos ( 0 ) 

07376                                 ReDim Nodos ( 0 ) 

07377                             End If 

07378      

07379                             If reader . Name = "node" Then 

07380                                 DNodo = True 

07381                                 DGrafico = False 

07382                                 TotalNodos = TotalNodos + 1 

07383                                 ReDim Preserve Nodos ( TotalNodos - 1 ) 

07384                             End If 

07385      

07386                             If reader . Name = "edge" Then 

07387                                 DArco = True 

07388                                 DGrafico = False 

07389                                 TotalArcos = TotalArcos + 1 

07390                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

07391                             End If 

07392      

07393                             If reader . HasAttributes Then 

07394                                 'Si tiene atributos  

07395                                 While reader . MoveToNextAttribute () 

07396                                     'Muestra el nombre del atributo y su valor  

07397                                     'Console.Write(" {0}='{1}'", reader.Name,  

       »                                       reader.Value)  

07398      

07399                                     'Atributos del Grafo  

07400                                     'If DGrafo = True Then  

07401                                     ' If reader.Name = "parse.nodes" Then  

07402                                     ' TotalNodos = reader.Value  

07403                                     ' End If  

07404                                     ' If reader.Name = "parse.edges" Then  

07405                                     ' TotalArcos = reader.Value  

07406                                     ' End If  

07407                                     'End If  

07408      

07409                                     'Atributos del grafico  

07410                                     If DGrafico = True And reader . Name = "id" Then 

07411                                         valor = reader . Value 

07412                                     End If 

07413      

07414                                     'Atributos del Nodo  

07415                                     If DNodo = True And reader . Name = "key" Then 

07416                                         valor = reader . Value 

07417                                     End If 

07418                                     'Atributos del Arco  

07419                                     If DArco = True And reader . Name = "source"  

       »                                       Then 

07420                                         Arcos ( TotalArcos - 1 ) . Nd1 = Val ( reader .  

       »                                           Value . ToString . Remove ( 0 , 1 )) 

07421                                     End If 

07422                                     If DArco = True And reader . Name = "target"  

       »                                       Then 

07423                                         Arcos ( TotalArcos - 1 ) . Nd2 = Val ( reader .  

       »                                           Value . ToString . Remove ( 0 , 1 )) 

07424                                     End If 

07425                                     If DArco = True And reader . Name = "key" Then 

07426                                         valor = reader . Value 

07427                                     End If 

07428      



07429                                 End While 

07430                             End If 

07431                             'Console.WriteLine(">")  

07432                         Case XmlNodeType . Text 

07433                             'Muestra el texto de cada elemento.  

07434                             'Console.WriteLine(reader.Value)  

07435      

07436      

07437                             'Atributos del grafico  

07438                             If DGrafico = True Then 

07439                                 'Tapiz por defecto  

07440                                 If valor = "GvZ" Then 

07441                                     Grafico . Zoom = reader . Value 

07442                                 End If 

07443                                 If valor = "GvR" Then 

07444                                     Grafico . Rejilla = reader . Value 

07445                                 End If 

07446                                 If valor = "GvMR" Then 

07447                                     Grafico . MostrarRejilla = reader . Value 

07448                                 End If 

07449                                 If valor = "GvI" Then 

07450                                     Grafico . Iman = reader . Value 

07451                                 End If 

07452                                 If valor = "GtX" Then 

07453                                     Grafico . TapizX = reader . Value 

07454                                 End If 

07455                                 If valor = "GtY" Then 

07456                                     Grafico . TapizY = reader . Value 

07457                                 End If 

07458                                 'Color rejilla  

07459                                 If valor = "GrCA" Then 

07460                                     A = reader . Value 

07461                                 End If 

07462                                 If valor = "GrCR" Then 

07463                                     R = reader . Value 

07464                                 End If 

07465                                 If valor = "GrCG" Then 

07466                                     G = reader . Value 

07467                                 End If 

07468                                 If valor = "GrCB" Then 

07469                                     B = reader . Value 

07470                                     Grafico . ColorRejilla = Color . FromArgb ( A , R , G  

       »                                       , B ) 

07471                                 End If 

07472                                 'Color tapiz  

07473                                 If valor = "GtCA" Then 

07474                                     A = reader . Value 

07475                                 End If 

07476                                 If valor = "GtCR" Then 

07477                                     R = reader . Value 

07478                                 End If 

07479                                 If valor = "GtCG" Then 

07480                                     G = reader . Value 

07481                                 End If 

07482                                 If valor = "GtCB" Then 

07483                                     B = reader . Value 

07484                                     Grafico . ColorTapiz = Color . FromArgb ( A , R , G ,  

       »                                       B ) 

07485                                 End If 

07486                                 'Tipo de letra  

07487                                 If valor = "GfN" Then 

07488                                     n = reader . Value 

07489                                 End If 

07490                                 If valor = "GfS" Then 

07491                                     t = reader . Value 

07492                                 End If 

07493                                 If valor = "GfSt" Then 

07494                                     v = reader . Value 

07495                                     Dim F As New Font ( n , t , v , GraphicsUnit . Pixel  

       »                                       ) 

07496                                     Grafico . Fuente = F 

07497                                 End If 

07498                                 'Nodo por defecto  

07499                                 If valor = "GnT" Then 

07500                                     Grafico . textoNodo = reader . Value 

07501                                 End If 

07502                                 If valor = "GnV" Then 

07503                                     Grafico . costNodo = reader . Value 

07504                                 End If 

07505                                 If valor = "GnR" Then 

07506                                     Grafico . RadioNodo = reader . Value 

07507                                 End If 

07508                                 If valor = "GnG" Then 

07509                                     Grafico . TrazoNodo = reader . Value 

07510                                 End If 

07511                                 If valor = "GnCA" Then 

07512                                     A = reader . Value 

07513                                 End If 

07514                                 If valor = "GnCR" Then 

07515                                     R = reader . Value 

07516                                 End If 

07517                                 If valor = "GnCG" Then 

07518                                     G = reader . Value 

07519                                 End If 

07520                                 If valor = "GnCB" Then 

07521                                     B = reader . Value 

07522                                     Grafico . ColNodo = Color . FromArgb ( A , R , G , B ) 

07523                                 End If 

07524                                 'Arco por defecto  

07525                                 If valor = "GaMin" Then 

07526                                     Grafico . minArco = reader . Value 

07527                                 End If 

07528                                 If valor = "GaMax" Then 

07529                                     Grafico . maxArco = reader . Value 

07530                                 End If 

07531                                 If valor = "GaC" Then 

07532                                     Grafico . costArco = reader . Value 

07533                                 End If 

07534                                 If valor = "GaB" Then 

07535                                     Grafico . BArco = reader . Value 

07536                                 End If 

07537                                 If valor = "GaG" Then 

07538                                     Grafico . TrazoArco = reader . Value 

07539                                 End If 

07540      

07541                                 If valor = "GnCA" Then 

07542                                     A = reader . Value 

07543                                 End If 

07544                                 If valor = "GnCR" Then 

07545                                     R = reader . Value 

07546                                 End If 

07547                                 If valor = "GnCG" Then 

07548                                     G = reader . Value 

07549                                 End If 

07550                                 If valor = "GnCB" Then 

07551                                     B = reader . Value 

07552                                     Grafico . ColNodo = Color . FromArgb ( A , R , G , B ) 

07553                                 End If 

07554      

07555      



07556                             End If 

07557      

07558                             'Atributos de nodos  

07559                             If DNodo = True Then 

07560                                 If valor = "nT" Then 

07561                                     Nodos ( TotalNodos - 1 ) . Texto = reader . Value 

07562                                 End If 

07563                                 If valor = "nX" Then 

07564                                     Nodos ( TotalNodos - 1 ) . X = reader . Value 

07565                                 End If 

07566                                 If valor = "nY" Then 

07567                                     Nodos ( TotalNodos - 1 ) . Y = reader . Value 

07568                                 End If 

07569                                 If valor = "nZ" Then 

07570                                     Nodos ( TotalNodos - 1 ) . Z = reader . Value 

07571                                 End If 

07572                                 If valor = "nV" Then 

07573                                     Nodos ( TotalNodos - 1 ) . Valor = reader . Value 

07574                                 End If 

07575                                 If valor = "nR" Then 

07576                                     Nodos ( TotalNodos - 1 ) . Radio = reader . Value 

07577                                 End If 

07578                                 If valor = "nG" Then 

07579                                     Nodos ( TotalNodos - 1 ) . Grosor = reader . Value 

07580                                 End If 

07581                                 If valor = "nCA" Then 

07582                                     A = reader . Value 

07583                                 End If 

07584                                 If valor = "nCR" Then 

07585                                     R = reader . Value 

07586                                 End If 

07587                                 If valor = "nCG" Then 

07588                                     G = reader . Value 

07589                                 End If 

07590                                 If valor = "nCB" Then 

07591                                     B = reader . Value 

07592                                     Nodos ( TotalNodos - 1 ) . Col = Color . FromArgb ( A , 

       »                                       R , G , B ) 

07593                                 End If 

07594                             End If 

07595      

07596                             'Atributos de arcos  

07597                             If DArco = True Then 

07598                                 If valor = "aT" Then 

07599                                     Arcos ( TotalArcos - 1 ) . Texto = reader . Value 

07600                                 End If 

07601                                 If valor = "aMin" Then 

07602                                     Arcos ( TotalArcos - 1 ) . Min = reader . Value 

07603                                 End If 

07604                                 If valor = "aMax" Then 

07605                                     Arcos ( TotalArcos - 1 ) . Max = reader . Value 

07606                                 End If 

07607                                 If valor = "aC" Then 

07608                                     Arcos ( TotalArcos - 1 ) . Coste = reader . Value 

07609                                 End If 

07610                                 If valor = "aB" Then 

07611                                     Arcos ( TotalArcos - 1 ) . B = reader . Value 

07612                                 End If 

07613                                 If valor = "aG" Then 

07614                                     Arcos ( TotalArcos - 1 ) . Grosor = reader . Value 

07615                                 End If 

07616                                 If valor = "aCA" Then 

07617                                     A = reader . Value 

07618                                 End If 

07619                                 If valor = "aCR" Then 

07620                                     R = reader . Value 

07621                                 End If 

07622                                 If valor = "aCG" Then 

07623                                     G = reader . Value 

07624                                 End If 

07625                                 If valor = "aCB" Then 

07626                                     B = reader . Value 

07627                                     Arcos ( TotalArcos - 1 ) . Col = Color . FromArgb ( A , 

       »                                       R , G , B ) 

07628                                 End If 

07629                             End If 

07630      

07631                         Case XmlNodeType . EndElement 

07632                             'Muestra el final del elemento.  

07633                             'Console.Write("</" + reader.Name)  

07634                             'Console.WriteLine(">")  

07635      

07636                             'Se detecta el final de la definición  

07637                             If reader . Name = "graph" Then DGrafo = False 

07638                             If reader . Name = "node" Then DNodo = False 

07639                             If reader . Name = "edge" Then DArco = False 

07640                     End Select 

07641                 Loop 

07642                 'Console.ReadLine()  

07643      

07644                 reader . Close () 

07645      

07646                 'Extensión del fichero en formato propietario .grf  

07647                 Grafico . Extension = ".graphML" 

07648                 'Intercepción de posibles errores en el fichero  

07649             Catch ex As Exception 

07650                 Me . Cursor = Cursors . Default 

07651                 MsgBox ( "Ha fallado la operación de abrir fichero .graphML" & vbCrLf  

       »                   & ex . Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

07652                 Exit Sub 

07653             Finally 

07654             End Try 

07655      

07656         End Sub 

07657         'Public Sub EventoValidacionXML(ByVal sender As Object, ByVal args As  

       »           System.Xml.Schema.ValidationEventArgs)  

07658         ' 'Este evento ocurre al intentar validar un fichero XML (Abrir .graphML)  

07659         ' XMLValido = False  

07660         ' Console.WriteLine("Validación XML = " & vbCrLf & args.Message)  

07661         'End Sub  

07662      

07663         Private Sub mnuFormatoAutoRadio_Click ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles mnuFormatoAutoRadio . Click 

07664             'Auto-radio nodos (valor)  

07665             If TotalNodos = 0 Then Exit Sub 

07666      

07667             'pide antes confirmación  

07668             Dim respuesta As MsgBoxResult 

07669             respuesta = MsgBox ( "Esta opción cambiará el radio de los nodos  

       »               proporcionalmente a su valor." & vbCrLf & "¿Desea realmente aplicar  

       »               cambios en el diseño?" , MsgBoxStyle . OKCancel , ) 

07670             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

07671      

07672             Dim i As Long 

07673             Dim suma As Double = 0 

07674      

07675             For i = 0 To TotalNodos - 1 

07676                 suma = suma + Nodos ( i ) . Valor 

07677             Next i 

07678             For i = 0 To TotalNodos - 1 

07679                 Nodos ( i ) . Radio = Math . Round (( Nodos ( i ) . Valor / suma ) * ( 50 - 15 ) +  

       »                   15 ) 

07680             Next i 

07681             DibujaGrafo () 

07682      

07683         End Sub 

07684      

07685         Private Sub mnuFormatoAutoTrazo_Click ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles mnuFormatoAutoTrazo . Click 

07686             'Auto-trazo arcos (coste)  

07687             If TotalArcos = 0 Then Exit Sub 

07688      

07689             'pide antes confirmación  

07690             Dim respuesta As MsgBoxResult 

07691             respuesta = MsgBox ( "Esta opción cambiará el grosor del trazo de los  

       »               arcos proporcionalmente a su coste." & vbCrLf & "¿Desea realmente  

       »               aplicar cambios en el diseño?" , MsgBoxStyle . OKCancel , ) 

07692             If respuesta = MsgBoxResult . Cancel Then Exit Sub 

07693      

07694             Dim i As Long 

07695             Dim suma As Double = 0 

07696      

07697             For i = 0 To TotalArcos - 1 

07698                 suma = suma + Arcos ( i ) . Coste 

07699             Next i 

07700             For i = 0 To TotalNodos - 1 

07701                 Arcos ( i ) . Grosor = Math . Round (( Arcos ( i ) . Coste / suma ) * ( 8 - 1 ) + 1  

       »                   ) 

07702             Next i 

07703             DibujaGrafo () 

07704      

07705         End Sub 

07706      

07707      

07708         Private Sub CajaSolucion_ActualizaGrafo ( ByVal valor As Boolean ) Handles  

       »           CajaSolucion . ActualizaGrafo 

07709             'Se responde al evento de dibujar solución desde la caja de solución  

07710             If valor = True Then 

07711                 DibujaGrafo () 

07712                 Me . Refresh () 

07713             End If 

07714         End Sub 

07715     End Class 

00001     Public Class Form2 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents TabControl1 As System . Windows . Forms . TabControl 

00033         Friend WithEvents TabPage1 As System . Windows . Forms . TabPage 

00034         Friend WithEvents TabPage2 As System . Windows . Forms . TabPage 

00035         Friend WithEvents TabPage3 As System . Windows . Forms . TabPage 

00036         Friend WithEvents udTrazoArco As System . Windows . Forms . NumericUpDown 

00037         Friend WithEvents Label2 As System . Windows . Forms . Label 

00038         Friend WithEvents chkBArco As System . Windows . Forms . CheckBox 

00039         Friend WithEvents GroupBox2 As System . Windows . Forms . GroupBox 

00040         Friend WithEvents lblColorArco As System . Windows . Forms . Label 

00041         Friend WithEvents btnColorArco As System . Windows . Forms . Button 

00042         Friend WithEvents GroupBox4 As System . Windows . Forms . GroupBox 

00043         Friend WithEvents Label3 As System . Windows . Forms . Label 

00044         Friend WithEvents lblColorNodo As System . Windows . Forms . Label 

00045         Friend WithEvents btnColorNodo As System . Windows . Forms . Button 

00046         Friend WithEvents udTrazoNodo As System . Windows . Forms . NumericUpDown 

00047         Friend WithEvents udRadioNodo As System . Windows . Forms . NumericUpDown 

00048         Friend WithEvents Label4 As System . Windows . Forms . Label 

00049         Friend WithEvents FontDialog1 As System . Windows . Forms . FontDialog 

00050         Friend WithEvents btnAplicar As System . Windows . Forms . Button 

00051         Friend WithEvents btnAplicarNuevos As System . Windows . Forms . Button 

00052         Friend WithEvents btnRestaurar As System . Windows . Forms . Button 

00053         Friend WithEvents udTapizX As System . Windows . Forms . NumericUpDown 

00054         Friend WithEvents udTapizY As System . Windows . Forms . NumericUpDown 

00055         Friend WithEvents btnColorTapiz As System . Windows . Forms . Button 

00056         Friend WithEvents GroupBox7 As System . Windows . Forms . GroupBox 

00057         Friend WithEvents Label7 As System . Windows . Forms . Label 

00058         Friend WithEvents Label8 As System . Windows . Forms . Label 

00059         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00060         Friend WithEvents TabPage4 As System . Windows . Forms . TabPage 

00061         Friend WithEvents GroupBox6 As System . Windows . Forms . GroupBox 

00062         Friend WithEvents btnColorRejilla As System . Windows . Forms . Button 

00063         Friend WithEvents udRejilla As System . Windows . Forms . NumericUpDown 

00064         Friend WithEvents lblColorRejilla As System . Windows . Forms . Label 

00065         Friend WithEvents Label5 As System . Windows . Forms . Label 

00066         Friend WithEvents chkMostrarRejilla As System . Windows . Forms . CheckBox 

00067         Friend WithEvents chkIman As System . Windows . Forms . CheckBox 

00068         Friend WithEvents TabPage5 As System . Windows . Forms . TabPage 

00069         Friend WithEvents lblFuente As System . Windows . Forms . Label 

00070         Friend WithEvents btnFuente As System . Windows . Forms . Button 

00071         Friend WithEvents Label1 As System . Windows . Forms . Label 

00072         Friend WithEvents udZoom As System . Windows . Forms . NumericUpDown 

00073         Friend WithEvents pbNodo As System . Windows . Forms . PictureBox 

00074         Friend WithEvents GroupBox3 As System . Windows . Forms . GroupBox 

00075         Friend WithEvents chktxtNodo As System . Windows . Forms . CheckBox 

00076         Friend WithEvents chkcostNodo As System . Windows . Forms . CheckBox 

00077         Friend WithEvents pbArco As System . Windows . Forms . PictureBox 

00078         Friend WithEvents GroupBox1 As System . Windows . Forms . GroupBox 

00079         Friend WithEvents chkminArco As System . Windows . Forms . CheckBox 

00080         Friend WithEvents chkmaxArco As System . Windows . Forms . CheckBox 

00081         Friend WithEvents chkcostArco As System . Windows . Forms . CheckBox 

00082         Friend WithEvents lblColorTapiz As System . Windows . Forms . PictureBox 

00083         Friend WithEvents chkTapizImagen As System . Windows . Forms . CheckBox 

00084         Friend WithEvents btnImagenTapiz As System . Windows . Forms . Button 

00085         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00086             Me . TabControl1 = New System . Windows . Forms . TabControl 

00087             Me . TabPage1 = New System . Windows . Forms . TabPage 

00088             Me . GroupBox7 = New System . Windows . Forms . GroupBox 

00089             Me . Label1 = New System . Windows . Forms . Label 

00090             Me . udZoom = New System . Windows . Forms . NumericUpDown 

00091             Me . udTapizX = New System . Windows . Forms . NumericUpDown 

00092             Me . btnColorTapiz = New System . Windows . Forms . Button 

00093             Me . Label7 = New System . Windows . Forms . Label 

00094             Me . udTapizY = New System . Windows . Forms . NumericUpDown 

00095             Me . Label8 = New System . Windows . Forms . Label 

00096             Me . TabPage3 = New System . Windows . Forms . TabPage 

00097             Me . GroupBox2 = New System . Windows . Forms . GroupBox 

00098             Me . GroupBox1 = New System . Windows . Forms . GroupBox 

00099             Me . chkminArco = New System . Windows . Forms . CheckBox 

00100             Me . chkmaxArco = New System . Windows . Forms . CheckBox 

00101             Me . chkcostArco = New System . Windows . Forms . CheckBox 

00102             Me . pbArco = New System . Windows . Forms . PictureBox 

00103             Me . udTrazoArco = New System . Windows . Forms . NumericUpDown 

00104             Me . Label2 = New System . Windows . Forms . Label 

00105             Me . chkBArco = New System . Windows . Forms . CheckBox 

00106             Me . btnColorArco = New System . Windows . Forms . Button 

00107             Me . lblColorArco = New System . Windows . Forms . Label 

00108             Me . TabPage2 = New System . Windows . Forms . TabPage 

00109             Me . GroupBox4 = New System . Windows . Forms . GroupBox 

00110             Me . GroupBox3 = New System . Windows . Forms . GroupBox 

00111             Me . chktxtNodo = New System . Windows . Forms . CheckBox 

00112             Me . chkcostNodo = New System . Windows . Forms . CheckBox 

00113             Me . pbNodo = New System . Windows . Forms . PictureBox 

00114             Me . Label4 = New System . Windows . Forms . Label 

00115             Me . udRadioNodo = New System . Windows . Forms . NumericUpDown 

00116             Me . udTrazoNodo = New System . Windows . Forms . NumericUpDown 

00117             Me . Label3 = New System . Windows . Forms . Label 

00118             Me . lblColorNodo = New System . Windows . Forms . Label 

00119             Me . btnColorNodo = New System . Windows . Forms . Button 

00120             Me . TabPage4 = New System . Windows . Forms . TabPage 

00121             Me . GroupBox6 = New System . Windows . Forms . GroupBox 

00122             Me . chkIman = New System . Windows . Forms . CheckBox 

00123             Me . chkMostrarRejilla = New System . Windows . Forms . CheckBox 

00124             Me . btnColorRejilla = New System . Windows . Forms . Button 

00125             Me . udRejilla = New System . Windows . Forms . NumericUpDown 

00126             Me . lblColorRejilla = New System . Windows . Forms . Label 

00127             Me . Label5 = New System . Windows . Forms . Label 

00128             Me . TabPage5 = New System . Windows . Forms . TabPage 

00129             Me . lblFuente = New System . Windows . Forms . Label 

00130             Me . btnFuente = New System . Windows . Forms . Button 

00131             Me . FontDialog1 = New System . Windows . Forms . FontDialog 

00132             Me . btnAplicar = New System . Windows . Forms . Button 

00133             Me . btnAplicarNuevos = New System . Windows . Forms . Button 

00134             Me . btnRestaurar = New System . Windows . Forms . Button 

00135             Me . btnCancelar = New System . Windows . Forms . Button 

00136             Me . lblColorTapiz = New System . Windows . Forms . PictureBox 

00137             Me . chkTapizImagen = New System . Windows . Forms . CheckBox 

00138             Me . btnImagenTapiz = New System . Windows . Forms . Button 

00139             Me . TabControl1 . SuspendLayout () 

00140             Me . TabPage1 . SuspendLayout () 

00141             Me . GroupBox7 . SuspendLayout () 

00142             CType ( Me . udZoom , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00143             CType ( Me . udTapizX , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00144             CType ( Me . udTapizY , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00145             Me . TabPage3 . SuspendLayout () 

00146             Me . GroupBox2 . SuspendLayout () 

00147             Me . GroupBox1 . SuspendLayout () 

00148             CType ( Me . udTrazoArco , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00149             Me . TabPage2 . SuspendLayout () 

00150             Me . GroupBox4 . SuspendLayout () 

00151             Me . GroupBox3 . SuspendLayout () 

00152             CType ( Me . udRadioNodo , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00153             CType ( Me . udTrazoNodo , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00154             Me . TabPage4 . SuspendLayout () 

00155             Me . GroupBox6 . SuspendLayout () 

00156             CType ( Me . udRejilla , System . ComponentModel . ISupportInitialize ) . BeginInit ( 

       »               ) 

00157             Me . TabPage5 . SuspendLayout () 

00158             Me . SuspendLayout () 

00159             '  

00160             'TabControl1  

00161             '  

00162             Me . TabControl1 . Anchor = CType ((( System . Windows . Forms . AnchorStyles . Top Or 

       »               System . Windows . Forms . AnchorStyles . Left ) _ 

00163                         Or System . Windows . Forms . AnchorStyles . Right ), System . Windows  

       »                           . Forms . AnchorStyles ) 

00164             Me . TabControl1 . Controls . Add ( Me . TabPage1 ) 

00165             Me . TabControl1 . Controls . Add ( Me . TabPage3 ) 

00166             Me . TabControl1 . Controls . Add ( Me . TabPage2 ) 

00167             Me . TabControl1 . Controls . Add ( Me . TabPage4 ) 

00168             Me . TabControl1 . Controls . Add ( Me . TabPage5 ) 

00169             Me . TabControl1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00170             Me . TabControl1 . Name = "TabControl1" 

00171             Me . TabControl1 . SelectedIndex = 0 

00172             Me . TabControl1 . Size = New System . Drawing . Size ( 370 , 215 ) 

00173             Me . TabControl1 . TabIndex = 0 

00174             '  

00175             'TabPage1  

00176             '  

00177             Me . TabPage1 . Controls . Add ( Me . GroupBox7 ) 

00178             Me . TabPage1 . Location = New System . Drawing . Point ( 4 , 22 ) 

00179             Me . TabPage1 . Name = "TabPage1" 

00180             Me . TabPage1 . Size = New System . Drawing . Size ( 362 , 189 ) 

00181             Me . TabPage1 . TabIndex = 0 

00182             Me . TabPage1 . Text = "Tapiz" 

00183             '  

00184             'GroupBox7  

00185             '  

00186             Me . GroupBox7 . Controls . Add ( Me . chkTapizImagen ) 

00187             Me . GroupBox7 . Controls . Add ( Me . lblColorTapiz ) 

00188             Me . GroupBox7 . Controls . Add ( Me . Label1 ) 

00189             Me . GroupBox7 . Controls . Add ( Me . udZoom ) 

00190             Me . GroupBox7 . Controls . Add ( Me . udTapizX ) 

00191             Me . GroupBox7 . Controls . Add ( Me . btnColorTapiz ) 

00192             Me . GroupBox7 . Controls . Add ( Me . Label7 ) 

00193             Me . GroupBox7 . Controls . Add ( Me . udTapizY ) 

00194             Me . GroupBox7 . Controls . Add ( Me . Label8 ) 

00195             Me . GroupBox7 . Controls . Add ( Me . btnImagenTapiz ) 

00196             Me . GroupBox7 . Location = New System . Drawing . Point ( 8 , 8 ) 

00197             Me . GroupBox7 . Name = "GroupBox7" 

00198             Me . GroupBox7 . Size = New System . Drawing . Size ( 344 , 176 ) 

00199             Me . GroupBox7 . TabIndex = 7 

00200             Me . GroupBox7 . TabStop = False 

00201             '  

00202             'Label1  

00203             '  

00204             Me . Label1 . Location = New System . Drawing . Point ( 248 , 144 ) 

00205             Me . Label1 . Name = "Label1" 

00206             Me . Label1 . Size = New System . Drawing . Size ( 40 , 24 ) 

00207             Me . Label1 . TabIndex = 23 

00208             Me . Label1 . Text = "Zoom:" 

00209             Me . Label1 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00210             '  

00211             'udZoom  

00212             '  

00213             Me . udZoom . DecimalPlaces = 2 

00214             Me . udZoom . Increment = New Decimal ( New Integer () { 1 , 0 , 0 , 65536 }) 

00215             Me . udZoom . Location = New System . Drawing . Point ( 288 , 144 ) 

00216             Me . udZoom . Maximum = New Decimal ( New Integer () { 4 , 0 , 0 , 0 }) 

00217             Me . udZoom . Minimum = New Decimal ( New Integer () { 2 , 0 , 0 , 65536 }) 

00218             Me . udZoom . Name = "udZoom" 

00219             Me . udZoom . Size = New System . Drawing . Size ( 48 , 20 ) 

00220             Me . udZoom . TabIndex = 22 

00221             Me . udZoom . Value = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00222             '  

00223             'udTapizX  

00224             '  

00225             Me . udTapizX . Increment = New Decimal ( New Integer () { 50 , 0 , 0 , 0 }) 

00226             Me . udTapizX . Location = New System . Drawing . Point ( 48 , 144 ) 

00227             Me . udTapizX . Maximum = New Decimal ( New Integer () { 2000 , 0 , 0 , 0 }) 

00228             Me . udTapizX . Minimum = New Decimal ( New Integer () { 100 , 0 , 0 , 0 }) 

00229             Me . udTapizX . Name = "udTapizX" 

00230             Me . udTapizX . Size = New System . Drawing . Size ( 56 , 20 ) 

00231             Me . udTapizX . TabIndex = 8 

00232             Me . udTapizX . Value = New Decimal ( New Integer () { 800 , 0 , 0 , 0 }) 

00233             '  

00234             'btnColorTapiz  

00235             '  

00236             Me . btnColorTapiz . Location = New System . Drawing . Point ( 256 , 16 ) 

00237             Me . btnColorTapiz . Name = "btnColorTapiz" 

00238             Me . btnColorTapiz . Size = New System . Drawing . Size ( 80 , 24 ) 

00239             Me . btnColorTapiz . TabIndex = 20 

00240             Me . btnColorTapiz . Text = "Color ..." 

00241             '  

00242             'Label7  

00243             '  

00244             Me . Label7 . Location = New System . Drawing . Point ( 104 , 144 ) 

00245             Me . Label7 . Name = "Label7" 

00246             Me . Label7 . Size = New System . Drawing . Size ( 40 , 24 ) 

00247             Me . Label7 . TabIndex = 9 

00248             Me . Label7 . Text = "ancho" 

00249             Me . Label7 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00250             '  

00251             'udTapizY  

00252             '  

00253             Me . udTapizY . Increment = New Decimal ( New Integer () { 50 , 0 , 0 , 0 }) 

00254             Me . udTapizY . Location = New System . Drawing . Point ( 168 , 72 ) 

00255             Me . udTapizY . Maximum = New Decimal ( New Integer () { 2000 , 0 , 0 , 0 }) 

00256             Me . udTapizY . Minimum = New Decimal ( New Integer () { 100 , 0 , 0 , 0 }) 

00257             Me . udTapizY . Name = "udTapizY" 

00258             Me . udTapizY . Size = New System . Drawing . Size ( 56 , 20 ) 

00259             Me . udTapizY . TabIndex = 10 

00260             Me . udTapizY . Value = New Decimal ( New Integer () { 800 , 0 , 0 , 0 }) 

00261             '  

00262             'Label8  

00263             '  

00264             Me . Label8 . Location = New System . Drawing . Point ( 224 , 72 ) 

00265             Me . Label8 . Name = "Label8" 

00266             Me . Label8 . Size = New System . Drawing . Size ( 24 , 24 ) 

00267             Me . Label8 . TabIndex = 9 

00268             Me . Label8 . Text = "alto" 

00269             Me . Label8 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00270             '  

00271             'TabPage3  

00272             '  

00273             Me . TabPage3 . Controls . Add ( Me . GroupBox2 ) 

00274             Me . TabPage3 . Location = New System . Drawing . Point ( 4 , 22 ) 

00275             Me . TabPage3 . Name = "TabPage3" 

00276             Me . TabPage3 . Size = New System . Drawing . Size ( 362 , 189 ) 

00277             Me . TabPage3 . TabIndex = 2 

00278             Me . TabPage3 . Text = "Arcos" 

00279             '  

00280             'GroupBox2  

00281             '  

00282             Me . GroupBox2 . Controls . Add ( Me . GroupBox1 ) 

00283             Me . GroupBox2 . Controls . Add ( Me . pbArco ) 

00284             Me . GroupBox2 . Controls . Add ( Me . udTrazoArco ) 

00285             Me . GroupBox2 . Controls . Add ( Me . Label2 ) 

00286             Me . GroupBox2 . Controls . Add ( Me . chkBArco ) 

00287             Me . GroupBox2 . Controls . Add ( Me . btnColorArco ) 

00288             Me . GroupBox2 . Controls . Add ( Me . lblColorArco ) 

00289             Me . GroupBox2 . Location = New System . Drawing . Point ( 8 , 8 ) 

00290             Me . GroupBox2 . Name = "GroupBox2" 

00291             Me . GroupBox2 . Size = New System . Drawing . Size ( 344 , 176 ) 

00292             Me . GroupBox2 . TabIndex = 10 

00293             Me . GroupBox2 . TabStop = False 

00294             '  

00295             'GroupBox1  

00296             '  

00297             Me . GroupBox1 . Controls . Add ( Me . chkminArco ) 

00298             Me . GroupBox1 . Controls . Add ( Me . chkmaxArco ) 

00299             Me . GroupBox1 . Controls . Add ( Me . chkcostArco ) 

00300             Me . GroupBox1 . FlatStyle = System . Windows . Forms . FlatStyle . Flat 

00301             Me . GroupBox1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00302             Me . GroupBox1 . Name = "GroupBox1" 

00303             Me . GroupBox1 . Size = New System . Drawing . Size ( 80 , 80 ) 

00304             Me . GroupBox1 . TabIndex = 13 

00305             Me . GroupBox1 . TabStop = False 

00306             '  

00307             'chkminArco  

00308             '  

00309             Me . chkminArco . Checked = True 

00310             Me . chkminArco . CheckState = System . Windows . Forms . CheckState . Checked 

00311             Me . chkminArco . Location = New System . Drawing . Point ( 8 , 16 ) 

00312             Me . chkminArco . Name = "chkminArco" 

00313             Me . chkminArco . Size = New System . Drawing . Size ( 64 , 16 ) 

00314             Me . chkminArco . TabIndex = 0 

00315             Me . chkminArco . Text = "mínimo" 

00316             '  

00317             'chkmaxArco  

00318             '  

00319             Me . chkmaxArco . Checked = True 

00320             Me . chkmaxArco . CheckState = System . Windows . Forms . CheckState . Checked 

00321             Me . chkmaxArco . Location = New System . Drawing . Point ( 8 , 32 ) 

00322             Me . chkmaxArco . Name = "chkmaxArco" 

00323             Me . chkmaxArco . Size = New System . Drawing . Size ( 64 , 24 ) 

00324             Me . chkmaxArco . TabIndex = 1 

00325             Me . chkmaxArco . Text = "máximo" 

00326             '  

00327             'chkcostArco  

00328             '  

00329             Me . chkcostArco . Checked = True 

00330             Me . chkcostArco . CheckState = System . Windows . Forms . CheckState . Checked 

00331             Me . chkcostArco . Location = New System . Drawing . Point ( 8 , 56 ) 

00332             Me . chkcostArco . Name = "chkcostArco" 

00333             Me . chkcostArco . Size = New System . Drawing . Size ( 64 , 16 ) 

00334             Me . chkcostArco . TabIndex = 2 

00335             Me . chkcostArco . Text = "coste" 

00336             '  

00337             'pbArco  

00338             '  

00339             Me . pbArco . BackColor = System . Drawing . Color . White 

00340             Me . pbArco . BorderStyle = System . Windows . Forms . BorderStyle . Fixed3D 

00341             Me . pbArco . Location = New System . Drawing . Point ( 88 , 72 ) 

00342             Me . pbArco . Name = "pbArco" 

00343             Me . pbArco . Size = New System . Drawing . Size ( 248 , 96 ) 

00344             Me . pbArco . TabIndex = 12 

00345             Me . pbArco . TabStop = False 

00346             '  

00347             'udTrazoArco  

00348             '  

00349             Me . udTrazoArco . Location = New System . Drawing . Point ( 8 , 144 ) 

00350             Me . udTrazoArco . Maximum = New Decimal ( New Integer () { 8 , 0 , 0 , 0 }) 

00351             Me . udTrazoArco . Minimum = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00352             Me . udTrazoArco . Name = "udTrazoArco" 

00353             Me . udTrazoArco . Size = New System . Drawing . Size ( 48 , 20 ) 

00354             Me . udTrazoArco . TabIndex = 3 

00355             Me . udTrazoArco . Value = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00356             '  

00357             'Label2  

00358             '  

00359             Me . Label2 . Location = New System . Drawing . Point ( 8 , 128 ) 

00360             Me . Label2 . Name = "Label2" 

00361             Me . Label2 . Size = New System . Drawing . Size ( 40 , 16 ) 

00362             Me . Label2 . TabIndex = 8 

00363             Me . Label2 . Text = "Trazo: " 

00364             Me . Label2 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00365             '  

00366             'chkBArco  

00367             '  

00368             Me . chkBArco . Location = New System . Drawing . Point ( 88 , 48 ) 

00369             Me . chkBArco . Name = "chkBArco" 

00370             Me . chkBArco . Size = New System . Drawing . Size ( 104 , 16 ) 

00371             Me . chkBArco . TabIndex = 5 

00372             Me . chkBArco . Text = "Bidireccional" 

00373             '  

00374             'btnColorArco  

00375             '  

00376             Me . btnColorArco . Location = New System . Drawing . Point ( 256 , 16 ) 

00377             Me . btnColorArco . Name = "btnColorArco" 

00378             Me . btnColorArco . Size = New System . Drawing . Size ( 80 , 24 ) 

00379             Me . btnColorArco . TabIndex = 6 

00380             Me . btnColorArco . Text = "Color ..." 

00381             '  

00382             'lblColorArco  

00383             '  

00384             Me . lblColorArco . BackColor = System . Drawing . Color . Black 

00385             Me . lblColorArco . BorderStyle = System . Windows . Forms . BorderStyle .  

       »               FixedSingle 

00386             Me . lblColorArco . Location = New System . Drawing . Point ( 224 , 16 ) 

00387             Me . lblColorArco . Name = "lblColorArco" 

00388             Me . lblColorArco . Size = New System . Drawing . Size ( 24 , 24 ) 

00389             Me . lblColorArco . TabIndex = 11 

00390             '  

00391             'TabPage2  

00392             '  

00393             Me . TabPage2 . Controls . Add ( Me . GroupBox4 ) 

00394             Me . TabPage2 . Location = New System . Drawing . Point ( 4 , 22 ) 

00395             Me . TabPage2 . Name = "TabPage2" 

00396             Me . TabPage2 . Size = New System . Drawing . Size ( 362 , 189 ) 

00397             Me . TabPage2 . TabIndex = 1 

00398             Me . TabPage2 . Text = "Nodos" 

00399             '  

00400             'GroupBox4  

00401             '  

00402             Me . GroupBox4 . Controls . Add ( Me . GroupBox3 ) 

00403             Me . GroupBox4 . Controls . Add ( Me . pbNodo ) 

00404             Me . GroupBox4 . Controls . Add ( Me . Label4 ) 

00405             Me . GroupBox4 . Controls . Add ( Me . udRadioNodo ) 

00406             Me . GroupBox4 . Controls . Add ( Me . udTrazoNodo ) 

00407             Me . GroupBox4 . Controls . Add ( Me . Label3 ) 

00408             Me . GroupBox4 . Controls . Add ( Me . lblColorNodo ) 

00409             Me . GroupBox4 . Controls . Add ( Me . btnColorNodo ) 

00410             Me . GroupBox4 . Location = New System . Drawing . Point ( 8 , 8 ) 

00411             Me . GroupBox4 . Name = "GroupBox4" 

00412             Me . GroupBox4 . Size = New System . Drawing . Size ( 344 , 176 ) 

00413             Me . GroupBox4 . TabIndex = 16 

00414             Me . GroupBox4 . TabStop = False 

00415             '  

00416             'GroupBox3  

00417             '  

00418             Me . GroupBox3 . Controls . Add ( Me . chktxtNodo ) 

00419             Me . GroupBox3 . Controls . Add ( Me . chkcostNodo ) 

00420             Me . GroupBox3 . Location = New System . Drawing . Point ( 0 , 0 ) 

00421             Me . GroupBox3 . Name = "GroupBox3" 

00422             Me . GroupBox3 . Size = New System . Drawing . Size ( 80 , 72 ) 

00423             Me . GroupBox3 . TabIndex = 19 

00424             Me . GroupBox3 . TabStop = False 

00425             '  

00426             'chktxtNodo  

00427             '  

00428             Me . chktxtNodo . Checked = True 

00429             Me . chktxtNodo . CheckState = System . Windows . Forms . CheckState . Checked 

00430             Me . chktxtNodo . Location = New System . Drawing . Point ( 8 , 16 ) 

00431             Me . chktxtNodo . Name = "chktxtNodo" 

00432             Me . chktxtNodo . Size = New System . Drawing . Size ( 64 , 24 ) 

00433             Me . chktxtNodo . TabIndex = 1 

00434             Me . chktxtNodo . Text = "etiqueta" 

00435             '  

00436             'chkcostNodo  

00437             '  

00438             Me . chkcostNodo . Checked = True 

00439             Me . chkcostNodo . CheckState = System . Windows . Forms . CheckState . Checked 

00440             Me . chkcostNodo . Location = New System . Drawing . Point ( 8 , 40 ) 

00441             Me . chkcostNodo . Name = "chkcostNodo" 

00442             Me . chkcostNodo . Size = New System . Drawing . Size ( 56 , 16 ) 

00443             Me . chkcostNodo . TabIndex = 2 

00444             Me . chkcostNodo . Text = "valor" 

00445             '  

00446             'pbNodo  

00447             '  

00448             Me . pbNodo . BackColor = System . Drawing . Color . White 

00449             Me . pbNodo . BorderStyle = System . Windows . Forms . BorderStyle . Fixed3D 

00450             Me . pbNodo . Location = New System . Drawing . Point ( 96 , 48 ) 

00451             Me . pbNodo . Name = "pbNodo" 

00452             Me . pbNodo . Size = New System . Drawing . Size ( 120 , 120 ) 

00453             Me . pbNodo . TabIndex = 18 

00454             Me . pbNodo . TabStop = False 

00455             '  

00456             'Label4  

00457             '  

00458             Me . Label4 . Location = New System . Drawing . Point ( 224 , 80 ) 

00459             Me . Label4 . Name = "Label4" 

00460             Me . Label4 . Size = New System . Drawing . Size ( 48 , 16 ) 

00461             Me . Label4 . TabIndex = 10 

00462             Me . Label4 . Text = "Radio: " 

00463             Me . Label4 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00464             '  

00465             'udRadioNodo  

00466             '  

00467             Me . udRadioNodo . Location = New System . Drawing . Point ( 224 , 96 ) 

00468             Me . udRadioNodo . Maximum = New Decimal ( New Integer () { 50 , 0 , 0 , 0 }) 

00469             Me . udRadioNodo . Minimum = New Decimal ( New Integer () { 15 , 0 , 0 , 0 }) 

00470             Me . udRadioNodo . Name = "udRadioNodo" 

00471             Me . udRadioNodo . Size = New System . Drawing . Size ( 48 , 20 ) 

00472             Me . udRadioNodo . TabIndex = 9 

00473             Me . udRadioNodo . Value = New Decimal ( New Integer () { 15 , 0 , 0 , 0 }) 

00474             '  

00475             'udTrazoNodo  

00476             '  

00477             Me . udTrazoNodo . Location = New System . Drawing . Point ( 8 , 144 ) 

00478             Me . udTrazoNodo . Maximum = New Decimal ( New Integer () { 5 , 0 , 0 , 0 }) 

00479             Me . udTrazoNodo . Minimum = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00480             Me . udTrazoNodo . Name = "udTrazoNodo" 

00481             Me . udTrazoNodo . Size = New System . Drawing . Size ( 48 , 20 ) 

00482             Me . udTrazoNodo . TabIndex = 3 

00483             Me . udTrazoNodo . Value = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00484             '  

00485             'Label3  

00486             '  

00487             Me . Label3 . Location = New System . Drawing . Point ( 8 , 128 ) 

00488             Me . Label3 . Name = "Label3" 

00489             Me . Label3 . Size = New System . Drawing . Size ( 48 , 16 ) 

00490             Me . Label3 . TabIndex = 8 

00491             Me . Label3 . Text = "Trazo: " 

00492             Me . Label3 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00493             '  

00494             'lblColorNodo  

00495             '  

00496             Me . lblColorNodo . BackColor = System . Drawing . Color . LightSteelBlue 

00497             Me . lblColorNodo . BorderStyle = System . Windows . Forms . BorderStyle .  

       »               FixedSingle 

00498             Me . lblColorNodo . Location = New System . Drawing . Point ( 224 , 16 ) 

00499             Me . lblColorNodo . Name = "lblColorNodo" 

00500             Me . lblColorNodo . Size = New System . Drawing . Size ( 24 , 24 ) 

00501             Me . lblColorNodo . TabIndex = 17 

00502             '  

00503             'btnColorNodo  

00504             '  

00505             Me . btnColorNodo . Location = New System . Drawing . Point ( 256 , 16 ) 

00506             Me . btnColorNodo . Name = "btnColorNodo" 

00507             Me . btnColorNodo . Size = New System . Drawing . Size ( 80 , 24 ) 

00508             Me . btnColorNodo . TabIndex = 13 

00509             Me . btnColorNodo . Text = "Color ..." 

00510             '  

00511             'TabPage4  

00512             '  

00513             Me . TabPage4 . Controls . Add ( Me . GroupBox6 ) 

00514             Me . TabPage4 . Location = New System . Drawing . Point ( 4 , 22 ) 

00515             Me . TabPage4 . Name = "TabPage4" 

00516             Me . TabPage4 . Size = New System . Drawing . Size ( 362 , 189 ) 

00517             Me . TabPage4 . TabIndex = 3 

00518             Me . TabPage4 . Text = "Rejilla" 

00519             '  

00520             'GroupBox6  

00521             '  

00522             Me . GroupBox6 . Controls . Add ( Me . chkIman ) 

00523             Me . GroupBox6 . Controls . Add ( Me . chkMostrarRejilla ) 

00524             Me . GroupBox6 . Controls . Add ( Me . btnColorRejilla ) 

00525             Me . GroupBox6 . Controls . Add ( Me . udRejilla ) 

00526             Me . GroupBox6 . Controls . Add ( Me . lblColorRejilla ) 

00527             Me . GroupBox6 . Controls . Add ( Me . Label5 ) 

00528             Me . GroupBox6 . Location = New System . Drawing . Point ( 8 , 8 ) 

00529             Me . GroupBox6 . Name = "GroupBox6" 

00530             Me . GroupBox6 . Size = New System . Drawing . Size ( 344 , 176 ) 

00531             Me . GroupBox6 . TabIndex = 7 

00532             Me . GroupBox6 . TabStop = False 

00533             '  

00534             'chkIman  

00535             '  

00536             Me . chkIman . Location = New System . Drawing . Point ( 8 , 40 ) 

00537             Me . chkIman . Name = "chkIman" 

00538             Me . chkIman . TabIndex = 21 

00539             Me . chkIman . Text = "Imán" 

00540             '  

00541             'chkMostrarRejilla  

00542             '  

00543             Me . chkMostrarRejilla . Location = New System . Drawing . Point ( 8 , 16 ) 

00544             Me . chkMostrarRejilla . Name = "chkMostrarRejilla" 

00545             Me . chkMostrarRejilla . TabIndex = 20 

00546             Me . chkMostrarRejilla . Text = "Mostrar rejilla" 

00547             '  

00548             'btnColorRejilla  

00549             '  

00550             Me . btnColorRejilla . Location = New System . Drawing . Point ( 256 , 16 ) 

00551             Me . btnColorRejilla . Name = "btnColorRejilla" 

00552             Me . btnColorRejilla . Size = New System . Drawing . Size ( 80 , 24 ) 

00553             Me . btnColorRejilla . TabIndex = 18 

00554             Me . btnColorRejilla . Text = "Color ..." 

00555             '  

00556             'udRejilla  

00557             '  

00558             Me . udRejilla . Increment = New Decimal ( New Integer () { 5 , 0 , 0 , 0 }) 

00559             Me . udRejilla . Location = New System . Drawing . Point ( 8 , 72 ) 

00560             Me . udRejilla . Minimum = New Decimal ( New Integer () { 10 , 0 , 0 , 0 }) 

00561             Me . udRejilla . Name = "udRejilla" 

00562             Me . udRejilla . Size = New System . Drawing . Size ( 48 , 20 ) 

00563             Me . udRejilla . TabIndex = 6 

00564             Me . udRejilla . Value = New Decimal ( New Integer () { 10 , 0 , 0 , 0 }) 

00565             '  

00566             'lblColorRejilla  

00567             '  

00568             Me . lblColorRejilla . BackColor = System . Drawing . Color . Silver 

00569             Me . lblColorRejilla . BorderStyle = System . Windows . Forms . BorderStyle .  

       »               FixedSingle 

00570             Me . lblColorRejilla . Location = New System . Drawing . Point ( 224 , 16 ) 

00571             Me . lblColorRejilla . Name = "lblColorRejilla" 

00572             Me . lblColorRejilla . Size = New System . Drawing . Size ( 24 , 24 ) 

00573             Me . lblColorRejilla . TabIndex = 19 

00574             '  

00575             'Label5  

00576             '  

00577             Me . Label5 . Location = New System . Drawing . Point ( 64 , 72 ) 

00578             Me . Label5 . Name = "Label5" 

00579             Me . Label5 . Size = New System . Drawing . Size ( 64 , 24 ) 

00580             Me . Label5 . TabIndex = 7 

00581             Me . Label5 . Text = "Espacio:" 

00582             Me . Label5 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00583             '  

00584             'TabPage5  

00585             '  

00586             Me . TabPage5 . Controls . Add ( Me . lblFuente ) 

00587             Me . TabPage5 . Controls . Add ( Me . btnFuente ) 

00588             Me . TabPage5 . Location = New System . Drawing . Point ( 4 , 22 ) 

00589             Me . TabPage5 . Name = "TabPage5" 

00590             Me . TabPage5 . Size = New System . Drawing . Size ( 362 , 189 ) 

00591             Me . TabPage5 . TabIndex = 4 

00592             Me . TabPage5 . Text = "Fuente" 

00593             '  

00594             'lblFuente  

00595             '  

00596             Me . lblFuente . AutoSize = True 

00597             Me . lblFuente . Font = New System . Drawing . Font ( "Verdana" , 12.0 !, System .  

       »               Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point , CType ( 0  

       »               , Byte )) 

00598             Me . lblFuente . Location = New System . Drawing . Point ( 8 , 40 ) 

00599             Me . lblFuente . Name = "lblFuente" 

00600             Me . lblFuente . Size = New System . Drawing . Size ( 122 , 23 ) 

00601             Me . lblFuente . TabIndex = 6 

00602             Me . lblFuente . Text = "ABC abc 0123" 

00603             Me . lblFuente . TextAlign = System . Drawing . ContentAlignment . MiddleCenter 

00604             '  

00605             'btnFuente  

00606             '  

00607             Me . btnFuente . Location = New System . Drawing . Point ( 264 , 24 ) 

00608             Me . btnFuente . Name = "btnFuente" 

00609             Me . btnFuente . Size = New System . Drawing . Size ( 80 , 24 ) 

00610             Me . btnFuente . TabIndex = 5 

00611             Me . btnFuente . Text = "Fuente..." 

00612             '  

00613             'btnAplicar  

00614             '  

00615             Me . btnAplicar . Location = New System . Drawing . Point ( 184 , 224 ) 

00616             Me . btnAplicar . Name = "btnAplicar" 

00617             Me . btnAplicar . Size = New System . Drawing . Size ( 88 , 24 ) 

00618             Me . btnAplicar . TabIndex = 1 

00619             Me . btnAplicar . Text = "Aplicar" 

00620             '  

00621             'btnAplicarNuevos  

00622             '  

00623             Me . btnAplicarNuevos . Location = New System . Drawing . Point ( 96 , 224 ) 

00624             Me . btnAplicarNuevos . Name = "btnAplicarNuevos" 

00625             Me . btnAplicarNuevos . Size = New System . Drawing . Size ( 80 , 24 ) 

00626             Me . btnAplicarNuevos . TabIndex = 0 

00627             Me . btnAplicarNuevos . Text = "Establecer" 

00628             '  

00629             'btnRestaurar  

00630             '  

00631             Me . btnRestaurar . Location = New System . Drawing . Point ( 8 , 224 ) 

00632             Me . btnRestaurar . Name = "btnRestaurar" 

00633             Me . btnRestaurar . Size = New System . Drawing . Size ( 80 , 24 ) 

00634             Me . btnRestaurar . TabIndex = 2 

00635             Me . btnRestaurar . Text = "Restaurar " 

00636             '  

00637             'btnCancelar  

00638             '  

00639             Me . btnCancelar . Location = New System . Drawing . Point ( 280 , 224 ) 

00640             Me . btnCancelar . Name = "btnCancelar" 

00641             Me . btnCancelar . Size = New System . Drawing . Size ( 80 , 24 ) 

00642             Me . btnCancelar . TabIndex = 3 

00643             Me . btnCancelar . Text = "Cancelar" 

00644             '  

00645             'lblColorTapiz  

00646             '  

00647             Me . lblColorTapiz . BackColor = System . Drawing . Color . White 

00648             Me . lblColorTapiz . BorderStyle = System . Windows . Forms . BorderStyle . Fixed3D 

00649             Me . lblColorTapiz . Location = New System . Drawing . Point ( 8 , 16 ) 

00650             Me . lblColorTapiz . Name = "lblColorTapiz" 

00651             Me . lblColorTapiz . Size = New System . Drawing . Size ( 152 , 120 ) 

00652             Me . lblColorTapiz . TabIndex = 24 

00653             Me . lblColorTapiz . TabStop = False 

00654             '  

00655             'chkTapizImagen  

00656             '  

00657             Me . chkTapizImagen . Location = New System . Drawing . Point ( 248 , 120 ) 

00658             Me . chkTapizImagen . Name = "chkTapizImagen" 

00659             Me . chkTapizImagen . Size = New System . Drawing . Size ( 88 , 16 ) 

00660             Me . chkTapizImagen . TabIndex = 25 

00661             Me . chkTapizImagen . Text = "imagen tapiz" 

00662             '  

00663             'btnImagenTapiz  

00664             '  

00665             Me . btnImagenTapiz . Enabled = False 

00666             Me . btnImagenTapiz . Location = New System . Drawing . Point ( 256 , 40 ) 

00667             Me . btnImagenTapiz . Name = "btnImagenTapiz" 

00668             Me . btnImagenTapiz . Size = New System . Drawing . Size ( 80 , 24 ) 

00669             Me . btnImagenTapiz . TabIndex = 20 

00670             Me . btnImagenTapiz . Text = "Imagen ..." 

00671             '  

00672             'Form2  

00673             '  

00674             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00675             Me . ClientSize = New System . Drawing . Size ( 370 , 255 ) 

00676             Me . ControlBox = False 

00677             Me . Controls . Add ( Me . btnCancelar ) 

00678             Me . Controls . Add ( Me . btnAplicar ) 

00679             Me . Controls . Add ( Me . TabControl1 ) 

00680             Me . Controls . Add ( Me . btnAplicarNuevos ) 

00681             Me . Controls . Add ( Me . btnRestaurar ) 

00682             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00683             Me . MaximizeBox = False 

00684             Me . MinimizeBox = False 

00685             Me . Name = "Form2" 

00686             Me . Text = "Grafos - Opciones de Formato" 

00687             Me . TopMost = True 

00688             Me . TabControl1 . ResumeLayout ( False ) 

00689             Me . TabPage1 . ResumeLayout ( False ) 

00690             Me . GroupBox7 . ResumeLayout ( False ) 

00691             CType ( Me . udZoom , System . ComponentModel . ISupportInitialize ) . EndInit () 

00692             CType ( Me . udTapizX , System . ComponentModel . ISupportInitialize ) . EndInit () 

00693             CType ( Me . udTapizY , System . ComponentModel . ISupportInitialize ) . EndInit () 

00694             Me . TabPage3 . ResumeLayout ( False ) 

00695             Me . GroupBox2 . ResumeLayout ( False ) 

00696             Me . GroupBox1 . ResumeLayout ( False ) 

00697             CType ( Me . udTrazoArco , System . ComponentModel . ISupportInitialize ) . EndInit ( 

       »               ) 

00698             Me . TabPage2 . ResumeLayout ( False ) 

00699             Me . GroupBox4 . ResumeLayout ( False ) 

00700             Me . GroupBox3 . ResumeLayout ( False ) 

00701             CType ( Me . udRadioNodo , System . ComponentModel . ISupportInitialize ) . EndInit ( 

       »               ) 

00702             CType ( Me . udTrazoNodo , System . ComponentModel . ISupportInitialize ) . EndInit ( 

       »               ) 

00703             Me . TabPage4 . ResumeLayout ( False ) 

00704             Me . GroupBox6 . ResumeLayout ( False ) 

00705             CType ( Me . udRejilla , System . ComponentModel . ISupportInitialize ) . EndInit () 

00706             Me . TabPage5 . ResumeLayout ( False ) 

00707             Me . ResumeLayout ( False ) 

00708      

00709         End Sub 

00710      

00711      

00712      

00713      

00714     # End Region 

00715      

00716         Public Event ActualizaGrafo ( ByVal valor As Boolean ) 

00717         Public Event ActualizaMenu () 

00718      



00719         Sub DibujaArcoPrueba () 

00720      

00721      

00722             pbArco . Width = 250 

00723             pbArco . Height = 100 

00724      

00725      

00726             'Crea un objeto Graphics  

00727             Dim G As Graphics 

00728             'toma el objeto graphics  

00729             G = TomaObjetoGraphics ( pbArco ) 

00730      

00731             'borra el objeto graphics  

00732             G . Clear ( Color . White ) 

00733      

00734      

00735             'definiciones  

00736             Dim p As Pen 'pluma  

00737             Dim brocha As System . Drawing . SolidBrush 

00738      

00739             Dim b As Rectangle 

00740             Dim i As Long 'contador  

00741      

00742             Dim x , y As Single 

00743             Dim x2 , y2 As Single 

00744             Dim radio As Single 

00745             Dim t As String 'para texto  

00746             Dim v As Single 'para valor  

00747      

00748             Dim tamañotexto As SizeF 

00749      

00750             Dim LV As Single 

00751             Dim Xa As Single , Ya As Single 

00752             Dim Xb As Single , Yb As Single 

00753      

00754      

00755             Dim fuente As Font 

00756      

00757      

00758             'Cambia escala del tipo de letra  

00759             fuente = New Font ( lblFuente . Font . Name , lblFuente . Font . Size , lblFuente .  

       »               Font . Style , GraphicsUnit . Pixel ) 

00760      

00761      

00762      

00763             '----------------------------  

00764             'Dibuja la colección de Arcos  

00765             '----------------------------  

00766      

00767             'define el trazo y su color  

00768             p = New Pen ( lblColorArco . BackColor , Me . udTrazoArco . Value ) 

00769             'toma datos del nodo 1  

00770             x = 10 

00771             y = 50 

00772      

00773             'toma datos del nodo 2  

00774             x2 = 240 

00775             y2 = 50 

00776      

00777             'línea principal de centro a centro  

00778             '------------------------------------  

00779             G . DrawLine ( p , x , y , x2 , y2 ) 

00780      

00781      



00782             'pone texto etiqueta en la mitad del arco  

00783             '-----------------------------------------  

00784      

00785             If chkminArco . Checked Or chkmaxArco . Checked Or chkcostArco . Checked Then 

00786                 t = "(" 

00787      

00788                 If chkminArco . Checked = True Then 

00789                     t = t & 0 

00790                 End If 

00791                 If chkmaxArco . Checked = True Then 

00792                     If chkminArco . Checked Then t = t & "; " 

00793                     t = t & 10 

00794                 End If 

00795      

00796                 If chkcostArco . Checked = True Then 

00797                     If chkmaxArco . Checked Or chkminArco . Checked Then t = t & "; " 

00798                     t = t & 5 

00799                 End If 

00800      

00801                 t = t & ")" 

00802      

00803             End If 

00804      

00805      

00806      

00807      

00808             tamañotexto = G . MeasureString ( t , fuente ) 

00809             'rectangulo blanco debajo para que el texto se lea más claro  

00810             b = New Rectangle ( x + 0.7 * ( x2 - x ) - tamañotexto . Width / 2 , y + 0.7  

       »               * ( y2 - y ) - tamañotexto . Height / 2 , tamañotexto . Width , tamañotexto .  

       »               Height ) 

00811             G . FillRectangle ( Brushes . White , b ) 

00812             'escribe el texto  

00813             G . DrawString ( t , fuente , Brushes . Black , x + 0.7 * ( x2 - x ) - tamañotexto  

       »               . Width / 2 , y + 0.7 * ( y2 - y ) - tamañotexto . Height / 2 ) 

00814      

00815             'punta de flecha destino  

00816             '-----------------------  

00817             'calcula vector unitario  

00818             LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

00819             If LV = 0 Then LV = 0.0000001 

00820             'vector unitario de tamaño radio del nodo destino  

00821             x = ( x2 - x ) / LV * 10 

00822             y = ( y2 - y ) / LV * 10 

00823      

00824             'punto de intersección de la línea principal con el círculo del nodo  

       »               destino  

00825             Xa = x2 '- x  

00826             Ya = y2 '- y  

00827      

00828             'segmento estribor de la punta de la flecha  

00829             Xb = Xa - x * Me . udTrazoArco . Value - y / 2 * Me . udTrazoArco . Value 

00830             Yb = Ya - y * Me . udTrazoArco . Value + x / 2 * Me . udTrazoArco . Value 

00831             G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

00832             'segmento babor de la punta de la flecha  

00833             Xb = Xa - x * Me . udTrazoArco . Value + y / 2 * Me . udTrazoArco . Value 

00834             Yb = Ya - y * Me . udTrazoArco . Value - x / 2 * Me . udTrazoArco . Value 

00835             G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

00836      

00837             'Caso de arco bidireccional  

00838             'con dos puntas de flecha  

00839             If Me . chkBArco . Checked = True Then 

00840                 'punta de flecha origen  

00841                 '-----------------------  

00842                 'toma los nodos al revés y ya está!  

00843                 'toma datos del nodo 1  

00844                 x = 240 

00845                 y = 50 

00846                 'toma datos del nodo 2  

00847                 x2 = 10 

00848                 y2 = 50 

00849      

00850                 'calcula vector unitario  

00851                 LV = Math . Sqrt ((( x2 - x )) ^ 2 + (( y2 - y )) ^ 2 ) 

00852                 If LV = 0 Then LV = 0.0000001 

00853                 'vector unitario de tamaño radio del nodo destino  

00854                 x = ( x2 - x ) / LV * 10 

00855                 y = ( y2 - y ) / LV * 10 

00856      

00857                 'punto de intersección de la línea principal con el círculo del  

       »                   nodo destino  

00858                 Xa = x2 '- x  

00859                 Ya = y2 '- y  

00860      

00861                 'segmento estribor de la punta de la flecha  

00862                 Xb = Xa - x * Me . udTrazoArco . Value - y / 2 * Me . udTrazoArco . Value 

00863                 Yb = Ya - y * Me . udTrazoArco . Value + x / 2 * Me . udTrazoArco . Value 

00864                 G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

00865                 'segmento babor de la punta de la flecha  

00866                 Xb = Xa - x * Me . udTrazoArco . Value + y / 2 * Me . udTrazoArco . Value 

00867                 Yb = Ya - y * Me . udTrazoArco . Value - x / 2 * Me . udTrazoArco . Value 

00868                 G . DrawLine ( p , Xb , Yb , Xa , Ya ) 

00869      

00870      

00871             End If 

00872      

00873      

00874         End Sub 

00875      

00876         Private Sub Button3_Click ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) 

00877             DibujaArcoPrueba () 

00878         End Sub 

00879      

00880         Private Sub btnColorArco_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnColorArco . Click 

00881             lblColorArco . BackColor = DialogoColor ( lblColorArco . BackColor ) 

00882             DibujaArcoPrueba () 

00883         End Sub 

00884      

00885      

00886      

00887         Private Sub btnColorNodo_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnColorNodo . Click 

00888             lblColorNodo . BackColor = DialogoColor ( lblColorNodo . BackColor ) 

00889             DibujaNodoPrueba () 

00890         End Sub 

00891         Sub DibujaNodoPrueba () 

00892             pbNodo . Width = 120 

00893             pbNodo . Height = 120 

00894      

00895             'Crea un objeto Graphics  

00896             Dim G As Graphics 

00897             'toma el objeto graphics  

00898             G = TomaObjetoGraphics ( pbNodo ) 

00899      

00900             'borra el objeto graphics  

00901             G . Clear ( Color . White ) 

00902      

00903      

00904             'definiciones  

00905             Dim p As Pen 'pluma  

00906             Dim brocha As System . Drawing . SolidBrush 

00907      

00908             Dim b As Rectangle 

00909             Dim i As Long 'contador  

00910      

00911             Dim x , y As Single 

00912             Dim x2 , y2 As Single 

00913             Dim radio As Single 

00914             Dim t As String 'para texto  

00915             Dim v As Single 'para valor  

00916      

00917             Dim tamañotexto As SizeF 

00918      

00919             Dim LV As Single 

00920             Dim Xa As Single , Ya As Single 

00921             Dim Xb As Single , Yb As Single 

00922      

00923             Dim fuente As Font 

00924      

00925             'Cambia escala del tipo de letra  

00926             fuente = New Font ( lblFuente . Font . Name , lblFuente . Font . Size , lblFuente .  

       »               Font . Style , GraphicsUnit . Pixel ) 

00927      

00928      

00929             '----------------------------  

00930             'Dibuja la colección de Nodos  

00931             '----------------------------  

00932      

00933             'toma datos del nodo  

00934             x = 60 

00935             y = 60 

00936             radio = udRadioNodo . Value 

00937      

00938             'define el trazo y su color  

00939             p = New Pen ( Color . Black , udTrazoNodo . Value ) 

00940             'dibuja círculo del nodo  

00941             b = New Rectangle ( x - radio , y - radio , radio * 2 , radio * 2 ) 

00942             'rellena el círculo del nodo  

00943             brocha = New System . Drawing . SolidBrush ( lblColorNodo . BackColor ) 

00944      

00945             G . FillEllipse ( brocha , b ) 

00946      

00947             Dim condicion As Integer 

00948             If chktxtNodo . Checked = False Or chkcostNodo . Checked = False Then 

00949                 condicion = 0 

00950             Else 

00951                 condicion = 1 

00952             End If 

00953      



00954             If chktxtNodo . Checked And chkcostNodo . Checked Then 

00955                 'dibuja ecuador del nodo  

00956                 G . DrawLine ( p , x - radio , y , x + radio , y ) 

00957             End If 

00958             If chktxtNodo . Checked Then 

00959                 'pone texto etiqueta en la mitad superior  

00960                 t = "etiqueta" 

00961                 tamañotexto = G . MeasureString ( t , fuente ) 

00962                 G . DrawString ( t , fuente , Brushes . Black , x - tamañotexto . Width / 2 , y 

       »                   - tamañotexto . Height / 2 - radio / 2 * condicion ) 

00963             End If 

00964             If chkcostNodo . Checked Then 

00965                 'pone texto valor en la mitad inferior  

00966                 t = "100" 

00967                 tamañotexto = G . MeasureString ( t , fuente ) 

00968                 G . DrawString ( t , fuente , Brushes . Black , x - tamañotexto . Width / 2 , y 

       »                   - tamañotexto . Height / 2 + radio / 2 * condicion ) 

00969             End If 

00970             'dibuja el borde del nodo  

00971             G . DrawEllipse ( p , b ) 

00972      

00973         End Sub 

00974         Private Sub Button2_Click ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) 

00975             DibujaNodoPrueba () 

00976         End Sub 

00977      

00978         Sub ModificaOpciones () 

00979             'Modifica en las variables globales los valores de las opciones  

00980      

00981             Form1 . Grafico . Rejilla = Me . udRejilla . Value 

00982             Form1 . Grafico . MostrarRejilla = Me . chkMostrarRejilla . Checked 

00983             Form1 . Grafico . Iman = Me . chkIman . Checked 

00984             Form1 . Grafico . Zoom = Me . udZoom . Value 

00985             Form1 . Grafico . TapizX = Me . udTapizX . Value 

00986             Form1 . Grafico . TapizY = Me . udTapizY . Value 

00987      

00988             Form1 . Grafico . ColorRejilla = Me . lblColorRejilla . BackColor 

00989             Form1 . Grafico . ColorTapiz = Me . lblColorTapiz . BackColor 

00990      

00991             Form1 . Grafico . MostrarImagenTapiz = Me . chkTapizImagen . Checked 

00992      

00993             'Toma valores actuales para los nodos  

00994      

00995             Form1 . Grafico . Fuente = Me . lblFuente . Font 

00996             Form1 . Grafico . textoNodo = Me . chktxtNodo . Checked 

00997             Form1 . Grafico . costNodo = Me . chkcostNodo . Checked 

00998             Form1 . Grafico . RadioNodo = Me . udRadioNodo . Value 

00999             Form1 . Grafico . TrazoNodo = Me . udTrazoNodo . Value 

01000             Form1 . Grafico . ColNodo = Me . lblColorNodo . BackColor 

01001      

01002             'Toma valores actuales para los nodos  

01003             Form1 . Grafico . minArco = Me . chkminArco . Checked 

01004             Form1 . Grafico . maxArco = Me . chkmaxArco . Checked 

01005             Form1 . Grafico . costArco = Me . chkcostArco . Checked 

01006             Form1 . Grafico . TrazoArco = Me . udTrazoArco . Value 

01007             Form1 . Grafico . ColArco = Me . lblColorArco . BackColor 

01008             Form1 . Grafico . BArco = Me . chkBArco . Checked 

01009      

01010      

01011         End Sub 

01012      



01013         Private Sub Form2_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

01014             LeeOpciones () 

01015      

01016             'dibuja estado actual de ejemplo  

01017             DibujaArcoPrueba () 

01018             DibujaNodoPrueba () 

01019      

01020         End Sub 

01021         Public Sub LeeOpciones () 

01022             Me . udZoom . Value = Form1 . Grafico . Zoom 

01023             Me . udRejilla . Value = Form1 . Grafico . Rejilla 

01024             Me . chkMostrarRejilla . Checked = Form1 . Grafico . MostrarRejilla 

01025             Me . chkIman . Checked = Form1 . Grafico . Iman 

01026      

01027             Me . udTapizX . Value = Form1 . Grafico . TapizX 

01028             Me . udTapizY . Value = Form1 . Grafico . TapizY 

01029      

01030             Me . lblColorRejilla . BackColor = Form1 . Grafico . ColorRejilla 

01031             Me . lblColorTapiz . BackColor = Form1 . Grafico . ColorTapiz 

01032      

01033             Me . chkTapizImagen . Checked = Form1 . Grafico . MostrarImagenTapiz 

01034             If Me . chkTapizImagen . Checked = True Then 

01035                 If Form1 . Grafico . ImagenTapiz <> "" Then 

01036                     Dim img As Image 

01037                     img = Image . FromFile ( Form1 . Grafico . ImagenTapiz ) 

01038                     lblColorTapiz . Image = img . GetThumbnailImage ( lblColorTapiz . Width  

       »                       , lblColorTapiz . Height , Nothing , Nothing ) 

01039                 End If 

01040             Else 

01041                 Me . lblColorTapiz . Image = Nothing 

01042             End If 

01043      

01044             'Toma valores actuales para los nodos  

01045      

01046             Me . lblFuente . Font = Form1 . Grafico . Fuente 

01047             Me . chktxtNodo . Checked = Form1 . Grafico . textoNodo 

01048             Me . chkcostNodo . Checked = Form1 . Grafico . costNodo 

01049             Me . udRadioNodo . Value = Form1 . Grafico . RadioNodo 

01050             Me . udTrazoNodo . Value = Form1 . Grafico . TrazoNodo 

01051             Me . lblColorNodo . BackColor = Form1 . Grafico . ColNodo 

01052      

01053             'Toma valores actuales para los nodos  

01054             Me . chkminArco . Checked = Form1 . Grafico . minArco 

01055             Me . chkmaxArco . Checked = Form1 . Grafico . maxArco 

01056             Me . chkcostArco . Checked = Form1 . Grafico . costArco 

01057             Me . udTrazoArco . Value = Form1 . Grafico . TrazoArco 

01058             Me . lblColorArco . BackColor = Form1 . Grafico . ColArco 

01059             Me . chkBArco . Checked = Form1 . Grafico . BArco 

01060      

01061         End Sub 

01062         Private Sub btnAplicar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnAplicar . Click 

01063             'Pide confirmación al usuario antes de aplicar  

01064             'las nuevas opciones a todo el gráfico  

01065             Dim respuesta As MsgBoxResult 

01066             respuesta = MsgBox ( "¿Desea aplicar los cambios a todo su gráfico?" ,  

       »               MsgBoxStyle . OKCancel , ) 

01067             If respuesta = MsgBoxResult . OK Then 

01068      

01069                 'Modifica para todos los nodos y arcos  

01070                 ModificaOpciones () 

01071      

01072                 Dim i As Long 

01073                 For i = 0 To Form1 . TotalNodos - 1 

01074                     Form1 . Nodos ( i ) . Col = Form1 . Grafico . ColNodo 

01075                     Form1 . Nodos ( i ) . Radio = Form1 . Grafico . RadioNodo 

01076                     Form1 . Nodos ( i ) . Grosor = Form1 . Grafico . TrazoNodo 

01077                 Next i 

01078                 For i = 0 To Form1 . TotalArcos - 1 

01079                     Form1 . Arcos ( i ) . Col = Form1 . Grafico . ColArco 

01080                     Form1 . Arcos ( i ) . B = Form1 . Grafico . BArco 

01081                     Form1 . Arcos ( i ) . Grosor = Form1 . Grafico . TrazoArco 

01082                 Next i 

01083      

01084                 RaiseEvent ActualizaGrafo ( True ) 

01085      

01086             End If 

01087         End Sub 

01088      

01089         Private Sub btnAplicarNuevos_Click ( ByVal sender As System . Object , ByVal e As 

       »           System . EventArgs ) Handles btnAplicarNuevos . Click 

01090             'Aplica los valores actuales para los nuevos nodos y arcos generados  

01091             'Modifica para los nuevos nodos y arcos generados  

01092             ModificaOpciones () 

01093      

01094         End Sub 

01095      

01096      

01097      

01098         Private Sub udTrazoNodo_ValueChanged ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles udTrazoNodo . ValueChanged 

01099             DibujaNodoPrueba () 

01100         End Sub 

01101      

01102         Private Sub udRadioNodo_ValueChanged ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles udRadioNodo . ValueChanged 

01103             DibujaNodoPrueba () 

01104         End Sub 

01105      

01106      

01107      

01108         Private Sub udTrazoArco_ValueChanged ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles udTrazoArco . ValueChanged 

01109             DibujaArcoPrueba () 

01110         End Sub 

01111      

01112         Private Sub chkBArco_CheckedChanged ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles chkBArco . CheckedChanged 

01113             DibujaArcoPrueba () 

01114         End Sub 

01115      

01116         Public Sub btnRestaurar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnRestaurar . Click 

01117             'cambia todas las opciones a los valores por defecto  

01118             Form1 . OpcionesporDefecto () 

01119             LeeOpciones () 

01120      

01121             'dibuja estado actual de ejemplo  

01122             DibujaArcoPrueba () 

01123             DibujaNodoPrueba () 

01124         End Sub 

01125      

01126      

01127         Private Sub btnColorTapiz_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnColorTapiz . Click 

01128             lblColorTapiz . BackColor = DialogoColor ( lblColorTapiz . BackColor ) 

01129         End Sub 

01130      

01131         Protected Overrides Sub Finalize () 

01132             MyBase . Finalize () 

01133         End Sub 

01134      

01135         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

01136             Me . Visible = False 

01137             RaiseEvent ActualizaMenu () 

01138         End Sub 

01139      

01140         Private Sub chkMostrarRejilla_CheckedChanged ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles chkMostrarRejilla . CheckedChanged 

01141             Form1 . Grafico . MostrarRejilla = chkMostrarRejilla . Checked 

01142             RaiseEvent ActualizaMenu () 

01143         End Sub 

01144      

01145         Private Sub chkIman_CheckedChanged ( ByVal sender As Object , ByVal e As System  

       »           . EventArgs ) Handles chkIman . CheckedChanged 

01146             Form1 . Grafico . Iman = chkIman . Checked 

01147             RaiseEvent ActualizaMenu () 

01148         End Sub 

01149      

01150      

01151         Private Sub btnFuente_Click ( ByVal sender As System . Object , ByVal e As System  

       »           . EventArgs ) Handles btnFuente . Click 

01152             FontDialog1 . ShowColor = False 

01153             FontDialog1 . Font = lblFuente . Font 

01154             If FontDialog1 . ShowDialog () <> DialogResult . Cancel Then 

01155                 lblFuente . Font = FontDialog1 . Font 

01156                 DibujaNodoPrueba () 

01157                 DibujaArcoPrueba () 

01158             End If 

01159         End Sub 

01160      

01161         Private Sub chktxtNodo_CheckedChanged ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles chktxtNodo . CheckedChanged 

01162             DibujaNodoPrueba () 

01163         End Sub 

01164      

01165         Private Sub chkcostNodo_CheckedChanged ( ByVal sender As System . Object , ByVal  

       »           e As System . EventArgs ) Handles chkcostNodo . CheckedChanged 

01166             DibujaNodoPrueba () 

01167         End Sub 

01168      

01169         Private Sub chkminArco_CheckedChanged ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles chkminArco . CheckedChanged 

01170             DibujaArcoPrueba () 

01171         End Sub 

01172      

01173         Private Sub chkmaxArco_CheckedChanged ( ByVal sender As System . Object , ByVal e 

       »           As System . EventArgs ) Handles chkmaxArco . CheckedChanged 

01174             DibujaArcoPrueba () 

01175         End Sub 

01176      

01177         Private Sub chkcostArco_CheckedChanged ( ByVal sender As System . Object , ByVal  

       »           e As System . EventArgs ) Handles chkcostArco . CheckedChanged 

01178             DibujaArcoPrueba () 

01179         End Sub 

01180      

01181         Private Sub btnColorRejilla_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnColorRejilla . Click 

01182             lblColorRejilla . BackColor = DialogoColor ( lblColorRejilla . BackColor ) 

01183         End Sub 

01184      

01185      

01186         Private Sub btnImagenTapiz_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnImagenTapiz . Click 

01187             'Carga imagen desde archivo para el fondo del tapiz  

01188      

01189             Dim openFileDialog1 As New OpenFileDialog 

01190             openFileDialog1 . AddExtension = True 

01191             openFileDialog1 . DefaultExt = ".gif" 'en caso de no especificar, se toma  

       »               gif por defecto  

01192             openFileDialog1 . Filter = "Graphics Interchange Format  

       »               (*.gif)|*.gif|Bitmap Image (*.bmp)|*.bmp|Portable Network Graphics  

       »               format (*.png)|*.png|Windows MetaFile format  

       »               (*.wmf)|*.wmf|MetaArchivo mejorado (*.emf)|*.emf|Tagged Image File  

       »               Format (*.tif)|*.tif|JPEG (*.jpg)|*.jpg" 

01193             openFileDialog1 . FilterIndex = 1 'formato por defecto .gif  

01194             openFileDialog1 . Title = "Abrir Imagen para el fondo del tapiz" 

01195             openFileDialog1 . RestoreDirectory = True 

01196      

01197             If openFileDialog1 . ShowDialog () = DialogResult . OK Then 

01198                 Dim img As Image 

01199                 img = Image . FromFile ( openFileDialog1 . FileName ) 

01200                 lblColorTapiz . Image = img . GetThumbnailImage ( lblColorTapiz . Width ,  

       »                   lblColorTapiz . Height , Nothing , Nothing ) 

01201                 Form1 . Grafico . ImagenTapiz = openFileDialog1 . FileName 

01202                 Form1 . Grafico . MostrarImagenTapiz = True 

01203             Else 

01204                 Exit Sub 

01205             End If 

01206      

01207         End Sub 

01208      

01209         Private Sub chkTapizImagen_CheckedChanged ( ByVal sender As System . Object ,  

       »           ByVal e As System . EventArgs ) Handles chkTapizImagen . CheckedChanged 

01210             If chkTapizImagen . Checked = True Then 

01211                 Form1 . Grafico . MostrarImagenTapiz = True 

01212                 Me . btnImagenTapiz . Enabled = True 

01213                 If Form1 . Grafico . ImagenTapiz <> "" Then 

01214                     Dim img As Image 

01215                     img = Image . FromFile ( Form1 . Grafico . ImagenTapiz ) 

01216                     lblColorTapiz . Image = img . GetThumbnailImage ( lblColorTapiz . Width  

       »                       , lblColorTapiz . Height , Nothing , Nothing ) 

01217                 End If 

01218             Else 

01219                 Form1 . Grafico . MostrarImagenTapiz = False 

01220                 Me . btnImagenTapiz . Enabled = False 

01221                 Me . lblColorTapiz . Image = Nothing 

01222             End If 

01223         End Sub 

01224     End Class 

00001     Public Class Form3 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents Label1 As System . Windows . Forms . Label 

00033         Friend WithEvents Label2 As System . Windows . Forms . Label 

00034         Friend WithEvents txtEtiquetaNodo As System . Windows . Forms . TextBox 

00035         Friend WithEvents txtCosteNodo As System . Windows . Forms . TextBox 

00036         Friend WithEvents btnAceptar As System . Windows . Forms . Button 

00037         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00038         Friend WithEvents lblXYNodo As System . Windows . Forms . Label 

00039         Friend WithEvents GroupBox4 As System . Windows . Forms . GroupBox 

00040         Friend WithEvents Label4 As System . Windows . Forms . Label 

00041         Friend WithEvents udRadioNodo As System . Windows . Forms . NumericUpDown 

00042         Friend WithEvents udTrazoNodo As System . Windows . Forms . NumericUpDown 

00043         Friend WithEvents Label3 As System . Windows . Forms . Label 

00044         Friend WithEvents lblColorNodo As System . Windows . Forms . Label 

00045         Friend WithEvents btnColorNodo As System . Windows . Forms . Button 

00046         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00047             Me . Label1 = New System . Windows . Forms . Label 

00048             Me . Label2 = New System . Windows . Forms . Label 

00049             Me . txtEtiquetaNodo = New System . Windows . Forms . TextBox 

00050             Me . txtCosteNodo = New System . Windows . Forms . TextBox 

00051             Me . btnAceptar = New System . Windows . Forms . Button 

00052             Me . btnCancelar = New System . Windows . Forms . Button 

00053             Me . lblXYNodo = New System . Windows . Forms . Label 

00054             Me . GroupBox4 = New System . Windows . Forms . GroupBox 

00055             Me . Label4 = New System . Windows . Forms . Label 

00056             Me . udRadioNodo = New System . Windows . Forms . NumericUpDown 

00057             Me . udTrazoNodo = New System . Windows . Forms . NumericUpDown 

00058             Me . Label3 = New System . Windows . Forms . Label 

00059             Me . lblColorNodo = New System . Windows . Forms . Label 

00060             Me . btnColorNodo = New System . Windows . Forms . Button 

00061             Me . GroupBox4 . SuspendLayout () 

00062             CType ( Me . udRadioNodo , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00063             CType ( Me . udTrazoNodo , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00064             Me . SuspendLayout () 

00065             '  

00066             'Label1  

00067             '  

00068             Me . Label1 . Location = New System . Drawing . Point ( 8 , 8 ) 

00069             Me . Label1 . Name = "Label1" 

00070             Me . Label1 . Size = New System . Drawing . Size ( 72 , 24 ) 

00071             Me . Label1 . TabIndex = 0 

00072             Me . Label1 . Text = "Etiqueta:" 

00073             '  

00074             'Label2  

00075             '  

00076             Me . Label2 . Location = New System . Drawing . Point ( 152 , 8 ) 

00077             Me . Label2 . Name = "Label2" 

00078             Me . Label2 . Size = New System . Drawing . Size ( 64 , 24 ) 

00079             Me . Label2 . TabIndex = 1 

00080             Me . Label2 . Text = "Valor:" 

00081             '  

00082             'txtEtiquetaNodo  

00083             '  

00084             Me . txtEtiquetaNodo . Location = New System . Drawing . Point ( 8 , 24 ) 

00085             Me . txtEtiquetaNodo . Name = "txtEtiquetaNodo" 

00086             Me . txtEtiquetaNodo . Size = New System . Drawing . Size ( 104 , 20 ) 

00087             Me . txtEtiquetaNodo . TabIndex = 2 

00088             Me . txtEtiquetaNodo . Text = "" 

00089             '  

00090             'txtCosteNodo  

00091             '  

00092             Me . txtCosteNodo . Location = New System . Drawing . Point ( 152 , 24 ) 

00093             Me . txtCosteNodo . Name = "txtCosteNodo" 

00094             Me . txtCosteNodo . Size = New System . Drawing . Size ( 104 , 20 ) 

00095             Me . txtCosteNodo . TabIndex = 3 

00096             Me . txtCosteNodo . Text = "" 

00097             '  

00098             'btnAceptar  

00099             '  

00100             Me . btnAceptar . Location = New System . Drawing . Point ( 176 , 176 ) 

00101             Me . btnAceptar . Name = "btnAceptar" 

00102             Me . btnAceptar . Size = New System . Drawing . Size ( 80 , 24 ) 

00103             Me . btnAceptar . TabIndex = 4 

00104             Me . btnAceptar . Text = "Aceptar" 

00105             '  

00106             'btnCancelar  

00107             '  

00108             Me . btnCancelar . Location = New System . Drawing . Point ( 8 , 176 ) 

00109             Me . btnCancelar . Name = "btnCancelar" 

00110             Me . btnCancelar . Size = New System . Drawing . Size ( 80 , 24 ) 

00111             Me . btnCancelar . TabIndex = 5 

00112             Me . btnCancelar . Text = "Cancelar" 

00113             '  

00114             'lblXYNodo  

00115             '  

00116             Me . lblXYNodo . BorderStyle = System . Windows . Forms . BorderStyle . Fixed3D 

00117             Me . lblXYNodo . Location = New System . Drawing . Point ( 8 , 56 ) 

00118             Me . lblXYNodo . Name = "lblXYNodo" 

00119             Me . lblXYNodo . Size = New System . Drawing . Size ( 248 , 24 ) 

00120             Me . lblXYNodo . TabIndex = 6 

00121             Me . lblXYNodo . Text = "..." 

00122             '  

00123             'GroupBox4  

00124             '  

00125             Me . GroupBox4 . Controls . Add ( Me . Label4 ) 

00126             Me . GroupBox4 . Controls . Add ( Me . udRadioNodo ) 

00127             Me . GroupBox4 . Controls . Add ( Me . udTrazoNodo ) 

00128             Me . GroupBox4 . Controls . Add ( Me . Label3 ) 

00129             Me . GroupBox4 . Controls . Add ( Me . lblColorNodo ) 

00130             Me . GroupBox4 . Controls . Add ( Me . btnColorNodo ) 

00131             Me . GroupBox4 . Location = New System . Drawing . Point ( 8 , 88 ) 

00132             Me . GroupBox4 . Name = "GroupBox4" 

00133             Me . GroupBox4 . Size = New System . Drawing . Size ( 248 , 80 ) 

00134             Me . GroupBox4 . TabIndex = 17 

00135             Me . GroupBox4 . TabStop = False 

00136             '  

00137             'Label4  

00138             '  

00139             Me . Label4 . Location = New System . Drawing . Point ( 8 , 48 ) 

00140             Me . Label4 . Name = "Label4" 

00141             Me . Label4 . Size = New System . Drawing . Size ( 48 , 16 ) 

00142             Me . Label4 . TabIndex = 10 

00143             Me . Label4 . Text = "Radio: " 

00144             Me . Label4 . TextAlign = System . Drawing . ContentAlignment . MiddleCenter 

00145             '  

00146             'udRadioNodo  

00147             '  

00148             Me . udRadioNodo . Location = New System . Drawing . Point ( 56 , 48 ) 

00149             Me . udRadioNodo . Maximum = New Decimal ( New Integer () { 50 , 0 , 0 , 0 }) 

00150             Me . udRadioNodo . Minimum = New Decimal ( New Integer () { 15 , 0 , 0 , 0 }) 

00151             Me . udRadioNodo . Name = "udRadioNodo" 

00152             Me . udRadioNodo . Size = New System . Drawing . Size ( 48 , 20 ) 

00153             Me . udRadioNodo . TabIndex = 9 

00154             Me . udRadioNodo . Value = New Decimal ( New Integer () { 15 , 0 , 0 , 0 }) 

00155             '  

00156             'udTrazoNodo  

00157             '  

00158             Me . udTrazoNodo . Location = New System . Drawing . Point ( 56 , 16 ) 

00159             Me . udTrazoNodo . Maximum = New Decimal ( New Integer () { 5 , 0 , 0 , 0 }) 

00160             Me . udTrazoNodo . Minimum = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00161             Me . udTrazoNodo . Name = "udTrazoNodo" 

00162             Me . udTrazoNodo . Size = New System . Drawing . Size ( 48 , 20 ) 

00163             Me . udTrazoNodo . TabIndex = 3 

00164             Me . udTrazoNodo . Value = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00165             '  

00166             'Label3  

00167             '  

00168             Me . Label3 . Location = New System . Drawing . Point ( 8 , 16 ) 

00169             Me . Label3 . Name = "Label3" 

00170             Me . Label3 . Size = New System . Drawing . Size ( 48 , 24 ) 

00171             Me . Label3 . TabIndex = 8 

00172             Me . Label3 . Text = "Trazo: " 

00173             Me . Label3 . TextAlign = System . Drawing . ContentAlignment . MiddleCenter 

00174             '  

00175             'lblColorNodo  

00176             '  

00177             Me . lblColorNodo . BackColor = System . Drawing . Color . LightSteelBlue 

00178             Me . lblColorNodo . BorderStyle = System . Windows . Forms . BorderStyle .  

       »               FixedSingle 

00179             Me . lblColorNodo . Location = New System . Drawing . Point ( 128 , 16 ) 

00180             Me . lblColorNodo . Name = "lblColorNodo" 

00181             Me . lblColorNodo . Size = New System . Drawing . Size ( 24 , 24 ) 

00182             Me . lblColorNodo . TabIndex = 17 

00183             '  

00184             'btnColorNodo  

00185             '  

00186             Me . btnColorNodo . Location = New System . Drawing . Point ( 160 , 16 ) 

00187             Me . btnColorNodo . Name = "btnColorNodo" 

00188             Me . btnColorNodo . Size = New System . Drawing . Size ( 80 , 24 ) 

00189             Me . btnColorNodo . TabIndex = 13 

00190             Me . btnColorNodo . Text = "Color ..." 

00191             '  

00192             'Form3  

00193             '  

00194             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00195             Me . ClientSize = New System . Drawing . Size ( 266 , 207 ) 

00196             Me . Controls . Add ( Me . GroupBox4 ) 

00197             Me . Controls . Add ( Me . lblXYNodo ) 

00198             Me . Controls . Add ( Me . btnCancelar ) 

00199             Me . Controls . Add ( Me . btnAceptar ) 

00200             Me . Controls . Add ( Me . txtCosteNodo ) 

00201             Me . Controls . Add ( Me . txtEtiquetaNodo ) 

00202             Me . Controls . Add ( Me . Label2 ) 

00203             Me . Controls . Add ( Me . Label1 ) 

00204             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00205             Me . MaximizeBox = False 

00206             Me . MinimizeBox = False 

00207             Me . Name = "Form3" 

00208             Me . Text = "Grafos - Editar Nodo" 

00209             Me . TopMost = True 

00210             Me . GroupBox4 . ResumeLayout ( False ) 

00211             CType ( Me . udRadioNodo , System . ComponentModel . ISupportInitialize ) . EndInit ( 

       »               ) 

00212             CType ( Me . udTrazoNodo , System . ComponentModel . ISupportInitialize ) . EndInit ( 

       »               ) 

00213             Me . ResumeLayout ( False ) 

00214      

00215         End Sub 

00216      

00217     # End Region 

00218      

00219      

00220         Private Sub btnColorNodo_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnColorNodo . Click 

00221             lblColorNodo . BackColor = DialogoColor ( lblColorNodo . BackColor ) 

00222         End Sub 

00223      



00224         Private Sub Form3_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

00225             'Toma los valores del nodo a editar  

00226             txtEtiquetaNodo . Text = Form1 . Nodos ( Form1 . Nd2S ) . Texto 

00227             txtCosteNodo . Text = Form1 . Nodos ( Form1 . Nd2S ) . Valor 

00228             lblXYNodo . Text = " X = " & Format ( Form1 . Nodos ( Form1 . Nd2S ) . X ,  

       »               "####.###" ) & " Y = " & Format ( Form1 . Nodos ( Form1 . Nd2S ) . Y ,  

       »               "####.###" ) 

00229             lblColorNodo . BackColor = Form1 . Nodos ( Form1 . Nd2S ) . Col 

00230             udRadioNodo . Value = Form1 . Nodos ( Form1 . Nd2S ) . Radio 

00231             udTrazoNodo . Value = Form1 . Nodos ( Form1 . Nd2S ) . Grosor 

00232      

00233         End Sub 

00234      

00235         Private Sub btnAceptar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnAceptar . Click 

00236             'Cambia los valores del nodo según los editados  

00237             Form1 . Nodos ( Form1 . Nd2S ) . Texto = txtEtiquetaNodo . Text 

00238             Form1 . Nodos ( Form1 . Nd2S ) . Valor = CSng ( txtCosteNodo . Text ) 

00239             'lblXYNodo.Text = "X = " & Form1.Nodos(Form1.Nd2S).X & ", Y = " &  

       »               Form1.Nodos(Form1.Nd2S).Y  

00240             Form1 . Nodos ( Form1 . Nd2S ) . Col = lblColorNodo . BackColor 

00241             Form1 . Nodos ( Form1 . Nd2S ) . Radio = udRadioNodo . Value 

00242             Form1 . Nodos ( Form1 . Nd2S ) . Grosor = udTrazoNodo . Value 

00243             Me . DialogResult = DialogResult . OK 

00244      

00245         End Sub 

00246      

00247         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

00248             Me . DialogResult = DialogResult . Cancel 

00249             Me . Visible = False 

00250         End Sub 

00251      

00252         Private Sub txtCosteNodo_KeyPress ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . KeyPressEventArgs ) Handles txtCosteNodo . KeyPress 

00253             InterceptaTeclas ( e ) 

00254      

00255         End Sub 

00256      

00257         Private Sub txtCosteNodo_Leave ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles txtCosteNodo . Leave 

00258             FiltraTexto ( sender ) 

00259         End Sub 

00260      

00261      

00262     End Class 

00001     Public Class Form4 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents Label1 As System . Windows . Forms . Label 

00033         Friend WithEvents Label2 As System . Windows . Forms . Label 

00034         Friend WithEvents btnAceptar As System . Windows . Forms . Button 

00035         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00036         Friend WithEvents txtminArco As System . Windows . Forms . TextBox 

00037         Friend WithEvents txtcostArco As System . Windows . Forms . TextBox 

00038         Friend WithEvents lblArco As System . Windows . Forms . Label 

00039         Friend WithEvents GroupBox2 As System . Windows . Forms . GroupBox 

00040         Friend WithEvents udTrazoArco As System . Windows . Forms . NumericUpDown 

00041         Friend WithEvents Label3 As System . Windows . Forms . Label 

00042         Friend WithEvents chkBArco As System . Windows . Forms . CheckBox 

00043         Friend WithEvents btnColorArco As System . Windows . Forms . Button 

00044         Friend WithEvents lblColorArco As System . Windows . Forms . Label 

00045         Friend WithEvents txtmaxArco As System . Windows . Forms . TextBox 

00046         Friend WithEvents Label4 As System . Windows . Forms . Label 

00047         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00048             Me . Label1 = New System . Windows . Forms . Label 

00049             Me . Label2 = New System . Windows . Forms . Label 

00050             Me . txtminArco = New System . Windows . Forms . TextBox 

00051             Me . txtcostArco = New System . Windows . Forms . TextBox 

00052             Me . btnAceptar = New System . Windows . Forms . Button 

00053             Me . btnCancelar = New System . Windows . Forms . Button 

00054             Me . lblArco = New System . Windows . Forms . Label 

00055             Me . GroupBox2 = New System . Windows . Forms . GroupBox 

00056             Me . udTrazoArco = New System . Windows . Forms . NumericUpDown 

00057             Me . Label3 = New System . Windows . Forms . Label 

00058             Me . chkBArco = New System . Windows . Forms . CheckBox 

00059             Me . btnColorArco = New System . Windows . Forms . Button 

00060             Me . lblColorArco = New System . Windows . Forms . Label 

00061             Me . txtmaxArco = New System . Windows . Forms . TextBox 

00062             Me . Label4 = New System . Windows . Forms . Label 

00063             Me . GroupBox2 . SuspendLayout () 

00064             CType ( Me . udTrazoArco , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00065             Me . SuspendLayout () 

00066             '  

00067             'Label1  

00068             '  

00069             Me . Label1 . Location = New System . Drawing . Point ( 8 , 8 ) 

00070             Me . Label1 . Name = "Label1" 

00071             Me . Label1 . Size = New System . Drawing . Size ( 72 , 24 ) 

00072             Me . Label1 . TabIndex = 0 

00073             Me . Label1 . Text = "Mínimo:" 

00074             '  

00075             'Label2  

00076             '  

00077             Me . Label2 . Location = New System . Drawing . Point ( 80 , 48 ) 

00078             Me . Label2 . Name = "Label2" 

00079             Me . Label2 . Size = New System . Drawing . Size ( 64 , 24 ) 

00080             Me . Label2 . TabIndex = 1 

00081             Me . Label2 . Text = "Coste:" 

00082             '  

00083             'txtminArco  

00084             '  

00085             Me . txtminArco . Location = New System . Drawing . Point ( 8 , 24 ) 

00086             Me . txtminArco . Name = "txtminArco" 

00087             Me . txtminArco . Size = New System . Drawing . Size ( 104 , 20 ) 

00088             Me . txtminArco . TabIndex = 2 

00089             Me . txtminArco . Text = "" 

00090             '  

00091             'txtcostArco  

00092             '  

00093             Me . txtcostArco . Location = New System . Drawing . Point ( 80 , 64 ) 

00094             Me . txtcostArco . Name = "txtcostArco" 

00095             Me . txtcostArco . Size = New System . Drawing . Size ( 104 , 20 ) 

00096             Me . txtcostArco . TabIndex = 3 

00097             Me . txtcostArco . Text = "" 

00098             '  

00099             'btnAceptar  

00100             '  

00101             Me . btnAceptar . Location = New System . Drawing . Point ( 176 , 200 ) 

00102             Me . btnAceptar . Name = "btnAceptar" 

00103             Me . btnAceptar . Size = New System . Drawing . Size ( 80 , 24 ) 

00104             Me . btnAceptar . TabIndex = 4 

00105             Me . btnAceptar . Text = "Aceptar" 

00106             '  

00107             'btnCancelar  

00108             '  

00109             Me . btnCancelar . Location = New System . Drawing . Point ( 8 , 200 ) 

00110             Me . btnCancelar . Name = "btnCancelar" 

00111             Me . btnCancelar . Size = New System . Drawing . Size ( 80 , 24 ) 

00112             Me . btnCancelar . TabIndex = 5 

00113             Me . btnCancelar . Text = "Cancelar" 

00114             '  

00115             'lblArco  

00116             '  

00117             Me . lblArco . BorderStyle = System . Windows . Forms . BorderStyle . Fixed3D 

00118             Me . lblArco . Location = New System . Drawing . Point ( 8 , 96 ) 

00119             Me . lblArco . Name = "lblArco" 

00120             Me . lblArco . Size = New System . Drawing . Size ( 248 , 24 ) 

00121             Me . lblArco . TabIndex = 6 

00122             Me . lblArco . Text = "..." 

00123             '  

00124             'GroupBox2  

00125             '  

00126             Me . GroupBox2 . Controls . Add ( Me . udTrazoArco ) 

00127             Me . GroupBox2 . Controls . Add ( Me . Label3 ) 

00128             Me . GroupBox2 . Controls . Add ( Me . chkBArco ) 

00129             Me . GroupBox2 . Controls . Add ( Me . btnColorArco ) 

00130             Me . GroupBox2 . Controls . Add ( Me . lblColorArco ) 

00131             Me . GroupBox2 . Location = New System . Drawing . Point ( 8 , 120 ) 

00132             Me . GroupBox2 . Name = "GroupBox2" 

00133             Me . GroupBox2 . Size = New System . Drawing . Size ( 248 , 72 ) 

00134             Me . GroupBox2 . TabIndex = 11 

00135             Me . GroupBox2 . TabStop = False 

00136             '  

00137             'udTrazoArco  

00138             '  

00139             Me . udTrazoArco . Location = New System . Drawing . Point ( 56 , 16 ) 

00140             Me . udTrazoArco . Maximum = New Decimal ( New Integer () { 8 , 0 , 0 , 0 }) 

00141             Me . udTrazoArco . Minimum = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00142             Me . udTrazoArco . Name = "udTrazoArco" 

00143             Me . udTrazoArco . Size = New System . Drawing . Size ( 48 , 20 ) 

00144             Me . udTrazoArco . TabIndex = 3 

00145             Me . udTrazoArco . Value = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00146             '  

00147             'Label3  

00148             '  

00149             Me . Label3 . Location = New System . Drawing . Point ( 8 , 16 ) 

00150             Me . Label3 . Name = "Label3" 

00151             Me . Label3 . Size = New System . Drawing . Size ( 48 , 24 ) 

00152             Me . Label3 . TabIndex = 8 

00153             Me . Label3 . Text = "Trazo: " 

00154             Me . Label3 . TextAlign = System . Drawing . ContentAlignment . MiddleCenter 

00155             '  

00156             'chkBArco  

00157             '  

00158             Me . chkBArco . Location = New System . Drawing . Point ( 16 , 40 ) 

00159             Me . chkBArco . Name = "chkBArco" 

00160             Me . chkBArco . Size = New System . Drawing . Size ( 88 , 24 ) 

00161             Me . chkBArco . TabIndex = 5 

00162             Me . chkBArco . Text = "Bidireccional" 

00163             Me . chkBArco . Visible = False 

00164             '  

00165             'btnColorArco  

00166             '  

00167             Me . btnColorArco . Location = New System . Drawing . Point ( 160 , 16 ) 

00168             Me . btnColorArco . Name = "btnColorArco" 

00169             Me . btnColorArco . Size = New System . Drawing . Size ( 80 , 24 ) 

00170             Me . btnColorArco . TabIndex = 6 

00171             Me . btnColorArco . Text = "Color ..." 

00172             '  

00173             'lblColorArco  

00174             '  

00175             Me . lblColorArco . BackColor = System . Drawing . Color . Black 

00176             Me . lblColorArco . BorderStyle = System . Windows . Forms . BorderStyle .  

       »               FixedSingle 

00177             Me . lblColorArco . Location = New System . Drawing . Point ( 128 , 16 ) 

00178             Me . lblColorArco . Name = "lblColorArco" 

00179             Me . lblColorArco . Size = New System . Drawing . Size ( 24 , 24 ) 

00180             Me . lblColorArco . TabIndex = 11 

00181             '  

00182             'txtmaxArco  

00183             '  

00184             Me . txtmaxArco . Location = New System . Drawing . Point ( 152 , 24 ) 

00185             Me . txtmaxArco . Name = "txtmaxArco" 

00186             Me . txtmaxArco . Size = New System . Drawing . Size ( 104 , 20 ) 

00187             Me . txtmaxArco . TabIndex = 13 

00188             Me . txtmaxArco . Text = "" 

00189             '  

00190             'Label4  

00191             '  

00192             Me . Label4 . Location = New System . Drawing . Point ( 152 , 8 ) 

00193             Me . Label4 . Name = "Label4" 

00194             Me . Label4 . Size = New System . Drawing . Size ( 72 , 24 ) 

00195             Me . Label4 . TabIndex = 12 

00196             Me . Label4 . Text = "Máximo:" 

00197             '  

00198             'Form4  

00199             '  

00200             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00201             Me . ClientSize = New System . Drawing . Size ( 266 , 231 ) 

00202             Me . Controls . Add ( Me . txtmaxArco ) 

00203             Me . Controls . Add ( Me . Label4 ) 

00204             Me . Controls . Add ( Me . GroupBox2 ) 

00205             Me . Controls . Add ( Me . lblArco ) 

00206             Me . Controls . Add ( Me . btnCancelar ) 

00207             Me . Controls . Add ( Me . btnAceptar ) 

00208             Me . Controls . Add ( Me . txtcostArco ) 

00209             Me . Controls . Add ( Me . txtminArco ) 

00210             Me . Controls . Add ( Me . Label2 ) 

00211             Me . Controls . Add ( Me . Label1 ) 

00212             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00213             Me . MaximizeBox = False 

00214             Me . MinimizeBox = False 

00215             Me . Name = "Form4" 

00216             Me . Text = "Grafos - Editar Arco" 

00217             Me . TopMost = True 

00218             Me . GroupBox2 . ResumeLayout ( False ) 

00219             CType ( Me . udTrazoArco , System . ComponentModel . ISupportInitialize ) . EndInit ( 

       »               ) 

00220             Me . ResumeLayout ( False ) 

00221      

00222         End Sub 

00223      

00224     # End Region 

00225      

00226         Dim Narc As Long 

00227      

00228      

00229      



00230         Private Sub Form4_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

00231      

00232             Dim i As Long 

00233             For i = 0 To Form1 . TotalArcos - 1 

00234                 If Form1 . Arcos ( i ) . Nd1 = Form1 . Nd1S And Form1 . Arcos ( i ) . Nd2 = Form1 .  

       »                   Nd2S Then 

00235                     Narc = i 

00236                     Exit For 

00237      

00238                 End If 

00239             Next i 

00240      

00241      

00242             'Toma los valores del nodo a editar  

00243             txtminArco . Text = Form1 . Arcos ( Narc ) . Min 

00244             txtmaxArco . Text = Form1 . Arcos ( Narc ) . Max 

00245             txtcostArco . Text = Form1 . Arcos ( Narc ) . Coste 

00246      

00247             lblArco . Text = " Nd1 = " & Form1 . Nodos ( Form1 . Arcos ( Narc ) . Nd1 ) . Texto &  

       »               " Nd2 = " & Form1 . Nodos ( Form1 . Arcos ( Narc ) . Nd2 ) . Texto 

00248             lblColorArco . BackColor = Form1 . Arcos ( Narc ) . Col 

00249             chkBArco . Checked = Form1 . Arcos ( Narc ) . B 

00250             udTrazoArco . Value = Form1 . Arcos ( Narc ) . Grosor 

00251      

00252         End Sub 

00253      

00254         Private Sub btnAceptar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnAceptar . Click 

00255             'Cambia los valores del nodo según los editados  

00256             Form1 . Arcos ( Narc ) . Min = CSng ( txtminArco . Text ) 

00257             Form1 . Arcos ( Narc ) . Max = CSng ( txtmaxArco . Text ) 

00258             Form1 . Arcos ( Narc ) . Coste = CSng ( txtcostArco . Text ) 

00259      

00260             Form1 . Arcos ( Narc ) . Col = lblColorArco . BackColor 

00261             Form1 . Arcos ( Narc ) . B = chkBArco . Checked 

00262             Form1 . Arcos ( Narc ) . Grosor = udTrazoArco . Value 

00263      

00264      

00265             Me . DialogResult = DialogResult . OK 

00266      

00267      

00268         End Sub 

00269      

00270         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

00271             Me . DialogResult = DialogResult . Cancel 

00272             Me . Visible = False 

00273         End Sub 

00274      

00275         Private Sub btnColorArco_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnColorArco . Click 

00276             lblColorArco . BackColor = DialogoColor ( lblColorArco . BackColor ) 

00277         End Sub 

00278      

00279      

00280      



00281         Private Sub txtminArco_KeyPress ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . KeyPressEventArgs ) Handles txtminArco . KeyPress 

00282             InterceptaTeclas ( e ) 

00283      

00284         End Sub 

00285      

00286         Private Sub txtcostArco_KeyPress ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . KeyPressEventArgs ) Handles txtcostArco . KeyPress 

00287             InterceptaTeclas ( e ) 

00288      

00289         End Sub 

00290      

00291         Private Sub txtmaxArco_KeyPress ( ByVal sender As Object , ByVal e As System .  

       »           Windows . Forms . KeyPressEventArgs ) Handles txtmaxArco . KeyPress 

00292             InterceptaTeclas ( e ) 

00293      

00294         End Sub 

00295      

00296      

00297      

00298         Private Sub txtminArco_Leave ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles txtminArco . Leave 

00299             FiltraTexto ( sender ) 

00300         End Sub 

00301      

00302         Private Sub txtcostArco_Leave ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles txtcostArco . Leave 

00303             FiltraTexto ( sender ) 

00304         End Sub 

00305      

00306         Private Sub txtmaxArco_Leave ( ByVal sender As Object , ByVal e As System .  

       »           EventArgs ) Handles txtmaxArco . Leave 

00307             FiltraTexto ( sender ) 

00308         End Sub 

00309     End Class 

00001     Public Class Form5 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents btnAceptar As System . Windows . Forms . Button 

00033         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00034         Friend WithEvents Label1 As System . Windows . Forms . Label 

00035         Friend WithEvents GroupBox1 As System . Windows . Forms . GroupBox 

00036         Friend WithEvents udTotalNodos As System . Windows . Forms . NumericUpDown 

00037         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00038             Me . btnAceptar = New System . Windows . Forms . Button 

00039             Me . btnCancelar = New System . Windows . Forms . Button 

00040             Me . Label1 = New System . Windows . Forms . Label 

00041             Me . GroupBox1 = New System . Windows . Forms . GroupBox 

00042             Me . udTotalNodos = New System . Windows . Forms . NumericUpDown 

00043             Me . GroupBox1 . SuspendLayout () 

00044             CType ( Me . udTotalNodos , System . ComponentModel . ISupportInitialize ) .  

       »               BeginInit () 

00045             Me . SuspendLayout () 

00046             '  

00047             'btnAceptar  

00048             '  

00049             Me . btnAceptar . Location = New System . Drawing . Point ( 128 , 88 ) 

00050             Me . btnAceptar . Name = "btnAceptar" 

00051             Me . btnAceptar . Size = New System . Drawing . Size ( 80 , 24 ) 

00052             Me . btnAceptar . TabIndex = 0 

00053             Me . btnAceptar . Text = "Aceptar" 

00054             '  

00055             'btnCancelar  

00056             '  

00057             Me . btnCancelar . Location = New System . Drawing . Point ( 8 , 88 ) 

00058             Me . btnCancelar . Name = "btnCancelar" 

00059             Me . btnCancelar . Size = New System . Drawing . Size ( 80 , 24 ) 

00060             Me . btnCancelar . TabIndex = 0 

00061             Me . btnCancelar . Text = "Cancelar" 

00062             '  

00063             'Label1  

00064             '  

00065             Me . Label1 . ImageAlign = System . Drawing . ContentAlignment . MiddleRight 

00066             Me . Label1 . Location = New System . Drawing . Point ( 8 , 24 ) 

00067             Me . Label1 . Name = "Label1" 

00068             Me . Label1 . Size = New System . Drawing . Size ( 80 , 24 ) 

00069             Me . Label1 . TabIndex = 1 

00070             Me . Label1 . Text = "Total Nodos: " 

00071             Me . Label1 . TextAlign = System . Drawing . ContentAlignment . MiddleRight 

00072             '  

00073             'GroupBox1  

00074             '  

00075             Me . GroupBox1 . Controls . Add ( Me . udTotalNodos ) 

00076             Me . GroupBox1 . Controls . Add ( Me . Label1 ) 

00077             Me . GroupBox1 . Location = New System . Drawing . Point ( 8 , 0 ) 

00078             Me . GroupBox1 . Name = "GroupBox1" 

00079             Me . GroupBox1 . Size = New System . Drawing . Size ( 200 , 72 ) 

00080             Me . GroupBox1 . TabIndex = 2 

00081             Me . GroupBox1 . TabStop = False 

00082             '  

00083             'udTotalNodos  

00084             '  

00085             Me . udTotalNodos . Location = New System . Drawing . Point ( 104 , 24 ) 

00086             Me . udTotalNodos . Maximum = New Decimal ( New Integer () { 200 , 0 , 0 , 0 }) 

00087             Me . udTotalNodos . Minimum = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00088             Me . udTotalNodos . Name = "udTotalNodos" 

00089             Me . udTotalNodos . Size = New System . Drawing . Size ( 64 , 20 ) 

00090             Me . udTotalNodos . TabIndex = 2 

00091             Me . udTotalNodos . TextAlign = System . Windows . Forms . HorizontalAlignment .  

       »               Right 

00092             Me . udTotalNodos . Value = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00093             '  

00094             'Form5  

00095             '  

00096             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00097             Me . ClientSize = New System . Drawing . Size ( 218 , 119 ) 

00098             Me . Controls . Add ( Me . GroupBox1 ) 

00099             Me . Controls . Add ( Me . btnAceptar ) 

00100             Me . Controls . Add ( Me . btnCancelar ) 

00101             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00102             Me . MaximizeBox = False 

00103             Me . MinimizeBox = False 

00104             Me . Name = "Form5" 

00105             Me . Text = "Grafos - Total Nodos" 

00106             Me . TopMost = True 

00107             Me . GroupBox1 . ResumeLayout ( False ) 

00108             CType ( Me . udTotalNodos , System . ComponentModel . ISupportInitialize ) . EndInit  

       »               () 

00109             Me . ResumeLayout ( False ) 

00110      

00111         End Sub 

00112      

00113     # End Region 

00114      

00115         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

00116             'cierra el cuadro sin pena ni gloria  

00117             Me . DialogResult = DialogResult . Cancel 

00118             Me . Visible = False 

00119         End Sub 

00120      

00121         Private Sub btnAceptar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnAceptar . Click 

00122             'establece el nuevo valor de nodosmatriz  

00123             If udTotalNodos . Value > udTotalNodos . Maximum Then 

00124                 udTotalNodos . Value = udTotalNodos . Maximum 

00125             End If 

00126             Form1 . NuevoNodosMatriz = udTotalNodos . Value 

00127             'cierra el cuadro y marca como que los cambios son ok  

00128             Me . DialogResult = DialogResult . OK 

00129             Me . Visible = False 

00130         End Sub 

00131      

00132         Private Sub Form5_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

00133             'toma el valor actual de nodosmatriz  

00134             udTotalNodos . Value = Form1 . NuevoNodosMatriz 

00135      

00136         End Sub 

00137      

00138      

00139     End Class 

00001      

00002     Public Class Form6 

00003      

00004      

00005         Inherits System . Windows . Forms . Form 

00006      

00007         Public Event ActualizaGrafo ( ByVal valor As Boolean ) 

00008     # Region " Código generado por el Diseñador de Windows Forms " 

00009      

00010         Public Sub New () 

00011             MyBase . New () 

00012      

00013             'El Diseñador de Windows Forms requiere esta llamada.  

00014             InitializeComponent () 

00015      

00016             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00017      

00018         End Sub 

00019      

00020         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00021         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00022             If disposing Then 

00023                 If Not ( components Is Nothing ) Then 

00024                     components . Dispose () 

00025                 End If 

00026             End If 

00027             MyBase . Dispose ( disposing ) 

00028         End Sub 

00029      

00030         'Requerido por el Diseñador de Windows Forms  

00031         Private components As System . ComponentModel . IContainer 

00032      

00033         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00034         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00035         'No lo modifique con el editor de código.  

00036         Friend WithEvents txtResultados As System . Windows . Forms . TextBox 

00037         Friend WithEvents ToolBar1 As System . Windows . Forms . ToolBar 

00038         Friend WithEvents ImageList1 As System . Windows . Forms . ImageList 

00039         Friend WithEvents btnGrabarResult As System . Windows . Forms . ToolBarButton 

00040         Friend WithEvents btnFontResult As System . Windows . Forms . ToolBarButton 

00041         Friend WithEvents ToolBarButton1 As System . Windows . Forms . ToolBarButton 

00042         Friend WithEvents ToolBarButton2 As System . Windows . Forms . ToolBarButton 

00043         Friend WithEvents btnCopiarResult As System . Windows . Forms . ToolBarButton 

00044         Friend WithEvents printDialog1 As System . Windows . Forms . PrintDialog 

00045         Friend WithEvents ThePrintDocument As System . Drawing . Printing . PrintDocument 

00046         Friend WithEvents btnPrintSetup As System . Windows . Forms . ToolBarButton 

00047         Friend WithEvents btnPrintPreview As System . Windows . Forms . ToolBarButton 

00048         Friend WithEvents ToolBarButton3 As System . Windows . Forms . ToolBarButton 

00049         Friend WithEvents ConfigPag As System . Windows . Forms . ToolBarButton 

00050         Friend WithEvents PageSetupDialog1 As System . Windows . Forms . PageSetupDialog 

00051         Friend WithEvents PrintPreviewDialog1 As System . Windows . Forms .  

       »           PrintPreviewDialog 

00052         Friend WithEvents btnSolucionGrafo As System . Windows . Forms . ToolBarButton 

00053         Friend WithEvents btnVerLP As System . Windows . Forms . ToolBarButton 

00054         Friend WithEvents ToolBarButton6 As System . Windows . Forms . ToolBarButton 

00055         Friend WithEvents btnCerrar As System . Windows . Forms . ToolBarButton 

00056         Friend WithEvents btnVerMPS As System . Windows . Forms . ToolBarButton 

00057         Friend WithEvents ToolBarButton4 As System . Windows . Forms . ToolBarButton 

00058         Friend WithEvents btnVerResultados As System . Windows . Forms . ToolBarButton 

00059         Friend WithEvents ToolBarButton5 As System . Windows . Forms . ToolBarButton 

00060         Friend WithEvents ToolBarButton7 As System . Windows . Forms . ToolBarButton 

00061         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00062             Me . components = New System . ComponentModel . Container 

00063             Dim resources As System . Resources . ResourceManager = New System . Resources  

       »               . ResourceManager ( GetType ( Form6 )) 

00064             Me . txtResultados = New System . Windows . Forms . TextBox 

00065             Me . ToolBar1 = New System . Windows . Forms . ToolBar 

00066             Me . btnGrabarResult = New System . Windows . Forms . ToolBarButton 

00067             Me . ToolBarButton1 = New System . Windows . Forms . ToolBarButton 

00068             Me . btnCopiarResult = New System . Windows . Forms . ToolBarButton 

00069             Me . btnFontResult = New System . Windows . Forms . ToolBarButton 

00070             Me . ToolBarButton2 = New System . Windows . Forms . ToolBarButton 

00071             Me . btnPrintSetup = New System . Windows . Forms . ToolBarButton 

00072             Me . ConfigPag = New System . Windows . Forms . ToolBarButton 

00073             Me . btnPrintPreview = New System . Windows . Forms . ToolBarButton 

00074             Me . ToolBarButton3 = New System . Windows . Forms . ToolBarButton 

00075             Me . btnSolucionGrafo = New System . Windows . Forms . ToolBarButton 

00076             Me . btnVerLP = New System . Windows . Forms . ToolBarButton 

00077             Me . ToolBarButton6 = New System . Windows . Forms . ToolBarButton 

00078             Me . btnCerrar = New System . Windows . Forms . ToolBarButton 

00079             Me . ImageList1 = New System . Windows . Forms . ImageList ( Me . components ) 

00080             Me . printDialog1 = New System . Windows . Forms . PrintDialog 

00081             Me . ThePrintDocument = New System . Drawing . Printing . PrintDocument 

00082             Me . PageSetupDialog1 = New System . Windows . Forms . PageSetupDialog 

00083             Me . PrintPreviewDialog1 = New System . Windows . Forms . PrintPreviewDialog 

00084             Me . btnVerMPS = New System . Windows . Forms . ToolBarButton 

00085             Me . ToolBarButton4 = New System . Windows . Forms . ToolBarButton 

00086             Me . btnVerResultados = New System . Windows . Forms . ToolBarButton 

00087             Me . ToolBarButton5 = New System . Windows . Forms . ToolBarButton 

00088             Me . ToolBarButton7 = New System . Windows . Forms . ToolBarButton 

00089             Me . SuspendLayout () 

00090             '  

00091             'txtResultados  

00092             '  

00093             Me . txtResultados . AcceptsReturn = True 

00094             Me . txtResultados . AcceptsTab = True 

00095             Me . txtResultados . Anchor = CType (((( System . Windows . Forms . AnchorStyles . Top 

       »               Or System . Windows . Forms . AnchorStyles . Bottom ) _ 

00096                         Or System . Windows . Forms . AnchorStyles . Left ) _ 

00097                         Or System . Windows . Forms . AnchorStyles . Right ), System . Windows  

       »                           . Forms . AnchorStyles ) 

00098             Me . txtResultados . Font = New System . Drawing . Font ( "Courier New" , 9.0 !,  

       »               System . Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point ,  

       »               CType ( 0 , Byte )) 

00099             Me . txtResultados . Location = New System . Drawing . Point ( 0 , 32 ) 

00100             Me . txtResultados . Multiline = True 

00101             Me . txtResultados . Name = "txtResultados" 

00102             Me . txtResultados . ScrollBars = System . Windows . Forms . ScrollBars . Both 

00103             Me . txtResultados . Size = New System . Drawing . Size ( 376 , 256 ) 

00104             Me . txtResultados . TabIndex = 0 

00105             Me . txtResultados . Text = "" 

00106             Me . txtResultados . WordWrap = False 

00107             '  

00108             'ToolBar1  

00109             '  

00110             Me . ToolBar1 . Buttons . AddRange ( New System . Windows . Forms . ToolBarButton () {  

       »               Me . btnGrabarResult , Me . ToolBarButton1 , Me . btnCopiarResult , Me .  

       »               btnFontResult , Me . ToolBarButton2 , Me . btnPrintSetup , Me . ConfigPag , Me .  

       »               btnPrintPreview , Me . ToolBarButton3 , Me . btnSolucionGrafo , Me .  

       »               ToolBarButton4 , Me . btnVerResultados , Me . btnVerLP , Me . btnVerMPS , Me .  

       »               ToolBarButton6 , Me . ToolBarButton5 , Me . ToolBarButton7 , Me . btnCerrar }) 

00111             Me . ToolBar1 . DropDownArrows = True 

00112             Me . ToolBar1 . ImageList = Me . ImageList1 

00113             Me . ToolBar1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00114             Me . ToolBar1 . Name = "ToolBar1" 

00115             Me . ToolBar1 . ShowToolTips = True 

00116             Me . ToolBar1 . Size = New System . Drawing . Size ( 376 , 28 ) 

00117             Me . ToolBar1 . TabIndex = 1 

00118             '  

00119             'btnGrabarResult  

00120             '  

00121             Me . btnGrabarResult . ImageIndex = 0 

00122             Me . btnGrabarResult . Tag = "Grabar" 

00123             Me . btnGrabarResult . ToolTipText = "Grabar resultados..." 

00124             '  

00125             'ToolBarButton1  

00126             '  

00127             Me . ToolBarButton1 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00128             '  

00129             'btnCopiarResult  

00130             '  

00131             Me . btnCopiarResult . ImageIndex = 3 

00132             Me . btnCopiarResult . Tag = "Copiar" 

00133             Me . btnCopiarResult . ToolTipText = "Copiar todo al portapapeles" 

00134             '  

00135             'btnFontResult  

00136             '  

00137             Me . btnFontResult . ImageIndex = 2 

00138             Me . btnFontResult . Tag = "Tamaño" 

00139             Me . btnFontResult . ToolTipText = "Cambiar tamaño de letra" 

00140             '  

00141             'ToolBarButton2  

00142             '  

00143             Me . ToolBarButton2 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00144             '  

00145             'btnPrintSetup  

00146             '  

00147             Me . btnPrintSetup . ImageIndex = 4 

00148             Me . btnPrintSetup . Tag = "ConfigImpresora" 

00149             Me . btnPrintSetup . ToolTipText = "Configurar impresora..." 

00150             '  

00151             'ConfigPag  

00152             '  

00153             Me . ConfigPag . ImageIndex = 7 

00154             Me . ConfigPag . Tag = "ConfigPagina" 

00155             Me . ConfigPag . ToolTipText = "Configurar página..." 

00156             '  

00157             'btnPrintPreview  

00158             '  

00159             Me . btnPrintPreview . ImageIndex = 6 

00160             Me . btnPrintPreview . Tag = "Previsualizar" 

00161             Me . btnPrintPreview . ToolTipText = "Previsualizar e imprimir resultados" 

00162             '  

00163             'ToolBarButton3  

00164             '  

00165             Me . ToolBarButton3 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00166             '  

00167             'btnSolucionGrafo  

00168             '  

00169             Me . btnSolucionGrafo . ImageIndex = 8 

00170             Me . btnSolucionGrafo . Pushed = True 

00171             Me . btnSolucionGrafo . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               ToggleButton 

00172             Me . btnSolucionGrafo . Tag = "VerSolucion" 

00173             Me . btnSolucionGrafo . ToolTipText = "Ver Solución o Grafo original" 

00174             '  

00175             'btnVerLP  

00176             '  

00177             Me . btnVerLP . Enabled = False 

00178             Me . btnVerLP . ImageIndex = 10 

00179             Me . btnVerLP . Style = System . Windows . Forms . ToolBarButtonStyle . ToggleButton 

00180             Me . btnVerLP . Tag = "VerLP" 

00181             Me . btnVerLP . ToolTipText = "Mostrar fichero Modelo .LP" 

00182             '  

00183             'ToolBarButton6  

00184             '  

00185             Me . ToolBarButton6 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00186             '  

00187             'btnCerrar  

00188             '  

00189             Me . btnCerrar . ImageIndex = 9 

00190             Me . btnCerrar . Tag = "Cerrar" 

00191             Me . btnCerrar . ToolTipText = "Cerrar ventana Resultados" 

00192             '  

00193             'ImageList1  

00194             '  

00195             Me . ImageList1 . ImageSize = New System . Drawing . Size ( 16 , 16 ) 

00196             Me . ImageList1 . ImageStream = CType ( resources . GetObject (  

       »               "ImageList1.ImageStream" ), System . Windows . Forms . ImageListStreamer ) 

00197             Me . ImageList1 . TransparentColor = System . Drawing . Color . Transparent 

00198             '  

00199             'ThePrintDocument  

00200             '  

00201             '  

00202             'PrintPreviewDialog1  

00203             '  

00204             Me . PrintPreviewDialog1 . AutoScrollMargin = New System . Drawing . Size ( 0 , 0 ) 

00205             Me . PrintPreviewDialog1 . AutoScrollMinSize = New System . Drawing . Size ( 0 , 0 ) 

00206             Me . PrintPreviewDialog1 . ClientSize = New System . Drawing . Size ( 400 , 300 ) 

00207             Me . PrintPreviewDialog1 . Enabled = True 

00208             Me . PrintPreviewDialog1 . Icon = CType ( resources . GetObject (  

       »               "PrintPreviewDialog1.Icon" ), System . Drawing . Icon ) 

00209             Me . PrintPreviewDialog1 . Location = New System . Drawing . Point ( 528 , 17 ) 

00210             Me . PrintPreviewDialog1 . MinimumSize = New System . Drawing . Size ( 375 , 250 ) 

00211             Me . PrintPreviewDialog1 . Name = "PrintPreviewDialog1" 

00212             Me . PrintPreviewDialog1 . TransparencyKey = System . Drawing . Color . Empty 

00213             Me . PrintPreviewDialog1 . Visible = False 

00214             '  

00215             'btnVerMPS  

00216             '  

00217             Me . btnVerMPS . Enabled = False 

00218             Me . btnVerMPS . ImageIndex = 11 

00219             Me . btnVerMPS . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               ToggleButton 

00220             Me . btnVerMPS . Tag = "VerMPS" 

00221             Me . btnVerMPS . ToolTipText = "Mostrar fichero Modelo .MPS" 

00222             '  

00223             'ToolBarButton4  

00224             '  

00225             Me . ToolBarButton4 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00226             '  

00227             'btnVerResultados  

00228             '  

00229             Me . btnVerResultados . ImageIndex = 12 

00230             Me . btnVerResultados . Pushed = True 

00231             Me . btnVerResultados . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               ToggleButton 

00232             Me . btnVerResultados . Tag = "VerResultados" 

00233             Me . btnVerResultados . ToolTipText = "Mostrar resultados del análisis" 

00234             '  

00235             'ToolBarButton5  

00236             '  

00237             Me . ToolBarButton5 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00238             '  

00239             'ToolBarButton7  

00240             '  

00241             Me . ToolBarButton7 . Style = System . Windows . Forms . ToolBarButtonStyle .  

       »               Separator 

00242             '  

00243             'Form6  

00244             '  

00245             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00246             Me . ClientSize = New System . Drawing . Size ( 376 , 288 ) 

00247             Me . ControlBox = False 

00248             Me . Controls . Add ( Me . ToolBar1 ) 

00249             Me . Controls . Add ( Me . txtResultados ) 

00250             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               SizableToolWindow 

00251             Me . Icon = CType ( resources . GetObject ( "$this.Icon" ), System . Drawing . Icon ) 

00252             Me . Name = "Form6" 

00253             Me . Text = " Grafos - Resultados del Análisis" 

00254             Me . TopMost = True 

00255             Me . ResumeLayout ( False ) 

00256      

00257         End Sub 

00258      

00259     # End Region 

00260      

00261      

00262      

00263      

00264      

00265      



00266         Private Sub ToolBar1_ButtonClick ( ByVal sender As System . Object , ByVal e As  

       »           System . Windows . Forms . ToolBarButtonClickEventArgs ) Handles ToolBar1 .  

       »           ButtonClick 

00267             Select Case e . Button . Tag 

00268                 Case "Grabar" 

00269                     'Esta opción de menú muestra el cuadro de diálogo  

00270                     'de grabar fichero de resultados  

00271      

00272                     Dim saveFileDialog1 As New SaveFileDialog 

00273                     saveFileDialog1 . AddExtension = True 

00274                     saveFileDialog1 . DefaultExt = ".txt" 

00275                     saveFileDialog1 . Filter = "Fichero de texto (*.txt)|*.txt|Todos  

       »                       los archivos (*.*)|*.*" 

00276                     saveFileDialog1 . FilterIndex = 1 'formato por defecto .txt  

00277                     saveFileDialog1 . Title = "Guardar resultados del análisis" 

00278                     saveFileDialog1 . RestoreDirectory = True 

00279                     Try 

00280                         If saveFileDialog1 . ShowDialog () = DialogResult . OK Then 

00281                             'llama al menu de guardar  

00282                             EscribeFicheroTexto ( saveFileDialog1 . FileName , Me .  

       »                               txtResultados . Text ) 

00283                         End If 

00284                     Catch 

00285                         Exit Sub 

00286                     End Try 

00287      

00288      

00289                 Case "ConfigImpresora" 

00290                     'Configura impresora y parámetros de impresión  

00291                     With printDialog1 

00292                         . PrinterSettings = Me . ThePrintDocument . PrinterSettings 

00293                         If . ShowDialog () = DialogResult . OK Then 

00294                             Me . ThePrintDocument . PrinterSettings = . PrinterSettings 

00295                         End If 

00296                     End With 

00297      

00298      

00299                 Case "ConfigPagina" 

00300                     'Establece configuración de página  

00301                     With PageSetupDialog1 

00302                         . PageSettings = Me . ThePrintDocument . DefaultPageSettings 

00303                         If . ShowDialog () = DialogResult . OK Then 

00304                             Me . ThePrintDocument . DefaultPageSettings = . PageSettings 

00305                         End If 

00306                     End With 

00307      

00308      

00309      

00310                 Case "Previsualizar" 

00311                     Try 

00312                         'Muestra el diálogo de previsualización  

00313                         'que a su vez llama al evento PrintPage de PrintDocument1  

00314      

00315                         Me . WindowState = FormWindowState . Normal 

00316      

00317                         'Dim strText As String = Me.txtResultados.Text  

00318                         'myReader = New StringReader(strText)  

00319                         PrintPreviewDialog1 . Document = Me . ThePrintDocument 

00320      

00321                         PrintPreviewDialog1 . ShowDialog () 

00322      

00323                     Catch exp As Exception 

00324                         MsgBox ( "Ha fallado la operación de impresión." & vbCrLf &  

       »                           exp . Message , MsgBoxStyle . Exclamation , "Grafos -  

       »                           Excepción" ) 

00325                     End Try 

00326      

00327                     'Case "Imprimir"  

00328                     ' Exit Sub  

00329                     ' 'Imprimir texto  

00330                     ' printDialog1.Document = ThePrintDocument  

00331                     ' Dim strText As String = Me.txtResultados.Text  

00332                     ' myReader = New StringReader(strText)  

00333                     ' If printDialog1.ShowDialog() = DialogResult.OK Then  

00334                     ' Me.ThePrintDocument.Print()  

00335                     ' End If  

00336      

00337                 Case "Tamaño" 

00338                     'cambia el tamaño de letra, útil para monitores grandes  

00339                     'o personas con problemas de visualización  

00340                     Dim n As String 

00341                     Dim t As Single 

00342                     Dim v As Integer 

00343                     'toma características de la fuente original  

00344                     n = Me . txtResultados . Font . Name 

00345                     t = Me . txtResultados . Font . Size 

00346                     v = Me . txtResultados . Font . Style 

00347                     'incrementa el tamaño de la letra progresivamente  

00348                     If t < 24 Then 

00349                         t = t + 2 

00350                     Else 

00351                         t = 6 

00352                     End If 

00353                     'Crea fuente con nuevas características y establece  

00354                     Dim F As New Font ( n , t , v , GraphicsUnit . Pixel ) 

00355                     Me . txtResultados . Font = F 

00356                 Case "Copiar" 

00357                     'copia todo el contenido del cuadro de texto al  

00358                     'portapapeles  

00359                     Me . txtResultados . SelectAll () 

00360                     Me . txtResultados . Copy () 

00361      

00362      

00363                 Case "VerSolucion" 

00364                     'intercambia la solución a previsualizar  

00365                     'y redibuja el grafo  

00366      

00367      

00368                     Dim i , j As Long 

00369                     If Me . btnSolucionGrafo . Pushed = True Then 

00370      

00371                         For i = 0 To Form1 . TotalNodos - 1 

00372                             Form1 . Nodos ( i ) = Form1 . NodosSol ( i ) 

00373                         Next i 

00374                         For j = 0 To Form1 . TotalArcos - 1 

00375                             Form1 . Arcos ( j ) = Form1 . ArcosSol ( j ) 

00376                         Next j 

00377                     Else 

00378                         For i = 0 To Form1 . TotalNodos - 1 

00379                             Form1 . Nodos ( i ) = Form1 . NodosPrev ( i ) 

00380                         Next i 

00381                         For j = 0 To Form1 . TotalArcos - 1 

00382                             Form1 . Arcos ( j ) = Form1 . ArcosPrev ( j ) 

00383                         Next j 

00384                     End If 

00385      

00386                     RaiseEvent ActualizaGrafo ( True ) 

00387      

00388      



00389      

00390                 Case "VerResultados" 

00391                     Me . btnVerResultados . Pushed = True 

00392      

00393                     If Form1 . AlgoritmoMILP = True Then 

00394                         Me . btnVerLP . Pushed = False 

00395                         Me . btnVerMPS . Pushed = False 

00396                     End If 

00397      

00398                     txtResultados . Text = Form1 . txtResultadosAlgoritmo 

00399      

00400                 Case "VerLP" 

00401                     Me . btnVerResultados . Pushed = False 

00402                     Me . btnVerLP . Pushed = True 

00403                     Me . btnVerMPS . Pushed = False 

00404      

00405                     LeeFicheroTexto ( CurDir () & "\GrafosLP~.lp" , txtResultados . Text ) 

00406      

00407                 Case "VerMPS" 

00408                     Me . btnVerResultados . Pushed = False 

00409                     Me . btnVerLP . Pushed = False 

00410                     Me . btnVerMPS . Pushed = True 

00411      

00412                     LeeFicheroTexto ( CurDir () & "\GrafosLP~.mps" , txtResultados . Text  

       »                       ) 

00413      

00414                 Case "Cerrar" 

00415                     txtResultados . Text = "" 

00416                     Form1 . txtResultadosAlgoritmo = Nothing 

00417                     'Me.DialogResult = DialogResult.OK  

00418                     Me . Visible = False 

00419             End Select 

00420         End Sub 

00421      

00422      



00423         Private Sub ThePrintDocument_PrintPage ( ByVal sender As Object , ByVal ev As  

       »           System . Drawing . Printing . PrintPageEventArgs ) Handles ThePrintDocument .  

       »           PrintPage 

00424             'imprime un texto con esta rutina que escribe caracter a caracter...  

00425             Dim leftMargin As Single = ev . MarginBounds . Left 

00426             Dim topMargin As Single = ev . MarginBounds . Top 

00427             Dim printFont As Font = Me . txtResultados . Font 

00428             Dim myBrush As New SolidBrush ( Color . Black ) 

00429      

00430             Static curchar As Long 

00431      

00432             Dim txtW , txtH , LM , TM As Integer 

00433      

00434      

00435             With ThePrintDocument . DefaultPageSettings 

00436                 txtH = . PaperSize . Height - . Margins . Top - . Margins . Bottom 

00437                 txtW = . PaperSize . Width - . Margins . Left - . Margins . Right 

00438                 LM = . Margins . Left 

00439                 TM = . Margins . Top 

00440             End With 

00441      

00442      

00443             If ThePrintDocument . DefaultPageSettings . Landscape Then 

00444                 Dim tmp As Integer 

00445                 tmp = txtH 

00446                 txtH = txtW 

00447                 txtW = tmp 

00448             End If 

00449             Dim R As New RectangleF ( LM , TM , txtW , txtH ) 

00450             Dim chars , lineas As Long 

00451             Dim fmt As New StringFormat ( StringFormatFlags . LineLimit ) 

00452      

00453      

00454             ev . Graphics . MeasureString ( Mid ( Me . txtResultados . Text , curchar + 1 ),  

       »               printFont , New SizeF ( txtW , txtH ), fmt , chars , lineas ) 

00455             ev . Graphics . DrawString ( Mid ( Me . txtResultados . Text , curchar + 1 ),  

       »               printFont , Brushes . Black , R , fmt ) 

00456      

00457             curchar = curchar + chars 

00458             If curchar < Me . txtResultados . Text . Length Then 

00459                 ev . HasMorePages = True 

00460             Else 

00461                 ev . HasMorePages = False 

00462                 curchar = 0 

00463             End If 

00464      

00465      

00466      

00467         End Sub 

00468      

00469      

00470      

00471         Protected Overrides Sub Finalize () 

00472             MyBase . Finalize () 

00473         End Sub 

00474     End Class 

00001     Public Class frmExportarDatos 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents btnExportar As System . Windows . Forms . Button 

00033         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00034         Friend WithEvents GroupBox2 As System . Windows . Forms . GroupBox 

00035         Friend WithEvents GroupBox3 As System . Windows . Forms . GroupBox 

00036         Friend WithEvents gbOpciones As System . Windows . Forms . GroupBox 

00037         Friend WithEvents chkMatrizBinaria As System . Windows . Forms . CheckBox 

00038         Friend WithEvents chkMatrizMinimo As System . Windows . Forms . CheckBox 

00039         Friend WithEvents chkMatrizMaximo As System . Windows . Forms . CheckBox 

00040         Friend WithEvents chkMatrizCoste As System . Windows . Forms . CheckBox 

00041         Friend WithEvents chkMatrizEtiqueta As System . Windows . Forms . CheckBox 

00042         Friend WithEvents chkMatrizValor As System . Windows . Forms . CheckBox 

00043         Friend WithEvents pbExportar As System . Windows . Forms . ProgressBar 

00044         Friend WithEvents Label1 As System . Windows . Forms . Label 

00045         Friend WithEvents txtFL As System . Windows . Forms . TextBox 

00046         Friend WithEvents Label2 As System . Windows . Forms . Label 

00047         Friend WithEvents Label3 As System . Windows . Forms . Label 

00048         Friend WithEvents txtSP As System . Windows . Forms . TextBox 

00049         Friend WithEvents txtNV As System . Windows . Forms . TextBox 

00050         Friend WithEvents chkSPTab As System . Windows . Forms . CheckBox 

00051         Friend WithEvents chkMatrizEtiquetaValor As System . Windows . Forms . CheckBox 

00052         Friend WithEvents GroupBox1 As System . Windows . Forms . GroupBox 

00053         Friend WithEvents chkInfoGrafos As System . Windows . Forms . CheckBox 

00054         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00055             Me . btnExportar = New System . Windows . Forms . Button 

00056             Me . btnCancelar = New System . Windows . Forms . Button 

00057             Me . gbOpciones = New System . Windows . Forms . GroupBox 

00058             Me . GroupBox3 = New System . Windows . Forms . GroupBox 

00059             Me . chkMatrizEtiqueta = New System . Windows . Forms . CheckBox 

00060             Me . chkMatrizValor = New System . Windows . Forms . CheckBox 

00061             Me . chkMatrizEtiquetaValor = New System . Windows . Forms . CheckBox 

00062             Me . GroupBox1 = New System . Windows . Forms . GroupBox 

00063             Me . chkInfoGrafos = New System . Windows . Forms . CheckBox 

00064             Me . chkSPTab = New System . Windows . Forms . CheckBox 

00065             Me . Label1 = New System . Windows . Forms . Label 

00066             Me . GroupBox2 = New System . Windows . Forms . GroupBox 

00067             Me . chkMatrizBinaria = New System . Windows . Forms . CheckBox 

00068             Me . chkMatrizMinimo = New System . Windows . Forms . CheckBox 

00069             Me . chkMatrizMaximo = New System . Windows . Forms . CheckBox 

00070             Me . chkMatrizCoste = New System . Windows . Forms . CheckBox 

00071             Me . txtFL = New System . Windows . Forms . TextBox 

00072             Me . Label2 = New System . Windows . Forms . Label 

00073             Me . Label3 = New System . Windows . Forms . Label 

00074             Me . txtSP = New System . Windows . Forms . TextBox 

00075             Me . txtNV = New System . Windows . Forms . TextBox 

00076             Me . pbExportar = New System . Windows . Forms . ProgressBar 

00077             Me . gbOpciones . SuspendLayout () 

00078             Me . GroupBox3 . SuspendLayout () 

00079             Me . GroupBox1 . SuspendLayout () 

00080             Me . GroupBox2 . SuspendLayout () 

00081             Me . SuspendLayout () 

00082             '  

00083             'btnExportar  

00084             '  

00085             Me . btnExportar . Location = New System . Drawing . Point ( 176 , 224 ) 

00086             Me . btnExportar . Name = "btnExportar" 

00087             Me . btnExportar . Size = New System . Drawing . Size ( 88 , 24 ) 

00088             Me . btnExportar . TabIndex = 0 

00089             Me . btnExportar . Text = "Exportar" 

00090             '  

00091             'btnCancelar  

00092             '  

00093             Me . btnCancelar . Location = New System . Drawing . Point ( 272 , 224 ) 

00094             Me . btnCancelar . Name = "btnCancelar" 

00095             Me . btnCancelar . Size = New System . Drawing . Size ( 88 , 24 ) 

00096             Me . btnCancelar . TabIndex = 0 

00097             Me . btnCancelar . Text = "Cancelar" 

00098             '  

00099             'gbOpciones  

00100             '  

00101             Me . gbOpciones . Controls . Add ( Me . GroupBox3 ) 

00102             Me . gbOpciones . Controls . Add ( Me . GroupBox1 ) 

00103             Me . gbOpciones . Controls . Add ( Me . chkSPTab ) 

00104             Me . gbOpciones . Controls . Add ( Me . Label1 ) 

00105             Me . gbOpciones . Controls . Add ( Me . GroupBox2 ) 

00106             Me . gbOpciones . Controls . Add ( Me . txtFL ) 

00107             Me . gbOpciones . Controls . Add ( Me . Label2 ) 

00108             Me . gbOpciones . Controls . Add ( Me . Label3 ) 

00109             Me . gbOpciones . Controls . Add ( Me . txtSP ) 

00110             Me . gbOpciones . Controls . Add ( Me . txtNV ) 

00111             Me . gbOpciones . Location = New System . Drawing . Point ( 8 , 0 ) 

00112             Me . gbOpciones . Name = "gbOpciones" 

00113             Me . gbOpciones . Size = New System . Drawing . Size ( 352 , 216 ) 

00114             Me . gbOpciones . TabIndex = 1 

00115             Me . gbOpciones . TabStop = False 

00116             '  

00117             'GroupBox3  

00118             '  

00119             Me . GroupBox3 . Controls . Add ( Me . chkMatrizEtiqueta ) 

00120             Me . GroupBox3 . Controls . Add ( Me . chkMatrizValor ) 

00121             Me . GroupBox3 . Controls . Add ( Me . chkMatrizEtiquetaValor ) 

00122             Me . GroupBox3 . Location = New System . Drawing . Point ( 176 , 16 ) 

00123             Me . GroupBox3 . Name = "GroupBox3" 

00124             Me . GroupBox3 . Size = New System . Drawing . Size ( 168 , 88 ) 

00125             Me . GroupBox3 . TabIndex = 3 

00126             Me . GroupBox3 . TabStop = False 

00127             Me . GroupBox3 . Text = "Nodos: " 

00128             '  

00129             'chkMatrizEtiqueta  

00130             '  

00131             Me . chkMatrizEtiqueta . Checked = True 

00132             Me . chkMatrizEtiqueta . CheckState = System . Windows . Forms . CheckState .  

       »               Checked 

00133             Me . chkMatrizEtiqueta . Location = New System . Drawing . Point ( 8 , 16 ) 

00134             Me . chkMatrizEtiqueta . Name = "chkMatrizEtiqueta" 

00135             Me . chkMatrizEtiqueta . Size = New System . Drawing . Size ( 144 , 16 ) 

00136             Me . chkMatrizEtiqueta . TabIndex = 3 

00137             Me . chkMatrizEtiqueta . Text = "Matriz etiqueta" 

00138             '  

00139             'chkMatrizValor  

00140             '  

00141             Me . chkMatrizValor . Checked = True 

00142             Me . chkMatrizValor . CheckState = System . Windows . Forms . CheckState . Checked 

00143             Me . chkMatrizValor . Location = New System . Drawing . Point ( 8 , 40 ) 

00144             Me . chkMatrizValor . Name = "chkMatrizValor" 

00145             Me . chkMatrizValor . Size = New System . Drawing . Size ( 144 , 16 ) 

00146             Me . chkMatrizValor . TabIndex = 3 

00147             Me . chkMatrizValor . Text = "Matriz valor" 

00148             '  

00149             'chkMatrizEtiquetaValor  

00150             '  

00151             Me . chkMatrizEtiquetaValor . Checked = True 

00152             Me . chkMatrizEtiquetaValor . CheckState = System . Windows . Forms . CheckState .  

       »               Checked 

00153             Me . chkMatrizEtiquetaValor . Location = New System . Drawing . Point ( 8 , 64 ) 

00154             Me . chkMatrizEtiquetaValor . Name = "chkMatrizEtiquetaValor" 

00155             Me . chkMatrizEtiquetaValor . Size = New System . Drawing . Size ( 144 , 16 ) 

00156             Me . chkMatrizEtiquetaValor . TabIndex = 3 

00157             Me . chkMatrizEtiquetaValor . Text = "Matriz etiqueta y valor" 

00158             '  

00159             'GroupBox1  

00160             '  

00161             Me . GroupBox1 . Controls . Add ( Me . chkInfoGrafos ) 

00162             Me . GroupBox1 . Location = New System . Drawing . Point ( 176 , 96 ) 

00163             Me . GroupBox1 . Name = "GroupBox1" 

00164             Me . GroupBox1 . Size = New System . Drawing . Size ( 168 , 40 ) 

00165             Me . GroupBox1 . TabIndex = 6 

00166             Me . GroupBox1 . TabStop = False 

00167             '  

00168             'chkInfoGrafos  

00169             '  

00170             Me . chkInfoGrafos . Location = New System . Drawing . Point ( 8 , 16 ) 

00171             Me . chkInfoGrafos . Name = "chkInfoGrafos" 

00172             Me . chkInfoGrafos . Size = New System . Drawing . Size ( 152 , 16 ) 

00173             Me . chkInfoGrafos . TabIndex = 0 

00174             Me . chkInfoGrafos . Text = "Fichero de info. Grafos" 

00175             '  

00176             'chkSPTab  

00177             '  

00178             Me . chkSPTab . Checked = True 

00179             Me . chkSPTab . CheckState = System . Windows . Forms . CheckState . Checked 

00180             Me . chkSPTab . Location = New System . Drawing . Point ( 176 , 168 ) 

00181             Me . chkSPTab . Name = "chkSPTab" 

00182             Me . chkSPTab . Size = New System . Drawing . Size ( 80 , 16 ) 

00183             Me . chkSPTab . TabIndex = 5 

00184             Me . chkSPTab . Text = "Tabulador" 

00185             '  

00186             'Label1  

00187             '  

00188             Me . Label1 . AutoSize = True 

00189             Me . Label1 . Location = New System . Drawing . Point ( 8 , 144 ) 

00190             Me . Label1 . Name = "Label1" 

00191             Me . Label1 . Size = New System . Drawing . Size ( 134 , 16 ) 

00192             Me . Label1 . TabIndex = 4 

00193             Me . Label1 . Text = "Carácter para fín de línea:" 

00194             '  

00195             'GroupBox2  

00196             '  

00197             Me . GroupBox2 . Controls . Add ( Me . chkMatrizBinaria ) 

00198             Me . GroupBox2 . Controls . Add ( Me . chkMatrizMinimo ) 

00199             Me . GroupBox2 . Controls . Add ( Me . chkMatrizMaximo ) 

00200             Me . GroupBox2 . Controls . Add ( Me . chkMatrizCoste ) 

00201             Me . GroupBox2 . Location = New System . Drawing . Point ( 8 , 16 ) 

00202             Me . GroupBox2 . Name = "GroupBox2" 

00203             Me . GroupBox2 . Size = New System . Drawing . Size ( 160 , 120 ) 

00204             Me . GroupBox2 . TabIndex = 3 

00205             Me . GroupBox2 . TabStop = False 

00206             Me . GroupBox2 . Text = " Arcos: " 

00207             '  

00208             'chkMatrizBinaria  

00209             '  

00210             Me . chkMatrizBinaria . Checked = True 

00211             Me . chkMatrizBinaria . CheckState = System . Windows . Forms . CheckState . Checked 

00212             Me . chkMatrizBinaria . Location = New System . Drawing . Point ( 8 , 16 ) 

00213             Me . chkMatrizBinaria . Name = "chkMatrizBinaria" 

00214             Me . chkMatrizBinaria . Size = New System . Drawing . Size ( 96 , 16 ) 

00215             Me . chkMatrizBinaria . TabIndex = 3 

00216             Me . chkMatrizBinaria . Text = "Matriz binaria" 

00217             '  

00218             'chkMatrizMinimo  

00219             '  

00220             Me . chkMatrizMinimo . Checked = True 

00221             Me . chkMatrizMinimo . CheckState = System . Windows . Forms . CheckState . Checked 

00222             Me . chkMatrizMinimo . Location = New System . Drawing . Point ( 8 , 40 ) 

00223             Me . chkMatrizMinimo . Name = "chkMatrizMinimo" 

00224             Me . chkMatrizMinimo . Size = New System . Drawing . Size ( 96 , 16 ) 

00225             Me . chkMatrizMinimo . TabIndex = 3 

00226             Me . chkMatrizMinimo . Text = "Matriz mínimo" 

00227             '  

00228             'chkMatrizMaximo  

00229             '  

00230             Me . chkMatrizMaximo . Checked = True 

00231             Me . chkMatrizMaximo . CheckState = System . Windows . Forms . CheckState . Checked 

00232             Me . chkMatrizMaximo . Location = New System . Drawing . Point ( 8 , 64 ) 

00233             Me . chkMatrizMaximo . Name = "chkMatrizMaximo" 

00234             Me . chkMatrizMaximo . Size = New System . Drawing . Size ( 104 , 16 ) 

00235             Me . chkMatrizMaximo . TabIndex = 3 

00236             Me . chkMatrizMaximo . Text = "Matriz máximo" 

00237             '  

00238             'chkMatrizCoste  

00239             '  

00240             Me . chkMatrizCoste . Checked = True 

00241             Me . chkMatrizCoste . CheckState = System . Windows . Forms . CheckState . Checked 

00242             Me . chkMatrizCoste . Location = New System . Drawing . Point ( 8 , 88 ) 

00243             Me . chkMatrizCoste . Name = "chkMatrizCoste" 

00244             Me . chkMatrizCoste . Size = New System . Drawing . Size ( 96 , 16 ) 

00245             Me . chkMatrizCoste . TabIndex = 3 

00246             Me . chkMatrizCoste . Text = "Matriz coste" 

00247             '  

00248             'txtFL  

00249             '  

00250             Me . txtFL . Location = New System . Drawing . Point ( 144 , 144 ) 

00251             Me . txtFL . MaxLength = 1 

00252             Me . txtFL . Name = "txtFL" 

00253             Me . txtFL . Size = New System . Drawing . Size ( 24 , 20 ) 

00254             Me . txtFL . TabIndex = 1 

00255             Me . txtFL . Text = "" 

00256             '  

00257             'Label2  

00258             '  

00259             Me . Label2 . AutoSize = True 

00260             Me . Label2 . Location = New System . Drawing . Point ( 8 , 168 ) 

00261             Me . Label2 . Name = "Label2" 

00262             Me . Label2 . Size = New System . Drawing . Size ( 130 , 16 ) 

00263             Me . Label2 . TabIndex = 4 

00264             Me . Label2 . Text = "Carácter para separador:" 

00265             '  

00266             'Label3  

00267             '  

00268             Me . Label3 . AutoSize = True 

00269             Me . Label3 . Location = New System . Drawing . Point ( 8 , 192 ) 

00270             Me . Label3 . Name = "Label3" 

00271             Me . Label3 . Size = New System . Drawing . Size ( 124 , 16 ) 

00272             Me . Label3 . TabIndex = 4 

00273             Me . Label3 . Text = "Carácter para 'no valor':" 

00274             '  

00275             'txtSP  

00276             '  

00277             Me . txtSP . Location = New System . Drawing . Point ( 144 , 168 ) 

00278             Me . txtSP . MaxLength = 1 

00279             Me . txtSP . Name = "txtSP" 

00280             Me . txtSP . Size = New System . Drawing . Size ( 24 , 20 ) 

00281             Me . txtSP . TabIndex = 1 

00282             Me . txtSP . Text = "" 

00283             '  

00284             'txtNV  

00285             '  

00286             Me . txtNV . Location = New System . Drawing . Point ( 144 , 192 ) 

00287             Me . txtNV . MaxLength = 1 

00288             Me . txtNV . Name = "txtNV" 

00289             Me . txtNV . Size = New System . Drawing . Size ( 24 , 20 ) 

00290             Me . txtNV . TabIndex = 1 

00291             Me . txtNV . Text = "#" 

00292             '  

00293             'pbExportar  

00294             '  

00295             Me . pbExportar . Location = New System . Drawing . Point ( 8 , 224 ) 

00296             Me . pbExportar . Name = "pbExportar" 

00297             Me . pbExportar . Size = New System . Drawing . Size ( 160 , 24 ) 

00298             Me . pbExportar . TabIndex = 2 

00299             '  

00300             'frmExportarDatos  

00301             '  

00302             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00303             Me . ClientSize = New System . Drawing . Size ( 370 , 255 ) 

00304             Me . ControlBox = False 

00305             Me . Controls . Add ( Me . pbExportar ) 

00306             Me . Controls . Add ( Me . gbOpciones ) 

00307             Me . Controls . Add ( Me . btnExportar ) 

00308             Me . Controls . Add ( Me . btnCancelar ) 

00309             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00310             Me . Name = "frmExportarDatos" 

00311             Me . StartPosition = System . Windows . Forms . FormStartPosition . CenterScreen 

00312             Me . Text = "Grafos - Opciones para Exportar datos..." 

00313             Me . TopMost = True 

00314             Me . gbOpciones . ResumeLayout ( False ) 

00315             Me . GroupBox3 . ResumeLayout ( False ) 

00316             Me . GroupBox1 . ResumeLayout ( False ) 

00317             Me . GroupBox2 . ResumeLayout ( False ) 

00318             Me . ResumeLayout ( False ) 

00319      

00320         End Sub 

00321      

00322     # End Region 

00323      

00324         'crea matrices para la tablas de arcos  

00325         Dim MatrizBinario (- 1 , - 1 ) As String 

00326         Dim MatrizMinimo (- 1 , - 1 ) As String 

00327         Dim MatrizMaximo (- 1 , - 1 ) As String 

00328         Dim MatrizCoste (- 1 , - 1 ) As String 

00329         'crea matriz para la cabecera de nodos  

00330         Dim MatrizNodosEtiqueta () As String 

00331         'crea matriz par los valores de nodos  

00332         Dim MatrizNodosValor () As String 

00333      

00334      



00335         Sub RellenaMatricesExportar () 

00336             'Esta rutina, lee los datos iniciales del grafo en formato gráfico  

00337             'y rellena las matrices que se usarán para la exportación de datos  

00338      

00339             'dimensiona matrices  

00340             ReDim MatrizBinario ( Form1 . TotalNodos - 1 , Form1 . TotalNodos - 1 ) 

00341             ReDim MatrizMinimo ( Form1 . TotalNodos - 1 , Form1 . TotalNodos - 1 ) 

00342             ReDim MatrizMaximo ( Form1 . TotalNodos - 1 , Form1 . TotalNodos - 1 ) 

00343             ReDim MatrizCoste ( Form1 . TotalNodos - 1 , Form1 . TotalNodos - 1 ) 

00344             ReDim MatrizNodosEtiqueta ( Form1 . TotalNodos - 1 ) 

00345             ReDim MatrizNodosValor ( Form1 . TotalNodos - 1 ) 

00346      

00347             Dim i , j , a As Long 

00348      

00349             'i,j donde i=fila=y,j=columna=x  

00350             'toma valores  

00351             'cambia los valores decimales de coma por punto (más estándar)  

00352             'así además se posibilita el separador de coma (.csv)  

00353             For i = 0 To Form1 . TotalNodos - 1 

00354                 MatrizNodosEtiqueta ( i ) = Form1 . Nodos ( i ) . Texto 

00355                 MatrizNodosValor ( i ) = Form1 . Nodos ( i ) . Valor . ToString . Replace ( "," ,  

       »                   "." ) 

00356                 For j = 0 To Form1 . TotalNodos - 1 

00357                     'nodo origen=y, nodo destino=x  

00358                     'nodo origen=i, nodo destino=j  

00359                     'rellena todas las matrices con 'no valor'  

00360                     MatrizBinario ( i , j ) = txtNV . Text 

00361                     MatrizMinimo ( i , j ) = txtNV . Text 

00362                     MatrizMaximo ( i , j ) = txtNV . Text 

00363                     MatrizCoste ( i , j ) = txtNV . Text 

00364                 Next j 

00365             Next i 

00366             'sobreescribe las matrices  

00367             'con las relaciones de arco  

00368             For a = 0 To Form1 . TotalArcos - 1 

00369                 i = Form1 . Arcos ( a ) . Nd1 

00370                 j = Form1 . Arcos ( a ) . Nd2 

00371      

00372                 MatrizBinario ( i , j ) = 1 

00373                 MatrizMinimo ( i , j ) = Form1 . Arcos ( a ) . Min . ToString . Replace ( "," , "." ) 

00374                 MatrizMaximo ( i , j ) = Form1 . Arcos ( a ) . Max . ToString . Replace ( "," , "." ) 

00375                 MatrizCoste ( i , j ) = Form1 . Arcos ( a ) . Coste . ToString . Replace ( "," , "." ) 

00376             Next a 

00377         End Sub 

00378      

00379      

00380         Private Sub chkSPTab_CheckedChanged ( ByVal sender As System . Object , ByVal e  

       »           As System . EventArgs ) Handles chkSPTab . CheckedChanged 

00381             If chkSPTab . Checked = True Then 

00382                 txtSP . Enabled = False 

00383             Else 

00384                 txtSP . Enabled = True 

00385             End If 

00386         End Sub 

00387      

00388         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

00389             Me . Finalize () 

00390         End Sub 

00391      



00392         Private Sub btnExportar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnExportar . Click 

00393             'Proceso completo de Exportación de Datos  

00394             'en función de las opciones seleccionadas  

00395      

00396             'Comprobación inicial  

00397             'no se puede exportar sin separador, ni tabulador  

00398             Dim SP As String 

00399             If Me . chkSPTab . Checked = False Then 

00400                 If txtSP . Text . Length < 1 Then 

00401                     txtSP . Text = " " 

00402                 End If 

00403                 SP = txtSP . Text 

00404             Else 

00405                 SP = vbTab 

00406             End If 

00407      

00408             'selecciona trayectoria, nombre y extensión  

00409             'si no, sale como si nada  

00410             '----------------------------------  

00411             Dim Fichero As String 

00412             Dim extension As String 

00413      

00414             Dim saveFileDialog1 As New SaveFileDialog 

00415             saveFileDialog1 . AddExtension = True 

00416             saveFileDialog1 . DefaultExt = ".txt" 

00417             saveFileDialog1 . Filter = "Documento de texto (*.txt)|*.txt|Fichero  

       »               delimitado por comas (*.csv)|*.csv|Todos los archivos (*.*)|*.*" 

00418             saveFileDialog1 . FilterIndex = 1 'formato por defecto .txt  

00419             saveFileDialog1 . Title = "Exportar Datos del Grafo" 

00420             saveFileDialog1 . RestoreDirectory = True 

00421      

00422             If saveFileDialog1 . ShowDialog () = DialogResult . OK Then 

00423                 'Selecciona el formato de texto que ha escogido el usuario  

00424                 Select Case saveFileDialog1 . FilterIndex 

00425                     Case 1 

00426                         extension = ".txt" 

00427                     Case 2 

00428                         extension = ".csv" 

00429                         '### habría que preguntar si se fuerza un estándar  

00430                         'o se deja personalizarlo  

00431                         'de fin de linea y separadores  

00432                         'sp=";"  

00433      

00434                     Case Else 

00435                         extension = saveFileDialog1 . FileName . Substring (  

       »                           saveFileDialog1 . FileName . Length - 4 ) 

00436                 End Select 

00437             Else 

00438                 'el usuario canceló el cuadro de diálogo  

00439                 Exit Sub 

00440             End If 

00441      

00442             'Comienza el proceso de exportación propiamente dicho  

00443             Try 

00444                 '### debería comprobar si existe un fichero del mismo base  

00445                 '### esta rutina sobreescribe posibles ficheros existentes con la  

       »                   misma base  

00446      

00447                 'quita extensión para quedarse con la trayectoria y base del nombre  

00448                 Fichero = saveFileDialog1 . FileName 

00449                 Fichero = Fichero . Remove ( Fichero . Length - 4 , 4 ) 

00450      

00451      



00452                 btnExportar . Enabled = False 

00453                 btnCancelar . Enabled = False 

00454                 gbOpciones . Enabled = False 

00455                 Me . Cursor = Cursors . WaitCursor 

00456      

00457      

00458                 'cambia estado de la barra de progreso a cada paso  

00459                 Dim paso As Integer 

00460                 paso = 9 

00461                 Me . pbExportar . Value = 0 * 100 / paso 

00462                 'Creación de matrices  

00463                 'para la exportación  

00464                 '----------------------------------  

00465                 RellenaMatricesExportar () 

00466      

00467                 Me . pbExportar . Value = 1 * 100 / paso 

00468      

00469                 'Graba todos los ficheros de texto  

00470                 '----------------------------------  

00471                 Dim txt As String 

00472                 Dim i , j As Long 

00473                 'MatrizNodosValor  

00474                 If chkMatrizValor . Checked Then 

00475                     txt = "" 

00476                     For i = 0 To Form1 . TotalNodos - 1 

00477                         txt & = MatrizNodosValor ( i ) 

00478                         txt & = txtFL . Text & vbCrLf 

00479                     Next 

00480                     EscribeFicheroTexto ( Fichero & "_nval" & extension , txt ) 

00481                 End If 

00482                 Me . pbExportar . Value = 2 * 100 / paso 

00483                 'MatrizNodosEtiqueta  

00484                 If chkMatrizEtiqueta . Checked Then 

00485                     txt = "" 

00486                     For i = 0 To Form1 . TotalNodos - 1 

00487                         txt & = MatrizNodosEtiqueta ( i ) 

00488                         txt & = txtFL . Text & vbCrLf 

00489                     Next 

00490                     EscribeFicheroTexto ( Fichero & "_netq" & extension , txt ) 

00491                 End If 

00492                 Me . pbExportar . Value = 3 * 100 / paso 

00493                 'MatrizEtiquetaValor  

00494                 If chkMatrizEtiquetaValor . Checked Then 

00495                     txt = "" 

00496                     For i = 0 To Form1 . TotalNodos - 1 

00497                         txt & = MatrizNodosEtiqueta ( i ) 

00498                         txt & = SP & MatrizNodosValor ( i ) 

00499                         txt & = txtFL . Text & vbCrLf 

00500                     Next i 

00501                     EscribeFicheroTexto ( Fichero & "_nmat" & extension , txt ) 

00502                 End If 

00503                 Me . pbExportar . Value = 4 * 100 / paso 

00504                 'MatrizBinario  

00505                 If chkMatrizBinaria . Checked Then 

00506                     txt = "" 

00507                     For i = 0 To Form1 . TotalNodos - 1 

00508                         For j = 0 To Form1 . TotalNodos - 1 

00509                             txt & = MatrizBinario ( i , j ) 

00510                             If j < Form1 . TotalNodos - 1 Then 

00511                                 txt & = SP 

00512                             End If 

00513                         Next j 

00514                         txt & = txtFL . Text & vbCrLf 

00515                     Next i 

00516                     EscribeFicheroTexto ( Fichero & "_abin" & extension , txt ) 

00517                 End If 

00518                 Me . pbExportar . Value = 5 * 100 / paso 

00519                 'MatrizMinimo  

00520                 If chkMatrizMinimo . Checked Then 

00521                     txt = "" 

00522                     For i = 0 To Form1 . TotalNodos - 1 

00523                         For j = 0 To Form1 . TotalNodos - 1 

00524                             txt & = MatrizMinimo ( i , j ) 

00525                             If j < Form1 . TotalNodos - 1 Then 

00526                                 txt & = SP 

00527                             End If 

00528                         Next j 

00529                         txt & = txtFL . Text & vbCrLf 

00530                     Next i 

00531                     EscribeFicheroTexto ( Fichero & "_amin" & extension , txt ) 

00532                 End If 

00533                 Me . pbExportar . Value = 6 * 100 / paso 

00534                 'MatrizMaximo  

00535                 If chkMatrizMaximo . Checked Then 

00536                     txt = "" 

00537                     For i = 0 To Form1 . TotalNodos - 1 

00538                         For j = 0 To Form1 . TotalNodos - 1 

00539                             txt & = MatrizMaximo ( i , j ) 

00540                             If j < Form1 . TotalNodos - 1 Then 

00541                                 txt & = SP 

00542                             End If 

00543                         Next j 

00544                         txt & = txtFL . Text & vbCrLf 

00545                     Next i 

00546                     EscribeFicheroTexto ( Fichero & "_amax" & extension , txt ) 

00547                 End If 

00548                 Me . pbExportar . Value = 7 * 100 / paso 

00549                 'MatrizCoste  

00550                 If chkMatrizCoste . Checked Then 

00551                     txt = "" 

00552                     For i = 0 To Form1 . TotalNodos - 1 

00553                         For j = 0 To Form1 . TotalNodos - 1 

00554                             txt & = MatrizCoste ( i , j ) 

00555                             If j < Form1 . TotalNodos - 1 Then 

00556                                 txt & = SP 

00557                             End If 

00558                         Next j 

00559                         txt & = txtFL . Text & vbCrLf 

00560                     Next i 

00561                     EscribeFicheroTexto ( Fichero & "_acst" & extension , txt ) 

00562                 End If 

00563                 Me . pbExportar . Value = 8 * 100 / paso 

00564                 'Fichero de información del grafo  

00565                 If chkInfoGrafos . Checked = True Then 

00566                     txt = "" 

00567                     txt & = "nodos =" & SP & Form1 . TotalNodos 

00568                     txt & = txtFL . Text & vbCrLf 

00569                     txt & = "arcos =" & SP & Form1 . TotalArcos 

00570                     txt & = txtFL . Text & vbCrLf 

00571                     'en el futuro se podrán añadir más campos  

00572                 End If 

00573                 EscribeFicheroTexto ( Fichero & "_ginf" & extension , txt ) 

00574      

00575                 Me . pbExportar . Value = 9 * 100 / paso 

00576      

00577             Catch ex As Exception 

00578                 MsgBox ( "Ha fallado el proceso de exportar datos." & vbCrLf & ex .  

       »                   Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

00579                 'Finalización correcta  

00580                 btnExportar . Enabled = True 

00581                 btnCancelar . Enabled = True 

00582                 gbOpciones . Enabled = True 

00583                 Me . pbExportar . Value = 0 

00584                 Me . Cursor = Cursors . Default 

00585                 Exit Sub 

00586             Finally 

00587             End Try 

00588      

00589      

00590             'Finalización correcta  

00591             btnExportar . Enabled = True 

00592             btnCancelar . Enabled = True 

00593             gbOpciones . Enabled = True 

00594             Me . pbExportar . Value = 0 

00595             Me . Cursor = Cursors . Default 

00596         End Sub 

00597      

00598      

00599         Private Sub txtFL_KeyPress ( ByVal sender As Object , ByVal e As System . Windows  

       »           . Forms . KeyPressEventArgs ) Handles txtFL . KeyPress 

00600             'carácter de fín de línea  

00601             'no se permiten números  

00602             'si se permite coma  

00603             'no se permite punto  

00604             'no se permite + -  

00605             'se permite vacío  

00606             If e . KeyChar = "-" Or e . KeyChar = "+" Or ( e . KeyChar >= "0" And e . KeyChar 

       »               <= "9" ) Or e . KeyChar = "." Then 

00607                 'carácter no permitido  

00608                 e . Handled = True 

00609             Else 

00610             End If 

00611         End Sub 

00612      

00613      

00614         Private Sub txtSP_KeyPress ( ByVal sender As Object , ByVal e As System . Windows  

       »           . Forms . KeyPressEventArgs ) Handles txtSP . KeyPress 

00615             'carácter de separación  

00616             'no se permiten números  

00617             'si se permite coma  

00618             'no se permite punto  

00619             'no se permite + -  

00620             'no se permite vacío (se controla en btnExportar)  

00621             If e . KeyChar = "-" Or e . KeyChar = "+" Or ( e . KeyChar >= "0" And e . KeyChar 

       »               <= "9" ) Or e . KeyChar = "." Then 

00622                 'carácter no permitido  

00623                 e . Handled = True 

00624             Else 

00625             End If 

00626         End Sub 

00627      



00628         Private Sub txtNV_KeyPress ( ByVal sender As Object , ByVal e As System . Windows  

       »           . Forms . KeyPressEventArgs ) Handles txtNV . KeyPress 

00629             'carácter de 'no valor'  

00630             'no se permiten números (sólo el cero 0)  

00631             'no se permite coma  

00632             'no se permite punto  

00633             'si se permite + -  

00634             'si se permite vacío  

00635             If ( e . KeyChar >= "1" And e . KeyChar <= "9" ) Or e . KeyChar = "," Or e .  

       »               KeyChar = "." Then 

00636                 'carácter no permitido  

00637                 e . Handled = True 

00638             Else 

00639             End If 

00640         End Sub 

00641      

00642      

00643     End Class 

00001     Public Class frmImportarDatos 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00033         Friend WithEvents pbImportar As System . Windows . Forms . ProgressBar 

00034         Friend WithEvents btnImportar As System . Windows . Forms . Button 

00035         Friend WithEvents gbOpciones As System . Windows . Forms . GroupBox 

00036         Friend WithEvents GroupBox3 As System . Windows . Forms . GroupBox 

00037         Friend WithEvents chkSPTab As System . Windows . Forms . CheckBox 

00038         Friend WithEvents Label1 As System . Windows . Forms . Label 

00039         Friend WithEvents GroupBox2 As System . Windows . Forms . GroupBox 

00040         Friend WithEvents txtFL As System . Windows . Forms . TextBox 

00041         Friend WithEvents Label2 As System . Windows . Forms . Label 

00042         Friend WithEvents Label3 As System . Windows . Forms . Label 

00043         Friend WithEvents txtSP As System . Windows . Forms . TextBox 

00044         Friend WithEvents txtNV As System . Windows . Forms . TextBox 

00045         Friend WithEvents opMatrizBinaria As System . Windows . Forms . RadioButton 

00046         Friend WithEvents opSustituir As System . Windows . Forms . RadioButton 

00047         Friend WithEvents opMatrizMinimo As System . Windows . Forms . RadioButton 

00048         Friend WithEvents opMatrizMaximo As System . Windows . Forms . RadioButton 

00049         Friend WithEvents opMatrizCoste As System . Windows . Forms . RadioButton 

00050         Friend WithEvents opMatrizEtiqueta As System . Windows . Forms . RadioButton 

00051         Friend WithEvents opMatrizValor As System . Windows . Forms . RadioButton 

00052         Friend WithEvents opMatrizEtiquetaValor As System . Windows . Forms . RadioButton 

00053         Friend WithEvents opActualizar As System . Windows . Forms . RadioButton 

00054         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00055             Me . btnCancelar = New System . Windows . Forms . Button 

00056             Me . pbImportar = New System . Windows . Forms . ProgressBar 

00057             Me . btnImportar = New System . Windows . Forms . Button 

00058             Me . gbOpciones = New System . Windows . Forms . GroupBox 

00059             Me . GroupBox2 = New System . Windows . Forms . GroupBox 

00060             Me . opMatrizBinaria = New System . Windows . Forms . RadioButton 

00061             Me . opMatrizMinimo = New System . Windows . Forms . RadioButton 

00062             Me . opMatrizMaximo = New System . Windows . Forms . RadioButton 

00063             Me . opMatrizCoste = New System . Windows . Forms . RadioButton 

00064             Me . opMatrizEtiqueta = New System . Windows . Forms . RadioButton 

00065             Me . opMatrizValor = New System . Windows . Forms . RadioButton 

00066             Me . opMatrizEtiquetaValor = New System . Windows . Forms . RadioButton 

00067             Me . GroupBox3 = New System . Windows . Forms . GroupBox 

00068             Me . opActualizar = New System . Windows . Forms . RadioButton 

00069             Me . opSustituir = New System . Windows . Forms . RadioButton 

00070             Me . chkSPTab = New System . Windows . Forms . CheckBox 

00071             Me . Label1 = New System . Windows . Forms . Label 

00072             Me . txtFL = New System . Windows . Forms . TextBox 

00073             Me . Label2 = New System . Windows . Forms . Label 

00074             Me . Label3 = New System . Windows . Forms . Label 

00075             Me . txtSP = New System . Windows . Forms . TextBox 

00076             Me . txtNV = New System . Windows . Forms . TextBox 

00077             Me . gbOpciones . SuspendLayout () 

00078             Me . GroupBox2 . SuspendLayout () 

00079             Me . GroupBox3 . SuspendLayout () 

00080             Me . SuspendLayout () 

00081             '  

00082             'btnCancelar  

00083             '  

00084             Me . btnCancelar . Location = New System . Drawing . Point ( 272 , 224 ) 

00085             Me . btnCancelar . Name = "btnCancelar" 

00086             Me . btnCancelar . Size = New System . Drawing . Size ( 88 , 24 ) 

00087             Me . btnCancelar . TabIndex = 1 

00088             Me . btnCancelar . Text = "Cancelar" 

00089             '  

00090             'pbImportar  

00091             '  

00092             Me . pbImportar . Location = New System . Drawing . Point ( 8 , 224 ) 

00093             Me . pbImportar . Name = "pbImportar" 

00094             Me . pbImportar . Size = New System . Drawing . Size ( 160 , 24 ) 

00095             Me . pbImportar . TabIndex = 4 

00096             '  

00097             'btnImportar  

00098             '  

00099             Me . btnImportar . Location = New System . Drawing . Point ( 176 , 224 ) 

00100             Me . btnImportar . Name = "btnImportar" 

00101             Me . btnImportar . Size = New System . Drawing . Size ( 88 , 24 ) 

00102             Me . btnImportar . TabIndex = 3 

00103             Me . btnImportar . Text = "Importar" 

00104             '  

00105             'gbOpciones  

00106             '  

00107             Me . gbOpciones . Controls . Add ( Me . GroupBox2 ) 

00108             Me . gbOpciones . Controls . Add ( Me . GroupBox3 ) 

00109             Me . gbOpciones . Controls . Add ( Me . chkSPTab ) 

00110             Me . gbOpciones . Controls . Add ( Me . Label1 ) 

00111             Me . gbOpciones . Controls . Add ( Me . txtFL ) 

00112             Me . gbOpciones . Controls . Add ( Me . Label2 ) 

00113             Me . gbOpciones . Controls . Add ( Me . Label3 ) 

00114             Me . gbOpciones . Controls . Add ( Me . txtSP ) 

00115             Me . gbOpciones . Controls . Add ( Me . txtNV ) 

00116             Me . gbOpciones . Location = New System . Drawing . Point ( 8 , 0 ) 

00117             Me . gbOpciones . Name = "gbOpciones" 

00118             Me . gbOpciones . Size = New System . Drawing . Size ( 352 , 216 ) 

00119             Me . gbOpciones . TabIndex = 5 

00120             Me . gbOpciones . TabStop = False 

00121             '  

00122             'GroupBox2  

00123             '  

00124             Me . GroupBox2 . Controls . Add ( Me . opMatrizBinaria ) 

00125             Me . GroupBox2 . Controls . Add ( Me . opMatrizMinimo ) 

00126             Me . GroupBox2 . Controls . Add ( Me . opMatrizMaximo ) 

00127             Me . GroupBox2 . Controls . Add ( Me . opMatrizCoste ) 

00128             Me . GroupBox2 . Controls . Add ( Me . opMatrizEtiqueta ) 

00129             Me . GroupBox2 . Controls . Add ( Me . opMatrizValor ) 

00130             Me . GroupBox2 . Controls . Add ( Me . opMatrizEtiquetaValor ) 

00131             Me . GroupBox2 . Location = New System . Drawing . Point ( 8 , 16 ) 

00132             Me . GroupBox2 . Name = "GroupBox2" 

00133             Me . GroupBox2 . Size = New System . Drawing . Size ( 336 , 120 ) 

00134             Me . GroupBox2 . TabIndex = 3 

00135             Me . GroupBox2 . TabStop = False 

00136             Me . GroupBox2 . Text = "Tipo de datos: " 

00137             '  

00138             'opMatrizBinaria  

00139             '  

00140             Me . opMatrizBinaria . Location = New System . Drawing . Point ( 8 , 16 ) 

00141             Me . opMatrizBinaria . Name = "opMatrizBinaria" 

00142             Me . opMatrizBinaria . Size = New System . Drawing . Size ( 144 , 16 ) 

00143             Me . opMatrizBinaria . TabIndex = 0 

00144             Me . opMatrizBinaria . Text = "Matriz binaria (arcos)" 

00145             '  

00146             'opMatrizMinimo  

00147             '  

00148             Me . opMatrizMinimo . Checked = True 

00149             Me . opMatrizMinimo . Location = New System . Drawing . Point ( 8 , 40 ) 

00150             Me . opMatrizMinimo . Name = "opMatrizMinimo" 

00151             Me . opMatrizMinimo . Size = New System . Drawing . Size ( 144 , 16 ) 

00152             Me . opMatrizMinimo . TabIndex = 0 

00153             Me . opMatrizMinimo . TabStop = True 

00154             Me . opMatrizMinimo . Text = "Matriz mínimo (arcos)" 

00155             '  

00156             'opMatrizMaximo  

00157             '  

00158             Me . opMatrizMaximo . Location = New System . Drawing . Point ( 8 , 64 ) 

00159             Me . opMatrizMaximo . Name = "opMatrizMaximo" 

00160             Me . opMatrizMaximo . Size = New System . Drawing . Size ( 144 , 16 ) 

00161             Me . opMatrizMaximo . TabIndex = 0 

00162             Me . opMatrizMaximo . Text = "Matriz máximo (arcos)" 

00163             '  

00164             'opMatrizCoste  

00165             '  

00166             Me . opMatrizCoste . Location = New System . Drawing . Point ( 8 , 88 ) 

00167             Me . opMatrizCoste . Name = "opMatrizCoste" 

00168             Me . opMatrizCoste . Size = New System . Drawing . Size ( 144 , 16 ) 

00169             Me . opMatrizCoste . TabIndex = 0 

00170             Me . opMatrizCoste . Text = "Matriz coste (arcos)" 

00171             '  

00172             'opMatrizEtiqueta  

00173             '  

00174             Me . opMatrizEtiqueta . Location = New System . Drawing . Point ( 152 , 16 ) 

00175             Me . opMatrizEtiqueta . Name = "opMatrizEtiqueta" 

00176             Me . opMatrizEtiqueta . Size = New System . Drawing . Size ( 144 , 16 ) 

00177             Me . opMatrizEtiqueta . TabIndex = 0 

00178             Me . opMatrizEtiqueta . Text = "Matriz etiqueta (nodos)" 

00179             '  

00180             'opMatrizValor  

00181             '  

00182             Me . opMatrizValor . Location = New System . Drawing . Point ( 152 , 40 ) 

00183             Me . opMatrizValor . Name = "opMatrizValor" 

00184             Me . opMatrizValor . Size = New System . Drawing . Size ( 144 , 16 ) 

00185             Me . opMatrizValor . TabIndex = 0 

00186             Me . opMatrizValor . Text = "Matriz valor (nodos)" 

00187             '  

00188             'opMatrizEtiquetaValor  

00189             '  

00190             Me . opMatrizEtiquetaValor . Location = New System . Drawing . Point ( 152 , 64 ) 

00191             Me . opMatrizEtiquetaValor . Name = "opMatrizEtiquetaValor" 

00192             Me . opMatrizEtiquetaValor . Size = New System . Drawing . Size ( 176 , 16 ) 

00193             Me . opMatrizEtiquetaValor . TabIndex = 0 

00194             Me . opMatrizEtiquetaValor . Text = "Matriz etiqueta y valor (nodos)" 

00195             '  

00196             'GroupBox3  

00197             '  

00198             Me . GroupBox3 . Controls . Add ( Me . opActualizar ) 

00199             Me . GroupBox3 . Controls . Add ( Me . opSustituir ) 

00200             Me . GroupBox3 . Location = New System . Drawing . Point ( 256 , 136 ) 

00201             Me . GroupBox3 . Name = "GroupBox3" 

00202             Me . GroupBox3 . Size = New System . Drawing . Size ( 88 , 72 ) 

00203             Me . GroupBox3 . TabIndex = 3 

00204             Me . GroupBox3 . TabStop = False 

00205             '  

00206             'opActualizar  

00207             '  

00208             Me . opActualizar . Location = New System . Drawing . Point ( 8 , 40 ) 

00209             Me . opActualizar . Name = "opActualizar" 

00210             Me . opActualizar . Size = New System . Drawing . Size ( 72 , 16 ) 

00211             Me . opActualizar . TabIndex = 0 

00212             Me . opActualizar . Text = "Actualizar" 

00213             '  

00214             'opSustituir  

00215             '  

00216             Me . opSustituir . Checked = True 

00217             Me . opSustituir . Location = New System . Drawing . Point ( 8 , 16 ) 

00218             Me . opSustituir . Name = "opSustituir" 

00219             Me . opSustituir . Size = New System . Drawing . Size ( 72 , 16 ) 

00220             Me . opSustituir . TabIndex = 0 

00221             Me . opSustituir . TabStop = True 

00222             Me . opSustituir . Text = "Sustituir" 

00223             '  

00224             'chkSPTab  

00225             '  

00226             Me . chkSPTab . Checked = True 

00227             Me . chkSPTab . CheckState = System . Windows . Forms . CheckState . Checked 

00228             Me . chkSPTab . Location = New System . Drawing . Point ( 176 , 168 ) 

00229             Me . chkSPTab . Name = "chkSPTab" 

00230             Me . chkSPTab . Size = New System . Drawing . Size ( 80 , 16 ) 

00231             Me . chkSPTab . TabIndex = 5 

00232             Me . chkSPTab . Text = "Tabulador" 

00233             '  

00234             'Label1  

00235             '  

00236             Me . Label1 . AutoSize = True 

00237             Me . Label1 . Location = New System . Drawing . Point ( 8 , 144 ) 

00238             Me . Label1 . Name = "Label1" 

00239             Me . Label1 . Size = New System . Drawing . Size ( 134 , 16 ) 

00240             Me . Label1 . TabIndex = 4 

00241             Me . Label1 . Text = "Carácter para fín de línea:" 

00242             '  

00243             'txtFL  

00244             '  

00245             Me . txtFL . Location = New System . Drawing . Point ( 144 , 144 ) 

00246             Me . txtFL . MaxLength = 1 

00247             Me . txtFL . Name = "txtFL" 

00248             Me . txtFL . Size = New System . Drawing . Size ( 24 , 20 ) 

00249             Me . txtFL . TabIndex = 1 

00250             Me . txtFL . Text = "" 

00251             '  

00252             'Label2  

00253             '  

00254             Me . Label2 . AutoSize = True 

00255             Me . Label2 . Location = New System . Drawing . Point ( 8 , 168 ) 

00256             Me . Label2 . Name = "Label2" 

00257             Me . Label2 . Size = New System . Drawing . Size ( 130 , 16 ) 

00258             Me . Label2 . TabIndex = 4 

00259             Me . Label2 . Text = "Carácter para separador:" 

00260             '  

00261             'Label3  

00262             '  

00263             Me . Label3 . AutoSize = True 

00264             Me . Label3 . Location = New System . Drawing . Point ( 8 , 192 ) 

00265             Me . Label3 . Name = "Label3" 

00266             Me . Label3 . Size = New System . Drawing . Size ( 124 , 16 ) 

00267             Me . Label3 . TabIndex = 4 

00268             Me . Label3 . Text = "Carácter para 'no valor':" 

00269             '  

00270             'txtSP  

00271             '  

00272             Me . txtSP . Location = New System . Drawing . Point ( 144 , 168 ) 

00273             Me . txtSP . MaxLength = 1 

00274             Me . txtSP . Name = "txtSP" 

00275             Me . txtSP . Size = New System . Drawing . Size ( 24 , 20 ) 

00276             Me . txtSP . TabIndex = 1 

00277             Me . txtSP . Text = "" 

00278             '  

00279             'txtNV  

00280             '  

00281             Me . txtNV . Location = New System . Drawing . Point ( 144 , 192 ) 

00282             Me . txtNV . MaxLength = 1 

00283             Me . txtNV . Name = "txtNV" 

00284             Me . txtNV . Size = New System . Drawing . Size ( 24 , 20 ) 

00285             Me . txtNV . TabIndex = 1 

00286             Me . txtNV . Text = "#" 

00287             '  

00288             'frmImportarDatos  

00289             '  

00290             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00291             Me . ClientSize = New System . Drawing . Size ( 368 , 253 ) 

00292             Me . ControlBox = False 

00293             Me . Controls . Add ( Me . gbOpciones ) 

00294             Me . Controls . Add ( Me . pbImportar ) 

00295             Me . Controls . Add ( Me . btnImportar ) 

00296             Me . Controls . Add ( Me . btnCancelar ) 

00297             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00298             Me . Name = "frmImportarDatos" 

00299             Me . Text = "Grafos - Opciones para Importar datos..." 

00300             Me . TopMost = True 

00301             Me . gbOpciones . ResumeLayout ( False ) 

00302             Me . GroupBox2 . ResumeLayout ( False ) 

00303             Me . GroupBox3 . ResumeLayout ( False ) 

00304             Me . ResumeLayout ( False ) 

00305      

00306         End Sub 

00307      

00308     # End Region 

00309      

00310         'crea matrices genérica  

00311         Dim MatrizGenerica (- 1 , - 1 ) As String 

00312      

00313         'crea matrices para la tablas de arcos  

00314         Dim MatrizBinario (- 1 , - 1 ) As String 

00315         Dim MatrizMinimo (- 1 , - 1 ) As String 

00316         Dim MatrizMaximo (- 1 , - 1 ) As String 

00317         Dim MatrizCoste (- 1 , - 1 ) As String 

00318         'crea matriz para la cabecera de nodos  

00319         Dim MatrizNodosEtiqueta () As String 

00320         'crea matriz par los valores de nodos  

00321         Dim MatrizNodosValor () As String 

00322      

00323      

00324         Public Event ActualizaGrafo ( ByVal valor As Boolean ) 

00325      

00326         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

00327             RaiseEvent ActualizaGrafo ( True ) 

00328             Me . Visible = False 

00329         End Sub 

00330      



00331         Private Sub btnImportar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnImportar . Click 

00332             'Proceso completo de Importación de Datos  

00333             'en función de las opciones seleccionadas  

00334             'y del grafo existente en el tapiz  

00335      

00336             'Comprobación inicial  

00337             'no se puede importar sin separador, ni tabulador  

00338             Dim SP As String 

00339             If Me . chkSPTab . Checked = False Then 

00340                 If txtSP . Text . Length < 1 Then 

00341                     txtSP . Text = " " 

00342                 End If 

00343                 SP = txtSP . Text 

00344             Else 

00345                 SP = vbTab 

00346             End If 

00347      

00348             'Aviso de sustitución de datos  

00349             If Form1 . TotalNodos > 0 And opSustituir . Checked = True Then 

00350                 Dim respuesta As MsgBoxResult 

00351                 respuesta = MsgBox ( "Con la opción Sustituir activada, si abre un  

       »                   fichero para importar," & vbCrLf & "perderá los datos actuales  

       »                   del grafo." & vbCrLf & vbCrLf & "¿Desea realmente proseguir e  

       »                   importar los datos del fichero?" , MsgBoxStyle . Information ,  

       »                   MsgBoxStyle . OKCancel ) 

00352                 If respuesta = MsgBoxResult . Cancel Then Exit Sub 

00353             End If 

00354             'Aviso de actualización de datos  

00355             If Form1 . TotalNodos > 0 And opActualizar . Checked = True Then 

00356                 Dim respuesta As MsgBoxResult 

00357                 respuesta = MsgBox ( "Con la opción Actualizar activada, si abre un  

       »                   fichero para importar," & vbCrLf & "se actualizarán los datos y  

       »                   dimensiones actuales del grafo." & vbCrLf & vbCrLf & "¿Desea  

       »                   realmente proseguir e importar los datos del fichero?" ,  

       »                   MsgBoxStyle . Information , MsgBoxStyle . OKCancel ) 

00358                 If respuesta = MsgBoxResult . Cancel Then Exit Sub 

00359             End If 

00360             'Esta opción de menú muestra el cuadro de diálogo  

00361             'de abrir fichero para la importación de datos  

00362             Dim openFileDialog1 As New OpenFileDialog 

00363             Dim Fichero As String 

00364      

00365             openFileDialog1 . AddExtension = True 

00366             openFileDialog1 . DefaultExt = ".txt" 'extensión por defecto  

00367             openFileDialog1 . Filter = "Documento de texto (*.txt)|*.txt|Fichero  

       »               delimitado por comas (*.csv)|*.csv|Todos los archivos (*.*)|*.*" 

00368             openFileDialog1 . FilterIndex = 1 'formato por defecto .txt  

00369             openFileDialog1 . Title = "Importar Datos del Grafo" 

00370             openFileDialog1 . RestoreDirectory = True 

00371      

00372             If openFileDialog1 . ShowDialog () = DialogResult . OK Then 

00373                 Fichero = openFileDialog1 . FileName 

00374             Else 

00375                 Exit Sub 'el usuario eligió cancelar, sale como si nada  

00376             End If 

00377      

00378             'deshabilita botones y cursor ratón  

00379             Me . Cursor = Cursors . WaitCursor 

00380             btnImportar . Enabled = False 

00381             btnCancelar . Enabled = False 

00382             gbOpciones . Enabled = False 

00383      

00384             'cambia estado de la barra de progreso a cada paso  

00385             Dim paso As Integer 

00386             paso = 5 

00387             pbImportar . Value = 0 * 100 / paso 

00388      

00389             'Comienza el proceso de importación propiamente dicho  

00390             Try 

00391                 Dim texto As String 

00392      

00393                 'Abre el fichero y lee su contenido  

00394                 LeeFicheroTexto ( Fichero , texto ) 

00395                 'fin abrir fichero  

00396                 pbImportar . Value = 1 * 100 / paso 

00397                 'Comprueba longitud mínima del fichero de texto  

00398                 If texto . Length <= 1 Then 'genera un error personalizado  

00399                     Err () . Description = "Error de formato en el fichero  

       »                       seleccionado." & vbCrLf & "Este fichero no contiene datos." 

00400                     Err () . Raise ( 1 ) 

00401                 End If 

00402      

00403      

00404                 'cuenta filas y columnas del fichero  

00405                 Dim i , j , a , b As Long 

00406                 Dim filas As Long 

00407                 Dim columnas As Long 

00408                 Dim c As String 

00409                 Dim p As String 

00410      

00411                 filas = 0 

00412                 columnas = 0 

00413                 For a = 0 To texto . Length - 1 

00414                     c = texto . Substring ( a , 1 ) 

00415                     If ( c = SP Or Asc ( c ) = Asc ( vbCrLf )) And filas = 0 Then 

00416                         columnas = columnas + 1 

00417      

00418                         'corrección por el error de conteo que puede originar la  

       »                           línea anterior  

00419                         If a > 0 Then 

00420                             If ( texto . Substring ( a - 1 , 1 ) = SP And Asc ( c ) = Asc (  

       »                               vbCrLf )) Then 

00421                                 columnas = columnas - 1 

00422                             End If 

00423                             If ( texto . Substring ( a - 1 , 1 ) = txtFL . Text And txtFL .  

       »                               Text <> "" And Asc ( c ) = Asc ( vbCrLf )) Then 

00424                                 columnas = columnas - 1 

00425                             End If 

00426                         End If 

00427                     End If 

00428                     If Asc ( c ) = Asc ( vbCrLf ) Then 'ha encontrado final de linea  

00429                         filas = filas + 1 

00430                     End If 

00431                 Next a 

00432                 If c = SP And txtFL . Text = SP Then 'las líneas acaban con una doble  

       »                   terminación, en teoría  

00433                     columnas = columnas - 1 

00434                 End If 

00435                 pbImportar . Value = 2 * 100 / paso 

00436                 'Comprueba longitud mínima del fichero de texto  

00437                 If filas <= 0 Then 'genera un error personalizado  

00438                     Err () . Description = "Error de formato en el fichero  

       »                       seleccionado." & vbCrLf & "Número de filas insuficiente." 

00439                     Err () . Raise ( 1 ) 

00440                 End If 

00441                 'Comprueba longitud mínima del fichero de texto  

00442                 If columnas <= 0 Then 'genera un error personalizado  

00443                     Err () . Description = "Error de formato en el fichero  

       »                       seleccionado." & vbCrLf & "Número de columnas insuficiente." 

00444                     Err () . Raise ( 1 ) 

00445                 End If 

00446      

00447                 'comprobaciones según tipo de opción de importación y tamaño  

00448                 'si importamos datos de arcos la matriz debe ser cuadrada  

00449                 If opMatrizBinaria . Checked Or opMatrizMinimo . Checked Or  

       »                   opMatrizMaximo . Checked Or opMatrizCoste . Checked Then 

00450                     If columnas <> filas Then 'genera un error personalizado  

00451                         Err () . Description = "Error de formato en el fichero  

       »                           seleccionado." & vbCrLf & "La matriz debe ser cuadrada." 

00452                         Err () . Raise ( 1 ) 

00453                     End If 

00454                 End If 

00455                 'si importamos datos de nodos (etiqueta o valor) la matriz de una  

       »                   columna  

00456                 If opMatrizEtiqueta . Checked Or opMatrizValor . Checked Then 

00457                     If columnas <> 1 Then 'genera un error personalizado  

00458                         Err () . Description = "Error de formato en el fichero  

       »                           seleccionado." & vbCrLf & "Número de columnas  

       »                           incorrecto." 

00459                         Err () . Raise ( 1 ) 

00460                     End If 

00461                 End If 

00462                 'si importamos datos de nodos (etiqueta y valor) la matriz de una  

       »                   columna  

00463                 If opMatrizEtiquetaValor . Checked Then 

00464                     If columnas <> 2 Then 'genera un error personalizado  

00465                         Err () . Description = "Error de formato en el fichero  

       »                           seleccionado." & vbCrLf & "Número de columnas  

       »                           incorrecto." 

00466                         Err () . Raise ( 1 ) 

00467                     End If 

00468                 End If 

00469                 'comprueba el máximo de nodos (200)  

00470                 If columnas > 200 Then 'genera un error personalizado  

00471                     Err () . Description = "Error de formato en el fichero  

       »                       seleccionado." & vbCrLf & "Número de columnas demasiado  

       »                       grande." 

00472                     Err () . Raise ( 1 ) 

00473                 End If 

00474                 pbImportar . Value = 3 * 100 / paso 

00475                 'dimensiona matrices (i,j)=(filas,columnas)  

00476                 'todas contienen strings  

00477                 ReDim MatrizGenerica ( filas - 1 , columnas - 1 ) 

00478                 'ReDim MatrizBinario(filas - 1, columnas - 1)  

00479                 'ReDim MatrizMinimo(filas - 1, columnas - 1)  

00480                 'ReDim MatrizMaximo(filas - 1, columnas - 1)  

00481                 'ReDim MatrizCoste(filas - 1, columnas - 1)  

00482                 'ReDim MatrizNodosEtiqueta(filas - 1)  

00483                 'ReDim MatrizNodosValor(filas - 1)  

00484      

00485                 'lee datos según opciones  

00486                 'busca finales de línea  

00487                 'busca elementos de cada línea según separador  

00488                 'atención a posible duplicidad de final de línea)  

00489                 p = "" 

00490                 i = 0 

00491                 j = 0 

00492                 For a = 0 To texto . Length - 1 

00493                     c = texto . Substring ( a , 1 ) 

00494      

00495                     If c <> SP And Asc ( c ) <> Asc ( vbCrLf ) And Asc ( c ) <> Asc ( vbCr )  

       »                       And Asc ( c ) <> Asc ( vbLf ) Then 

00496                         'el separador decimal se transforma en punto para una  

       »                           correcta importación  

00497                         If c = "," Then c = "." 'separador decimal  

00498                         'caracter que incluir a la palabra  

00499                         p & = c 

00500      

00501                     End If 

00502                     If c = SP Or ( Asc ( c ) = Asc ( vbCrLf ) And j = columnas - 1 ) Then 

00503                         'pone palabra en matriz  

00504                         MatrizGenerica ( i , j ) = p 

00505      

00506                         'columnas = columnas + 1  

00507                         j = j + 1 

00508                         If j > columnas - 1 Then 

00509                             j = 0 

00510                         End If 

00511                         'resetea palabra  

00512                         p = "" 

00513                     End If 

00514                     If Asc ( c ) = Asc ( vbCrLf ) Then  'ha encontrado final de linea  

00515                         'filas = filas + 1  

00516                         i = i + 1 

00517                         'salta de línea  

00518                         'resetea palabra  

00519                         p = "" 

00520                     End If 

00521                 Next a 

00522                 pbImportar . Value = 4 * 100 / paso 

00523      

00524                 'Sustituir  

00525                 'se crean todos los datos de un nuevo grafo  

00526      

00527                 '-------------------------------------------  

00528                 If opSustituir . Checked = True Or ( Form1 . TotalNodos = 0 And  

       »                   opActualizar . Checked = True ) Then 

00529                     'también se usa esta rutina cuando no existe ningún grafo y se  

       »                       actualiza  

00530      

00531                     'Crea sólo una colección de nodos  

00532                     If opMatrizValor . Checked = True Or opMatrizEtiqueta . Checked =  

       »                       True Or opMatrizEtiquetaValor . Checked = True Then 

00533                         'Crea las dimensiones de nodos y arcos  

00534                         Form1 . TotalNodos = filas 

00535                         Form1 . TotalArcos = 0 

00536      

00537                         ReDim Form1 . Nodos ( Form1 . TotalNodos - 1 ) 

00538                         ReDim Form1 . Arcos ( 0 ) 

00539      

00540                         For i = 0 To filas - 1 

00541                             'Crea nodo con las opciones de dibujo básicas  

00542                             Form1 . Nodos ( i ) . X = Rnd () * Form1 . Grafico . TapizX 

00543                             Form1 . Nodos ( i ) . Y = Rnd () * Form1 . Grafico . TapizY 

00544                             Form1 . Nodos ( i ) . Col = Form1 . Grafico . ColNodo 

00545                             Form1 . Nodos ( i ) . Radio = Form1 . Grafico . RadioNodo 

00546                             Form1 . Nodos ( i ) . Grosor = Form1 . Grafico . TrazoNodo 

00547      

00548                             If opMatrizValor . Checked = True Then 

00549                                 Form1 . Nodos ( i ) . Valor = Val ( MatrizGenerica ( i , 0 )) 

00550                                 Form1 . Nodos ( i ) . Texto = i . ToString 

00551                             End If 

00552                             If opMatrizEtiqueta . Checked = True Then 

00553                                 Form1 . Nodos ( i ) . Valor = 0 

00554                                 Form1 . Nodos ( i ) . Texto = MatrizGenerica ( i , 0 ) 

00555                             End If 

00556                             If opMatrizEtiquetaValor . Checked = True Then 

00557                                 Form1 . Nodos ( i ) . Texto = MatrizGenerica ( i , 0 ) 

00558                                 Form1 . Nodos ( i ) . Valor = Val ( MatrizGenerica ( i , 1 )) 

00559                             End If 

00560                         Next i 

00561      

00562                     Else 

00563                         'se están importando matrices de arcos  

00564                         'primero crea los nodos necesarios  

00565      

00566                         'Crea las dimensiones de nodos y arcos  

00567                         Form1 . TotalNodos = filas 

00568                         Form1 . TotalArcos = 0 

00569      

00570                         ReDim Form1 . Nodos ( Form1 . TotalNodos - 1 ) 

00571                         ReDim Form1 . Arcos ( 0 ) 

00572      

00573                         For i = 0 To filas - 1 

00574                             'Crea nodo con las opciones de dibujo básicas  

00575                             Form1 . Nodos ( i ) . X = Rnd () * Form1 . Grafico . TapizX 

00576                             Form1 . Nodos ( i ) . Y = Rnd () * Form1 . Grafico . TapizY 

00577                             Form1 . Nodos ( i ) . Col = Form1 . Grafico . ColNodo 

00578                             Form1 . Nodos ( i ) . Radio = Form1 . Grafico . RadioNodo 

00579                             Form1 . Nodos ( i ) . Grosor = Form1 . Grafico . TrazoNodo 

00580                             Form1 . Nodos ( i ) . Valor = 0 

00581                             Form1 . Nodos ( i ) . Texto = i . ToString 

00582                         Next i 

00583      

00584                         'después recorre toda la matriz buscando arcos  

00585                         For i = 0 To filas - 1 

00586                             For j = 0 To columnas - 1 

00587                                 'mira si existe un arco  

00588                                 If MatrizGenerica ( i , j ) <> txtNV . Text Then 

00589                                     'existe si es un valor diferente del no valor  

00590      

00591                                     'redimensiona matrices de arcos  

00592                                     Form1 . TotalArcos = Form1 . TotalArcos + 1 

00593                                     a = Form1 . TotalArcos - 1 

00594                                     ReDim Preserve Form1 . Arcos ( Form1 . TotalArcos -  

       »                                       1 ) 

00595      

00596                                     Form1 . Arcos ( a ) . Texto = a . ToString 

00597                                     Form1 . Arcos ( a ) . Col = Form1 . Grafico . ColArco 

00598                                     Form1 . Arcos ( a ) . Grosor = Form1 . Grafico .  

       »                                       TrazoNodo 

00599                                     Form1 . Arcos ( a ) . Nd1 = i 

00600                                     Form1 . Arcos ( a ) . Nd2 = j 

00601      

00602                                     If opMatrizBinaria . Checked = True Then 

00603                                         Form1 . Arcos ( a ) . Min = 0 

00604                                         Form1 . Arcos ( a ) . Max = 0 

00605                                         Form1 . Arcos ( a ) . Coste = 0 

00606                                     End If 

00607                                     If opMatrizMinimo . Checked = True Then 

00608                                         Form1 . Arcos ( a ) . Min = Val ( MatrizGenerica ( i  

       »                                           , j )) 

00609                                         Form1 . Arcos ( a ) . Max = 0 

00610                                         Form1 . Arcos ( a ) . Coste = 0 

00611                                     End If 

00612                                     If opMatrizMaximo . Checked = True Then 

00613                                         Form1 . Arcos ( a ) . Min = 0 

00614                                         Form1 . Arcos ( a ) . Max = Val ( MatrizGenerica ( i  

       »                                           , j )) 

00615                                         Form1 . Arcos ( a ) . Coste = 0 

00616                                     End If 

00617                                     If opMatrizCoste . Checked = True Then 

00618                                         Form1 . Arcos ( a ) . Min = 0 

00619                                         Form1 . Arcos ( a ) . Max = 0 

00620                                         Form1 . Arcos ( a ) . Coste = Val ( MatrizGenerica  

       »                                           ( i , j )) 

00621                                     End If 

00622                                 End If 

00623                             Next j 

00624                         Next i 

00625                     End If 

00626                     pbImportar . Value = 5 * 100 / paso 

00627                 End If 'fin sustituir  

00628      

00629                 'Actualizar  

00630                 '----------  

00631                 If opActualizar . Checked = True And Form1 . TotalNodos > 0 Then 

00632      

00633                     'crea una copia de seguridad de los arcos existentes  

00634                     Dim vArcos () As Form1 . Arco 

00635                     ReDim vArcos ( Form1 . TotalArcos - 1 ) 

00636                     vArcos = Form1 . Arcos 

00637                     'guarda dimensiones del grafo existente  

00638                     Dim vTotalNodos As Long 

00639                     vTotalNodos = Form1 . TotalNodos 

00640                     Dim vTotalArcos As Long 

00641                     vTotalArcos = Form1 . TotalArcos 

00642      

00643                     'Crea las dimensiones de nodos y arcos para el nuevo grafo  

00644                     'Nodos  

00645                     Form1 . TotalNodos = filas 

00646                     ReDim Preserve Form1 . Nodos ( Form1 . TotalNodos - 1 ) 

00647      

00648                     'Arcos  

00649                     If opMatrizBinaria . Checked Or opMatrizMinimo . Checked Or  

       »                       opMatrizMaximo . Checked Or opMatrizCoste . Checked Then 

00650                         'primero recorre toda la matriz buscando arcos  

00651                         a = 0 

00652                         For i = 0 To filas - 1 

00653                             For j = 0 To columnas - 1 

00654                                 'mira si existe un arco  

00655                                 If MatrizGenerica ( i , j ) <> txtNV . Text Then 

00656                                     a = a + 1 

00657                                 End If 

00658                             Next j 

00659                         Next i 

00660      

00661                         Form1 . TotalArcos = a 

00662                         ReDim Preserve Form1 . Arcos ( Form1 . TotalArcos - 1 ) 

00663                     End If 

00664      

00665                     'Actualización de datos:  

00666                     'si existe arco o nodo se cambian los datos implicados  

00667                     'el resto los existentes  

00668      

00669                     'si se crea arco o nodo, se toma el dato implicado  

00670                     'el resto los valores por defecto  

00671      

00672                     'Actualización de nodos  

00673                     '----------------------  

00674                     'si Nf<=Nv se habrán borrado nodos de la parte alta matriz  

00675                     For i = 0 To Form1 . TotalNodos - 1 

00676                         'si Nf>Nv se deben crear nuevos nodos  

00677                         If ( i + 1 ) > vTotalNodos Then 

00678                             'Crea nodo con las opciones de dibujo básicas  

00679                             Form1 . Nodos ( i ) . X = Rnd () * Form1 . Grafico . TapizX 

00680                             Form1 . Nodos ( i ) . Y = Rnd () * Form1 . Grafico . TapizY 

00681                             Form1 . Nodos ( i ) . Col = Form1 . Grafico . ColNodo 

00682                             Form1 . Nodos ( i ) . Radio = Form1 . Grafico . RadioNodo 

00683                             Form1 . Nodos ( i ) . Grosor = Form1 . Grafico . TrazoNodo 

00684                             Form1 . Nodos ( i ) . Valor = 0 

00685                             Form1 . Nodos ( i ) . Texto = i . ToString 

00686                         End If 

00687                         'si hay que actualizar algo se actualiza  

00688                         If opMatrizValor . Checked = True Then 

00689                             Form1 . Nodos ( i ) . Valor = Val ( MatrizGenerica ( i , 0 )) 

00690                             Form1 . Nodos ( i ) . Texto = i . ToString 

00691                         End If 

00692                         If opMatrizEtiqueta . Checked = True Then 

00693                             Form1 . Nodos ( i ) . Valor = 0 

00694                             Form1 . Nodos ( i ) . Texto = MatrizGenerica ( i , 0 ) 

00695                         End If 

00696                         If opMatrizEtiquetaValor . Checked = True Then 

00697                             Form1 . Nodos ( i ) . Texto = MatrizGenerica ( i , 0 ) 

00698                             Form1 . Nodos ( i ) . Valor = Val ( MatrizGenerica ( i , 1 )) 

00699                         End If 

00700                     Next i 

00701      

00702                     'Actualización de arcos  

00703                     '----------------------  

00704                     'si se están actualizando datos de nodos...  

00705                     'si Nf<=Nv se deben borrar arcos implicados  

00706                     'el resto de datos se mantienen de los existentes  

00707                     If opMatrizValor . Checked = True Or opMatrizEtiqueta . Checked =  

       »                       True Or opMatrizEtiquetaValor . Checked = True Then 

00708                         Form1 . TotalArcos = 0 

00709                         For a = 0 To vTotalArcos - 1 

00710                             If vArcos ( a ) . Nd1 <= filas - 1 And vArcos ( a ) . Nd2 <=  

       »                               filas - 1 Then 

00711                                 'se trata de un arco existente con nodo origen y  

       »                                   final  

00712                                 'que hay que mantener en la nueva matriz de nodos  

00713      

00714                                 Form1 . TotalArcos = Form1 . TotalArcos + 1 

00715                                 ReDim Preserve Form1 . Arcos ( Form1 . TotalArcos - 1 ) 

00716      

00717                                 Form1 . Arcos ( Form1 . TotalArcos - 1 ) = vArcos ( a ) 

00718                             End If 

00719                         Next a 

00720                     End If 

00721      

00722                     'si se están actualizando datos de arcos...  

00723                     If opMatrizBinaria . Checked Or opMatrizMinimo . Checked Or  

       »                       opMatrizMaximo . Checked Or opMatrizCoste . Checked Then 

00724                         'si Af>Av se deben incluir arcos  

00725                         'si Af<=Av se deben borrar arcos  

00726                         'después recorre toda la matriz buscando arcos  

00727                         a = - 1 

00728                         For i = 0 To filas - 1 

00729                             For j = 0 To columnas - 1 

00730                                 'mira si existe un arco  

00731                                 If MatrizGenerica ( i , j ) <> txtNV . Text Then 

00732                                     'existe si es un valor diferente del no valor  

00733      

00734                                     'crea los arcos nuevos necesarios  

00735                                     a = a + 1 

00736                                     If ( a + 1 ) > vTotalArcos Then 

00737                                         Form1 . Arcos ( a ) . Texto = a . ToString 

00738                                         Form1 . Arcos ( a ) . Col = Form1 . Grafico .  

       »                                           ColArco 

00739                                         Form1 . Arcos ( a ) . Grosor = Form1 . Grafico .  

       »                                           TrazoNodo 

00740                                     End If 

00741      

00742                                     'Actualiza origen destino en todos  

00743                                     Form1 . Arcos ( a ) . Nd1 = i 

00744                                     Form1 . Arcos ( a ) . Nd2 = j 

00745                                     'actualiza valores de importación  

00746                                     'If opMatrizBinaria.Checked = True Then  

00747                                     'End If  

00748                                     If opMatrizMinimo . Checked = True Then 

00749                                         Form1 . Arcos ( a ) . Min = Val ( MatrizGenerica ( i  

       »                                           , j )) 

00750                                         Form1 . Arcos ( a ) . Max = 0 

00751                                         Form1 . Arcos ( a ) . Coste = 0 

00752                                     End If 

00753                                     If opMatrizMaximo . Checked = True Then 

00754                                         Form1 . Arcos ( a ) . Min = 0 

00755                                         Form1 . Arcos ( a ) . Max = Val ( MatrizGenerica ( i  

       »                                           , j )) 

00756                                         Form1 . Arcos ( a ) . Coste = 0 

00757                                     End If 

00758                                     If opMatrizCoste . Checked = True Then 

00759                                         Form1 . Arcos ( a ) . Min = 0 

00760                                         Form1 . Arcos ( a ) . Max = 0 

00761                                         Form1 . Arcos ( a ) . Coste = Val ( MatrizGenerica  

       »                                           ( i , j )) 

00762                                     End If 

00763                                 End If 

00764                             Next j 

00765                         Next i 

00766                     End If 

00767      

00768                     pbImportar . Value = 5 * 100 / paso 

00769                 End If 'fin actualizar  

00770      

00771      

00772                 'en caso de error  

00773             Catch ex As Exception 

00774                 Me . Cursor = Cursors . Default 

00775                 MsgBox ( "Ha fallado el proceso de importar datos." & vbCrLf & ex .  

       »                   Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

00776                 'habilita botones y cursor ratón  

00777                 btnImportar . Enabled = True 

00778                 btnCancelar . Enabled = True 

00779                 gbOpciones . Enabled = True 

00780                 pbImportar . Value = 0 * 100 / paso 

00781                 Me . Cursor = Cursors . Default 

00782                 Exit Sub 

00783             Finally 

00784             End Try 

00785      

00786             'habilita botones y cursor ratón  

00787             btnImportar . Enabled = True 

00788             btnCancelar . Enabled = True 

00789             gbOpciones . Enabled = True 

00790             Me . Cursor = Cursors . Default 

00791             pbImportar . Value = 0 * 100 / paso 

00792             'Dibuja el grafo  

00793             RaiseEvent ActualizaGrafo ( True ) 

00794         End Sub 

00795         Private Sub chkSPTab_CheckedChanged ( ByVal sender As Object , ByVal e As  

       »           System . EventArgs ) Handles chkSPTab . CheckedChanged 

00796             If chkSPTab . Checked = True Then 

00797                 txtSP . Enabled = False 

00798             Else 

00799                 txtSP . Enabled = True 

00800             End If 

00801         End Sub 

00802         Private Sub txtFL_KeyPress ( ByVal sender As Object , ByVal e As System . Windows  

       »           . Forms . KeyPressEventArgs ) Handles txtFL . KeyPress 

00803             'carácter de fín de línea  

00804             'no se permiten números  

00805             'si se permite coma  

00806             'no se permite punto  

00807             'no se permite + -  

00808             'se permite vacío  

00809             If e . KeyChar = "-" Or e . KeyChar = "+" Or ( e . KeyChar >= "0" And e . KeyChar 

       »               <= "9" ) Or e . KeyChar = "." Then 

00810                 'carácter no permitido  

00811                 e . Handled = True 

00812             Else 

00813             End If 

00814         End Sub 

00815         Private Sub txtSP_KeyPress ( ByVal sender As Object , ByVal e As System . Windows  

       »           . Forms . KeyPressEventArgs ) Handles txtSP . KeyPress 

00816             'carácter de separación  

00817             'si se permite coma  

00818             'no se permite punto  

00819             'no se permite + -  

00820             'no se permite vacío (se controla en btnExportar)  

00821             If e . KeyChar = "-" Or e . KeyChar = "+" Or ( e . KeyChar >= "0" And e . KeyChar 

       »               <= "9" ) Or e . KeyChar = "." Then 

00822                 'carácter no permitido  

00823                 e . Handled = True 

00824             Else 

00825             End If 

00826         End Sub 

00827         Private Sub txtNV_KeyPress ( ByVal sender As Object , ByVal e As System . Windows  

       »           . Forms . KeyPressEventArgs ) Handles txtNV . KeyPress 

00828             'carácter de 'no valor'  

00829             'no se permiten números (sólo el cero 0)  

00830             'no se permite coma  

00831             'no se permite punto  

00832             'si se permite + -  

00833             'si se permite vacío  

00834             If ( e . KeyChar >= "1" And e . KeyChar <= "9" ) Or e . KeyChar = "," Or e .  

       »               KeyChar = "." Then 

00835                 'carácter no permitido  

00836                 e . Handled = True 

00837             Else 

00838             End If 

00839         End Sub 

00840      

00841         Private Sub txtSP_TextChanged ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles txtSP . TextChanged 

00842      

00843         End Sub 

00844     End Class 

00001     Public Class frmNuevoAleatorio 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents btnCancelar As System . Windows . Forms . Button 

00033         Friend WithEvents GroupBox1 As System . Windows . Forms . GroupBox 

00034         Friend WithEvents Label1 As System . Windows . Forms . Label 

00035         Friend WithEvents Label2 As System . Windows . Forms . Label 

00036         Friend WithEvents udTNodos As System . Windows . Forms . NumericUpDown 

00037         Friend WithEvents udTArcos As System . Windows . Forms . NumericUpDown 

00038         Friend WithEvents btnCrear As System . Windows . Forms . Button 

00039         Friend WithEvents chkArcosMismoNodo As System . Windows . Forms . CheckBox 

00040         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00041             Me . btnCrear = New System . Windows . Forms . Button 

00042             Me . btnCancelar = New System . Windows . Forms . Button 

00043             Me . GroupBox1 = New System . Windows . Forms . GroupBox 

00044             Me . udTNodos = New System . Windows . Forms . NumericUpDown 

00045             Me . Label1 = New System . Windows . Forms . Label 

00046             Me . udTArcos = New System . Windows . Forms . NumericUpDown 

00047             Me . Label2 = New System . Windows . Forms . Label 

00048             Me . chkArcosMismoNodo = New System . Windows . Forms . CheckBox 

00049             Me . GroupBox1 . SuspendLayout () 

00050             CType ( Me . udTNodos , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00051             CType ( Me . udTArcos , System . ComponentModel . ISupportInitialize ) . BeginInit () 

00052             Me . SuspendLayout () 

00053             '  

00054             'btnCrear  

00055             '  

00056             Me . btnCrear . Location = New System . Drawing . Point ( 176 , 112 ) 

00057             Me . btnCrear . Name = "btnCrear" 

00058             Me . btnCrear . Size = New System . Drawing . Size ( 88 , 24 ) 

00059             Me . btnCrear . TabIndex = 5 

00060             Me . btnCrear . Text = "Crear" 

00061             '  

00062             'btnCancelar  

00063             '  

00064             Me . btnCancelar . Location = New System . Drawing . Point ( 272 , 112 ) 

00065             Me . btnCancelar . Name = "btnCancelar" 

00066             Me . btnCancelar . Size = New System . Drawing . Size ( 88 , 24 ) 

00067             Me . btnCancelar . TabIndex = 4 

00068             Me . btnCancelar . Text = "Cancelar" 

00069             '  

00070             'GroupBox1  

00071             '  

00072             Me . GroupBox1 . Controls . Add ( Me . chkArcosMismoNodo ) 

00073             Me . GroupBox1 . Controls . Add ( Me . udTNodos ) 

00074             Me . GroupBox1 . Controls . Add ( Me . Label1 ) 

00075             Me . GroupBox1 . Controls . Add ( Me . udTArcos ) 

00076             Me . GroupBox1 . Controls . Add ( Me . Label2 ) 

00077             Me . GroupBox1 . Location = New System . Drawing . Point ( 8 , 8 ) 

00078             Me . GroupBox1 . Name = "GroupBox1" 

00079             Me . GroupBox1 . Size = New System . Drawing . Size ( 352 , 96 ) 

00080             Me . GroupBox1 . TabIndex = 6 

00081             Me . GroupBox1 . TabStop = False 

00082             '  

00083             'udTNodos  

00084             '  

00085             Me . udTNodos . Location = New System . Drawing . Point ( 88 , 24 ) 

00086             Me . udTNodos . Maximum = New Decimal ( New Integer () { 200 , 0 , 0 , 0 }) 

00087             Me . udTNodos . Minimum = New Decimal ( New Integer () { 1 , 0 , 0 , 0 }) 

00088             Me . udTNodos . Name = "udTNodos" 

00089             Me . udTNodos . Size = New System . Drawing . Size ( 56 , 20 ) 

00090             Me . udTNodos . TabIndex = 11 

00091             Me . udTNodos . Value = New Decimal ( New Integer () { 30 , 0 , 0 , 0 }) 

00092             '  

00093             'Label1  

00094             '  

00095             Me . Label1 . Location = New System . Drawing . Point ( 16 , 24 ) 

00096             Me . Label1 . Name = "Label1" 

00097             Me . Label1 . Size = New System . Drawing . Size ( 72 , 16 ) 

00098             Me . Label1 . TabIndex = 1 

00099             Me . Label1 . Text = "Total Nodos:" 

00100             '  

00101             'udTArcos  

00102             '  

00103             Me . udTArcos . Location = New System . Drawing . Point ( 280 , 24 ) 

00104             Me . udTArcos . Name = "udTArcos" 

00105             Me . udTArcos . Size = New System . Drawing . Size ( 56 , 20 ) 

00106             Me . udTArcos . TabIndex = 11 

00107             Me . udTArcos . Value = New Decimal ( New Integer () { 50 , 0 , 0 , 0 }) 

00108             '  

00109             'Label2  

00110             '  

00111             Me . Label2 . Location = New System . Drawing . Point ( 160 , 24 ) 

00112             Me . Label2 . Name = "Label2" 

00113             Me . Label2 . Size = New System . Drawing . Size ( 128 , 16 ) 

00114             Me . Label2 . TabIndex = 1 

00115             Me . Label2 . Text = "Densidad de Arcos (%):" 

00116             '  

00117             'chkArcosMismoNodo  

00118             '  

00119             Me . chkArcosMismoNodo . Location = New System . Drawing . Point ( 16 , 56 ) 

00120             Me . chkArcosMismoNodo . Name = "chkArcosMismoNodo" 

00121             Me . chkArcosMismoNodo . Size = New System . Drawing . Size ( 232 , 24 ) 

00122             Me . chkArcosMismoNodo . TabIndex = 12 

00123             Me . chkArcosMismoNodo . Text = "Arcos sobre un mismo nodo" 

00124             '  

00125             'frmNuevoAleatorio  

00126             '  

00127             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00128             Me . ClientSize = New System . Drawing . Size ( 368 , 143 ) 

00129             Me . ControlBox = False 

00130             Me . Controls . Add ( Me . GroupBox1 ) 

00131             Me . Controls . Add ( Me . btnCrear ) 

00132             Me . Controls . Add ( Me . btnCancelar ) 

00133             Me . Cursor = System . Windows . Forms . Cursors . Default 

00134             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00135             Me . Name = "frmNuevoAleatorio" 

00136             Me . Text = "Grafos - Opciones de generación de grafo aleatorio" 

00137             Me . TopMost = True 

00138             Me . GroupBox1 . ResumeLayout ( False ) 

00139             CType ( Me . udTNodos , System . ComponentModel . ISupportInitialize ) . EndInit () 

00140             CType ( Me . udTArcos , System . ComponentModel . ISupportInitialize ) . EndInit () 

00141             Me . ResumeLayout ( False ) 

00142      

00143         End Sub 

00144      

00145     # End Region 

00146      

00147         Public Event ActualizaGrafo ( ByVal valor As Boolean , ByVal n As Long , ByVal a 

       »           As Long , ByVal r As Boolean ) 

00148      

00149         Private Sub btnCancelar_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles btnCancelar . Click 

00150             RaiseEvent ActualizaGrafo ( False , 0 , 0 , False ) 

00151             Me . Visible = False 

00152         End Sub 

00153      



00154         Private Sub btnCrear_Click ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles btnCrear . Click 

00155             'deshabilita botones y cursor ratón  

00156             Me . Cursor = Cursors . WaitCursor 

00157             btnCrear . Enabled = False 

00158             btnCancelar . Enabled = False 

00159      

00160             RaiseEvent ActualizaGrafo ( True , udTNodos . Value , udTArcos . Value ,  

       »               chkArcosMismoNodo . Checked ) 

00161      

00162      

00163             'habilita botones y cursor ratón  

00164             Me . Cursor = Cursors . Default 

00165             btnCrear . Enabled = True 

00166             btnCancelar . Enabled = True 

00167             Me . Visible = False 

00168         End Sub 

00169     End Class 

00001     Option Strict Off 

00002     Option Explicit On 

00003     Friend Class lpsolve51 

00004      

00005         'lpsolve version 5 routines  

00006      

00007         Private Declare Function SetEnvironmentVariableA Lib "kernel32" ( ByVal lpname 

       »           As String , ByVal lpValue As String ) As Integer 

00008         Private Declare Function GetEnvironmentVariableA Lib "kernel32" ( ByVal lpname 

       »           As String , ByVal lpBuffer As String , ByVal nSize As Integer ) As Integer 

00009      

00010         '---------------------------------------------------------------------------- 

       »           ------------------------------------------------- 

00011      

00012         Public Declare Function add_column Lib "lpsolve51.dll" Alias "add_column" (  

       »           ByVal lp As Integer , ByRef column As Double ) As Boolean 

00013         Public Declare Function add_columnex Lib "lpsolve51.dll" Alias "add_columnex" 

       »           ( ByVal lp As Integer , ByVal count As Integer , ByRef column As Double ,  

       »           ByRef rowno As Integer ) As Boolean 

00014         Public Declare Function add_constraint Lib "lpsolve51.dll" Alias  

       »           "add_constraint" ( ByVal lp As Integer , ByRef row As Double , ByVal  

       »           constr_type As lpsolve_constr_types , ByVal rh As Double ) As Boolean 

00015         Public Declare Function add_constraintex Lib "lpsolve51.dll" Alias  

       »           "add_constraintex" ( ByVal lp As Integer , ByVal count As Integer , ByRef  

       »           row As Double , ByRef colno As Integer , ByVal constr_type As  

       »           lpsolve_constr_types , ByVal rh As Double ) As Boolean 

00016         Public Declare Function add_lag_con Lib "lpsolve51.dll" Alias "add_lag_con" (  

       »           ByVal lp As Integer , ByRef row As Double , ByVal con_type As  

       »           lpsolve_constr_types , ByVal rhs As Double ) As Boolean 

00017         Public Declare Function add_SOS Lib "lpsolve51.dll" Alias "add_SOS" ( ByVal lp 

       »           As Integer , ByVal name As String , ByVal sostype As Integer , ByVal  

       »           priority As Integer , ByVal count As Integer , ByRef sosvars As Integer ,  

       »           ByRef weights As Double ) As Integer 

00018         Public Declare Function column_in_lp Lib "lpsolve51.dll" Alias "column_in_lp" 

       »           ( ByVal lp As Integer , ByRef column As Double ) As Integer 

00019         Public Declare Sub default_basis Lib "lpsolve51.dll" Alias "default_basis" (  

       »           ByVal lp As Integer ) 

00020         Public Declare Function del_column Lib "lpsolve51.dll" Alias "del_column" (  

       »           ByVal lp As Integer , ByVal column As Integer ) As Boolean 

00021         Public Declare Function del_constraint Lib "lpsolve51.dll" Alias  

       »           "del_constraint" ( ByVal lp As Integer , ByVal del_row As Integer ) As  

       »           Boolean 

00022         Public Declare Sub delete_lp Lib "lpsolve51.dll" Alias "delete_lp" ( ByVal lp  

       »           As Integer ) 

00023         Public Declare Function get_anti_degen Lib "lpsolve51.dll" Alias  

       »           "get_anti_degen" ( ByVal lp As Integer ) As lpsolve_anti_degen 

00024         Public Declare Sub get_basis Lib "lpsolve51.dll" Alias "get_basis" ( ByVal lp  

       »           As Integer , ByRef bascolumn As Integer , ByVal nonbasic As Boolean ) 

00025         Public Declare Function get_basiscrash Lib "lpsolve51.dll" Alias  

       »           "get_basiscrash" ( ByVal lp As Integer ) As lpsolve_basiscrash 

00026         Public Declare Function get_bb_depthlimit Lib "lpsolve51.dll" Alias  

       »           "get_bb_depthlimit" ( ByVal lp As Integer ) As Integer 

00027         Public Declare Function get_bb_floorfirst Lib "lpsolve51.dll" Alias  

       »           "get_bb_floorfirst" ( ByVal lp As Integer ) As lpsolve_branch 

00028         Public Declare Function get_bb_rule Lib "lpsolve51.dll" Alias "get_bb_rule" (  

       »           ByVal lp As Integer ) As lpsolve_BBstrategies 

00029         Public Declare Function get_bounds_tighter Lib "lpsolve51.dll" Alias  

       »           "get_bounds_tighter" ( ByVal lp As Integer ) As Boolean 

00030         Public Declare Function get_break_at_value Lib "lpsolve51.dll" Alias  

       »           "get_break_at_value" ( ByVal lp As Integer ) As Double 

00031         Public Declare Function get_col_name Lib "lpsolve51.dll" Alias "get_col_name" 

       »           ( ByVal lp As Integer , ByVal column As Integer ) As String 

00032         Public Declare Function get_column Lib "lpsolve51.dll" Alias "get_column" (  

       »           ByVal lp As Integer , ByVal col_nr As Integer , ByRef column As Double ) As  

       »           Boolean 

00033         Public Declare Function get_constr_type Lib "lpsolve51.dll" Alias  

       »           "get_constr_type" ( ByVal lp As Integer , ByVal row As Integer ) As  

       »           lpsolve_constr_types 

00034         Public Declare Function get_constraints Lib "lpsolve51.dll" Alias  

       »           "get_constraints" ( ByVal lp As Integer , ByRef constr As Double ) As  

       »           Boolean 

00035         Public Declare Function get_dual_solution Lib "lpsolve51.dll" Alias  

       »           "get_dual_solution" ( ByVal lp As Integer , ByRef rc As Double ) As Boolean 

00036         Public Declare Function get_epsb Lib "lpsolve51.dll" Alias "get_epsb" ( ByVal  

       »           lp As Integer ) As Double 

00037         Public Declare Function get_epsd Lib "lpsolve51.dll" Alias "get_epsd" ( ByVal  

       »           lp As Integer ) As Double 

00038         Public Declare Function get_epsel Lib "lpsolve51.dll" Alias "get_epsel" (  

       »           ByVal lp As Integer ) As Double 

00039         Public Declare Function get_epsint Lib "lpsolve51.dll" Alias "get_epsint" (  

       »           ByVal lp As Integer ) As Double 

00040         Public Declare Function get_epsperturb Lib "lpsolve51.dll" Alias  

       »           "get_epsperturb" ( ByVal lp As Integer ) As Double 

00041         Public Declare Function get_epspivot Lib "lpsolve51.dll" Alias "get_epspivot" 

       »           ( ByVal lp As Integer ) As Double 

00042         Public Declare Function get_improve Lib "lpsolve51.dll" Alias "get_improve" (  

       »           ByVal lp As Integer ) As lpsolve_improves 

00043         Public Declare Function get_infinite Lib "lpsolve51.dll" Alias "get_infinite" 

       »           ( ByVal lp As Integer ) As Double 

00044         Public Declare Function get_lambda Lib "lpsolve51.dll" Alias "get_lambda" (  

       »           ByVal lp As Integer , ByRef lambda As Double ) As Boolean 

00045         Public Declare Function get_lowbo Lib "lpsolve51.dll" Alias "get_lowbo" (  

       »           ByVal lp As Integer , ByVal column As Integer ) As Double 

00046         Public Declare Function get_lp_index Lib "lpsolve51.dll" Alias "get_lp_index" 

       »           ( ByVal lp As Integer , ByVal orig_index As Integer ) As Integer 

00047         Public Declare Function get_lp_name Lib "lpsolve51.dll" Alias "get_lp_name" (  

       »           ByVal lp As Integer ) As String 

00048         Public Declare Function get_Lrows Lib "lpsolve51.dll" Alias "get_Lrows" (  

       »           ByVal lp As Integer ) As Integer 

00049         Public Declare Function get_mat Lib "lpsolve51.dll" Alias "get_mat" ( ByVal lp 

       »           As Integer , ByVal row As Integer , ByVal column As Integer ) As Double 

00050         Public Declare Function get_max_level Lib "lpsolve51.dll" Alias  

       »           "get_max_level" ( ByVal lp As Integer ) As Integer 

00051         Public Declare Function get_maxpivot Lib "lpsolve51.dll" Alias "get_maxpivot" 

       »           ( ByVal lp As Integer ) As Integer 

00052         Public Declare Function get_mip_gap Lib "lpsolve51.dll" Alias "get_mip_gap" (  

       »           ByVal lp As Integer , ByVal absolute As Boolean ) As Double 

00053         Public Declare Function get_Ncolumns Lib "lpsolve51.dll" Alias "get_Ncolumns" 

       »           ( ByVal lp As Integer ) As Integer 

00054         Public Declare Function get_negrange Lib "lpsolve51.dll" Alias "get_negrange" 

       »           ( ByVal lp As Integer ) As Double 

00055         Public Declare Function get_nameindex Lib "lpsolve51.dll" Alias  

       »           "get_nameindex" ( ByVal lp As Integer , ByVal name As String , ByVal isrow  

       »           As Boolean ) As Integer 

00056         Public Declare Function get_nonzeros Lib "lpsolve51.dll" Alias "get_nonzeros" 

       »           ( ByVal lp As Integer ) As Integer 

00057         Public Declare Function get_Norig_columns Lib "lpsolve51.dll" Alias  

       »           "get_Norig_columns" ( ByVal lp As Integer ) As Integer 

00058         Public Declare Function get_Norig_rows Lib "lpsolve51.dll" Alias  

       »           "get_Norig_rows" ( ByVal lp As Integer ) As Integer 

00059         Public Declare Function get_Nrows Lib "lpsolve51.dll" Alias "get_Nrows" (  

       »           ByVal lp As Integer ) As Integer 

00060         Public Declare Function get_obj_bound Lib "lpsolve51.dll" Alias  

       »           "get_obj_bound" ( ByVal lp As Integer ) As Double 

00061         Public Declare Function get_objective Lib "lpsolve51.dll" Alias  

       »           "get_objective" ( ByVal lp As Integer ) As Double 

00062         Public Declare Function get_orig_index Lib "lpsolve51.dll" Alias  

       »           "get_orig_index" ( ByVal lp As Integer , ByVal lp_index As Integer ) As  

       »           Integer 

00063         Public Declare Function get_origcol_name Lib "lpsolve51.dll" Alias  

       »           "get_origcol_name" ( ByVal lp As Integer , ByVal column As Integer ) As  

       »           String 

00064         Public Declare Function get_origrow_name Lib "lpsolve51.dll" Alias  

       »           "get_origrow_name" ( ByVal lp As Integer , ByVal row As Integer ) As String 

00065         Public Declare Function get_pivoting Lib "lpsolve51.dll" Alias "get_pivoting" 

       »           ( ByVal lp As Integer ) As lpsolve_piv_rules 

00066         Public Declare Function get_presolve Lib "lpsolve51.dll" Alias "get_presolve" 

       »           ( ByVal lp As Integer ) As lpsolve_presolve 

00067         Public Declare Function get_primal_solution Lib "lpsolve51.dll" Alias  

       »           "get_primal_solution" ( ByVal lp As Integer , ByRef pv_Renamed As Double )  

       »           As Boolean 

00068         Public Declare Function get_print_sol Lib "lpsolve51.dll" Alias  

       »           "get_print_sol" ( ByVal lp As Integer ) As Integer 

00069         Public Declare Function get_PseudoCosts Lib "lpsolve51.dll" Alias  

       »           "get_PseudoCosts" ( ByVal lp As Integer , ByRef clower As Double , ByRef  

       »           cupper As Double , ByRef updatelimit As Integer ) As Boolean 

00070         Public Declare Function get_rh Lib "lpsolve51.dll" Alias "get_rh" ( ByVal lp  

       »           As Integer , ByVal row As Integer ) As Double 

00071         Public Declare Function get_rh_range Lib "lpsolve51.dll" Alias "get_rh_range" 

       »           ( ByVal lp As Integer , ByVal row As Integer ) As Double 

00072         Public Declare Function get_row Lib "lpsolve51.dll" Alias "get_row" ( ByVal lp 

       »           As Integer , ByVal row_nr As Integer , ByRef row As Double ) As Boolean 

00073         Public Declare Function get_row_name Lib "lpsolve51.dll" Alias "get_row_name" 

       »           ( ByVal lp As Integer , ByVal row As Integer ) As String 

00074         Public Declare Function get_scalelimit Lib "lpsolve51.dll" Alias  

       »           "get_scalelimit" ( ByVal lp As Integer ) As Double 

00075         Public Declare Function get_scaling Lib "lpsolve51.dll" Alias "get_scaling" (  

       »           ByVal lp As Integer ) As lpsolve_scales 

00076         Public Declare Function get_sensitivity_obj Lib "lpsolve51.dll" Alias  

       »           "get_sensitivity_obj" ( ByVal lp As Integer , ByRef objfrom As Double ,  

       »           ByRef objtill As Double ) As Boolean 

00077         Public Declare Function get_sensitivity_objex Lib "lpsolve51.dll" Alias  

       »           "get_sensitivity_objex" ( ByVal lp As Integer , ByRef objfrom As Double ,  

       »           ByRef objtill As Double , ByRef objfromvalue As Double , ByRef objtillvalue 

       »           As Double ) As Boolean 

00078         Public Declare Function get_sensitivity_rhs Lib "lpsolve51.dll" Alias  

       »           "get_sensitivity_rhs" ( ByVal lp As Integer , ByRef duals As Double , ByRef  

       »           dualsfrom As Double , ByRef dualstill As Double ) As Boolean 

00079         Public Declare Function get_simplextype Lib "lpsolve51.dll" Alias  

       »           "get_simplextype" ( ByVal lp As Integer ) As lpsolve_simplextypes 

00080         Public Declare Function get_solutioncount Lib "lpsolve51.dll" Alias  

       »           "get_solutioncount" ( ByVal lp As Integer ) As Integer 

00081         Public Declare Function get_solutionlimit Lib "lpsolve51.dll" Alias  

       »           "get_solutionlimit" ( ByVal lp As Integer ) As Integer 

00082         Public Declare Function get_status Lib "lpsolve51.dll" Alias "get_status" (  

       »           ByVal lp As Integer ) As Integer 

00083         Public Declare Function get_statustext Lib "lpsolve51.dll" Alias  

       »           "get_statustext" ( ByVal lp As Integer , ByVal statuscode As Integer ) As  

       »           String 

00084         Public Declare Function get_timeout Lib "lpsolve51.dll" Alias "get_timeout" (  

       »           ByVal lp As Integer ) As Integer 

00085         Public Declare Function get_total_iter Lib "lpsolve51.dll" Alias  

       »           "get_total_iter" ( ByVal lp As Integer ) As Integer 

00086         Public Declare Function get_total_nodes Lib "lpsolve51.dll" Alias  

       »           "get_total_nodes" ( ByVal lp As Integer ) As Integer 

00087         Public Declare Function get_upbo Lib "lpsolve51.dll" Alias "get_upbo" ( ByVal  

       »           lp As Integer , ByVal column As Integer ) As Double 

00088         Public Declare Function get_var_branch Lib "lpsolve51.dll" Alias  

       »           "get_var_branch" ( ByVal lp As Integer , ByVal column As Integer ) As  

       »           lpsolve_branch 

00089         Public Declare Function get_var_dualresult Lib "lpsolve51.dll" Alias  

       »           "get_var_dualresult" ( ByVal lp As Integer , ByVal index As Integer ) As  

       »           Double 

00090         Public Declare Function get_var_primalresult Lib "lpsolve51.dll" Alias  

       »           "get_var_primalresult" ( ByVal lp As Integer , ByVal index As Integer ) As  

       »           Double 

00091         Public Declare Function get_var_priority Lib "lpsolve51.dll" Alias  

       »           "get_var_priority" ( ByVal lp As Integer , ByVal column As Integer ) As  

       »           Integer 

00092         Public Declare Function get_variables Lib "lpsolve51.dll" Alias  

       »           "get_variables" ( ByVal lp As Integer , ByRef var As Double ) As Boolean 

00093         Public Declare Function get_verbose Lib "lpsolve51.dll" Alias "get_verbose" (  

       »           ByVal lp As Integer ) As Integer 

00094         Public Declare Function get_working_objective Lib "lpsolve51.dll" Alias  

       »           "get_working_objective" ( ByVal lp As Integer ) As Double 

00095         Public Declare Function has_BFP Lib "lpsolve51.dll" Alias "has_BFP" ( ByVal lp 

       »           As Integer ) As Boolean 

00096         Public Declare Function has_XLI Lib "lpsolve51.dll" Alias "has_XLI" ( ByVal lp 

       »           As Integer ) As Boolean 

00097         Public Declare Function is_add_rowmode Lib "lpsolve51.dll" Alias  

       »           "is_add_rowmode" ( ByVal lp As Integer ) As Boolean 

00098         Public Declare Function is_anti_degen Lib "lpsolve51.dll" Alias  

       »           "is_anti_degen" ( ByVal lp As Integer , ByVal testmask As  

       »           lpsolve_anti_degen ) As Boolean 

00099         Public Declare Function is_binary Lib "lpsolve51.dll" Alias "is_binary" (  

       »           ByVal lp As Integer , ByVal column As Integer ) As Boolean 

00100         Public Declare Function is_break_at_first Lib "lpsolve51.dll" Alias  

       »           "is_break_at_first" ( ByVal lp As Integer ) As Boolean 

00101         Public Declare Function is_constr_type Lib "lpsolve51.dll" Alias  

       »           "is_constr_type" ( ByVal lp As Integer , ByVal row As Integer , ByVal mask  

       »           As Integer ) As Boolean 

00102         Public Declare Function is_debug Lib "lpsolve51.dll" Alias "is_debug" ( ByVal  

       »           lp As Integer ) As Boolean 

00103         Public Declare Function is_feasible Lib "lpsolve51.dll" Alias "is_feasible" (  

       »           ByVal lp As Integer , ByRef values As Double , ByVal threshold As Double )  

       »           As Boolean 

00104         Public Declare Function is_free Lib "lpsolve51.dll" Alias "is_free" ( ByVal lp 

       »           As Integer , ByVal column As Integer ) As Boolean 

00105         Public Declare Function is_infinite Lib "lpsolve51.dll" Alias "is_infinite" (  

       »           ByVal lp As Integer , ByVal value As Double ) As Boolean 

00106         Public Declare Function is_int Lib "lpsolve51.dll" Alias "is_int" ( ByVal lp  

       »           As Integer , ByVal column As Integer ) As Boolean 

00107         Public Declare Function is_integerscaling Lib "lpsolve51.dll" Alias  

       »           "is_integerscaling" ( ByVal lp As Integer ) As Boolean 

00108         Public Declare Function is_lag_trace Lib "lpsolve51.dll" Alias "is_lag_trace" 

       »           ( ByVal lp As Integer ) As Boolean 

00109         Public Declare Function is_maxim Lib "lpsolve51.dll" Alias "is_maxim" ( ByVal  

       »           lp As Integer ) As Boolean 

00110         Public Declare Function is_nativeBFP Lib "lpsolve51.dll" Alias "is_nativeBFP" 

       »           ( ByVal lp As Integer ) As Boolean 

00111         Public Declare Function is_nativeXLI Lib "lpsolve51.dll" Alias "is_nativeXLI" 

       »           ( ByVal lp As Integer ) As Boolean 

00112         Public Declare Function is_negative Lib "lpsolve51.dll" Alias "is_negative" (  

       »           ByVal lp As Integer , ByVal column As Integer ) As Boolean 

00113         Public Declare Function is_piv_mode Lib "lpsolve51.dll" Alias "is_piv_mode" (  

       »           ByVal lp As Integer , ByVal testmask As lpsolve_piv_rules ) As Boolean 

00114         Public Declare Function is_piv_rule Lib "lpsolve51.dll" Alias "is_piv_rule" (  

       »           ByVal lp As Integer , ByVal rule As lpsolve_piv_rules ) As Boolean 

00115         Public Declare Function is_presolve Lib "lpsolve51.dll" Alias "is_presolve" (  

       »           ByVal lp As Integer , ByVal testmask As lpsolve_presolve ) As Boolean 

00116         Public Declare Function is_scalemode Lib "lpsolve51.dll" Alias "is_scalemode" 

       »           ( ByVal lp As Integer , ByVal testmask As lpsolve_scales ) As Boolean 

00117         Public Declare Function is_scaletype Lib "lpsolve51.dll" Alias "is_scaletype" 

       »           ( ByVal lp As Integer , ByVal scaletype As lpsolve_scales ) As Boolean 

00118         Public Declare Function is_semicont Lib "lpsolve51.dll" Alias "is_semicont" (  

       »           ByVal lp As Integer , ByVal column As Integer ) As Boolean 

00119         Public Declare Function is_SOS_var Lib "lpsolve51.dll" Alias "is_SOS_var" (  

       »           ByVal lp As Integer , ByVal column As Integer ) As Boolean 

00120         Public Declare Function is_trace Lib "lpsolve51.dll" Alias "is_trace" ( ByVal  

       »           lp As Integer ) As Boolean 

00121         Public Declare Sub version Lib "lpsolve51.dll" Alias "lp_solve_version" (  

       »           ByRef majorversion As Integer , ByRef minorversion As Integer , ByRef  

       »           release As Integer , ByRef build As Integer ) 

00122         Public Declare Function make_lp Lib "lpsolve51.dll" Alias "make_lp" ( ByVal  

       »           rows As Integer , ByVal columns As Integer ) As Integer 

00123         Public Declare Sub print_constraints Lib "lpsolve51.dll" Alias  

       »           "print_constraints" ( ByVal lp As Integer , ByVal columns As Integer ) 

00124         Public Declare Function print_debugdump Lib "lpsolve51.dll" Alias  

       »           "print_debugdump" ( ByVal lp As Integer , ByVal filename As String ) As  

       »           Boolean 

00125         Public Declare Sub print_duals Lib "lpsolve51.dll" Alias "print_duals" ( ByVal 

       »           lp As Integer ) 

00126         Public Declare Sub print_lp Lib "lpsolve51.dll" Alias "print_lp" ( ByVal lp As 

       »           Integer ) 

00127         Public Declare Sub print_objective Lib "lpsolve51.dll" Alias  

       »           "print_objective" ( ByVal lp As Integer ) 

00128         Public Declare Sub print_scales Lib "lpsolve51.dll" Alias "print_scales" (  

       »           ByVal lp As Integer ) 

00129         Public Declare Sub print_solution Lib "lpsolve51.dll" Alias "print_solution"  

       »           ( ByVal lp As Integer , ByVal columns As Integer ) 

00130         Public Declare Sub print_str Lib "lpsolve51.dll" Alias "print_str" ( ByVal lp  

       »           As Integer , ByVal str_Renamed As String ) 

00131         Public Declare Sub print_tableau Lib "lpsolve51.dll" Alias "print_tableau" (  

       »           ByVal lp As Integer ) 

00132         Public Delegate Function abortfunc ( ByVal lp As Integer , ByVal userhandle As  

       »           Integer ) As Integer 

00133         Public Declare Sub put_abortfunc Lib "lpsolve51.dll" Alias "put_abortfunc" (  

       »           ByVal lp As Integer , ByVal newctrlc As abortfunc , ByVal ctrlchandle As  

       »           Integer ) 

00134         Public Delegate Sub logfunc ( ByVal lp As Integer , ByVal userhandle As Integer  

       »           , ByVal buf As String ) 

00135         Public Declare Sub put_logfunc Lib "lpsolve51.dll" Alias "put_logfunc" ( ByVal 

       »           lp As Integer , ByVal newlog As logfunc , ByVal loghandle As Integer ) 

00136         Public Delegate Sub msgfunc ( ByVal lp As Integer , ByVal userhandle As Integer  

       »           , ByVal message As lpsolve_msgmask ) 

00137         Public Declare Sub put_msgfunc Lib "lpsolve51.dll" Alias "put_msgfunc" ( ByVal 

       »           lp As Integer , ByVal newmsg As msgfunc , ByVal msghandle As Integer ,  

       »           ByVal mask As lpsolve_msgmask ) 

00138         Public Declare Function read_basis Lib "lpsolve51.dll" Alias "read_basis" (  

       »           ByVal lp As Integer , ByVal filename As String , ByVal info As String ) As  

       »           Boolean 

00139         Public Declare Function read_freeMPS Lib "lpsolve51.dll" Alias "read_freeMPS" 

       »           ( ByVal filename As String , ByVal verbose As Integer ) As Integer 

00140         Public Declare Function read_LP Lib "lpsolve51.dll" Alias "read_LP" ( ByVal  

       »           filename As String , ByVal verbose As Integer , ByVal lp_name As String ) As 

       »           Integer 

00141         Public Declare Function read_MPS Lib "lpsolve51.dll" Alias "read_MPS" ( ByVal  

       »           filename As String , ByVal verbose As Integer ) As Integer 

00142         Public Declare Function read_XLI Lib "lpsolve51.dll" Alias "read_XLI" ( ByVal  

       »           xliname As String , ByVal modelname As String , ByVal dataname As String ,  

       »           ByVal options As String , ByVal verbose As Integer ) As Integer 

00143         Public Declare Sub reset_basis Lib "lpsolve51.dll" Alias "reset_basis" ( ByVal 

       »           lp As Integer ) 

00144         Public Declare Function set_add_rowmode Lib "lpsolve51.dll" Alias  

       »           "set_add_rowmode" ( ByVal lp As Integer , ByVal turnon As Boolean ) As  

       »           Boolean 

00145         Public Declare Sub set_anti_degen Lib "lpsolve51.dll" Alias "set_anti_degen"  

       »           ( ByVal lp As Integer , ByVal anti_degen As lpsolve_anti_degen ) 

00146         Public Declare Function set_basis Lib "lpsolve51.dll" Alias "set_basis" (  

       »           ByVal lp As Integer , ByRef bascolumn As Integer , ByVal nonbasic As  

       »           Boolean ) As Boolean 

00147         Public Declare Sub set_basiscrash Lib "lpsolve51.dll" Alias "set_basiscrash"  

       »           ( ByVal lp As Integer , ByVal mode As lpsolve_basiscrash ) 

00148         Public Declare Sub set_bb_depthlimit Lib "lpsolve51.dll" Alias  

       »           "set_bb_depthlimit" ( ByVal lp As Integer , ByVal bb_maxlevel As Integer ) 

00149         Public Declare Sub set_bb_floorfirst Lib "lpsolve51.dll" Alias  

       »           "set_bb_floorfirst" ( ByVal lp As Integer , ByVal bb_floorfirst As  

       »           lpsolve_branch ) 

00150         Public Declare Sub set_bb_rule Lib "lpsolve51.dll" Alias "set_bb_rule" ( ByVal 

       »           lp As Integer , ByVal bb_rule As lpsolve_BBstrategies ) 

00151         Public Declare Function set_BFP Lib "lpsolve51.dll" Alias "set_BFP" ( ByVal lp 

       »           As Integer , ByVal filename As String ) As Boolean 

00152         Public Declare Function set_binary Lib "lpsolve51.dll" Alias "set_binary" (  

       »           ByVal lp As Integer , ByVal column As Integer , ByVal must_be_bin As  

       »           Boolean ) As Boolean 

00153         Public Declare Function set_bounds Lib "lpsolve51.dll" Alias "set_bounds" (  

       »           ByVal lp As Integer , ByVal column As Integer , ByVal lower As Double ,  

       »           ByVal upper As Double ) As Boolean 

00154         Public Declare Sub set_bounds_tighter Lib "lpsolve51.dll" Alias  

       »           "set_bounds_tighter" ( ByVal lp As Integer , ByVal tighten As Boolean ) 

00155         Public Declare Sub set_break_at_first Lib "lpsolve51.dll" Alias  

       »           "set_break_at_first" ( ByVal lp As Integer , ByVal break_at_first As  

       »           Boolean ) 

00156         Public Declare Sub set_break_at_value Lib "lpsolve51.dll" Alias  

       »           "set_break_at_value" ( ByVal lp As Integer , ByVal break_at_value As Double  

       »           ) 

00157         Public Declare Function set_col_name Lib "lpsolve51.dll" Alias "set_col_name" 

       »           ( ByVal lp As Integer , ByVal column As Integer , ByVal new_name As String ) 

       »           As Boolean 

00158         Public Declare Function set_column Lib "lpsolve51.dll" Alias "set_column" (  

       »           ByVal lp As Integer , ByVal col_no As Integer , ByRef column As Double ) As  

       »           Boolean 

00159         Public Declare Function set_columnex Lib "lpsolve51.dll" Alias "set_columnex" 

       »           ( ByVal lp As Integer , ByVal col_no As Integer , ByVal count As Integer ,  

       »           ByRef column As Double , ByRef rowno As Integer ) As Boolean 

00160         Public Declare Function set_constr_type Lib "lpsolve51.dll" Alias  

       »           "set_constr_type" ( ByVal lp As Integer , ByVal row As Integer , ByVal  

       »           con_type As lpsolve_constr_types ) As Boolean 

00161         Public Declare Sub set_debug Lib "lpsolve51.dll" Alias "set_debug" ( ByVal lp  

       »           As Integer , ByVal debug_ As Boolean ) 

00162         Public Declare Sub set_epsb Lib "lpsolve51.dll" Alias "set_epsb" ( ByVal lp As 

       »           Integer , ByVal epsb As Double ) 

00163         Public Declare Sub set_epsd Lib "lpsolve51.dll" Alias "set_epsd" ( ByVal lp As 

       »           Integer , ByVal epsd As Double ) 

00164         Public Declare Sub set_epsel Lib "lpsolve51.dll" Alias "set_epsel" ( ByVal lp  

       »           As Integer , ByVal epsel As Double ) 

00165         Public Declare Sub set_epsint Lib "lpsolve51.dll" Alias "set_epsint" ( ByVal  

       »           lp As Integer , ByVal epsint As Double ) 

00166         Public Declare Sub set_epsperturb Lib "lpsolve51.dll" Alias "set_epsperturb"  

       »           ( ByVal lp As Integer , ByVal epsperturb As Double ) 

00167         Public Declare Sub set_epspivot Lib "lpsolve51.dll" Alias "set_epspivot" (  

       »           ByVal lp As Integer , ByVal epspivot As Double ) 

00168         Public Declare Function set_free Lib "lpsolve51.dll" Alias "set_free" ( ByVal  

       »           lp As Integer , ByVal column As Integer ) As Boolean 

00169         Public Declare Sub set_improve Lib "lpsolve51.dll" Alias "set_improve" ( ByVal 

       »           lp As Integer , ByVal improve As lpsolve_improves ) 

00170         Public Declare Sub set_infinite Lib "lpsolve51.dll" Alias "set_infinite" (  

       »           ByVal lp As Integer , ByVal infinite As Double ) 

00171         Public Declare Function set_int Lib "lpsolve51.dll" Alias "set_int" ( ByVal lp 

       »           As Integer , ByVal column As Integer , ByVal must_be_int As Boolean ) As  

       »           Boolean 

00172         Public Declare Sub set_lag_trace Lib "lpsolve51.dll" Alias "set_lag_trace" (  

       »           ByVal lp As Integer , ByVal lag_trace As Boolean ) 

00173         Public Declare Function set_lowbo Lib "lpsolve51.dll" Alias "set_lowbo" (  

       »           ByVal lp As Integer , ByVal column As Integer , ByVal value As Double ) As  

       »           Boolean 

00174         Public Declare Function set_lp_name Lib "lpsolve51.dll" Alias "set_lp_name" (  

       »           ByVal lp As Integer , ByVal lpname As String ) As Boolean 

00175         Public Declare Function set_mat Lib "lpsolve51.dll" Alias "set_mat" ( ByVal lp 

       »           As Integer , ByVal row As Integer , ByVal column As Integer , ByVal value  

       »           As Double ) As Boolean 

00176         Public Declare Sub set_maxim Lib "lpsolve51.dll" Alias "set_maxim" ( ByVal lp  

       »           As Integer ) 

00177         Public Declare Sub set_maxpivot Lib "lpsolve51.dll" Alias "set_maxpivot" (  

       »           ByVal lp As Integer , ByVal max_num_inv As Integer ) 

00178         Public Declare Sub set_minim Lib "lpsolve51.dll" Alias "set_minim" ( ByVal lp  

       »           As Integer ) 

00179         Public Declare Sub set_mip_gap Lib "lpsolve51.dll" Alias "set_mip_gap" ( ByVal 

       »           lp As Integer , ByVal absolute As Boolean , ByVal mip_gap As Double ) 

00180         Public Declare Sub set_negrange Lib "lpsolve51.dll" Alias "set_negrange" (  

       »           ByVal lp As Integer , ByVal negrange As Double ) 

00181         Public Declare Function set_obj Lib "lpsolve51.dll" Alias "set_obj" ( ByVal lp 

       »           As Integer , ByVal column As Integer , ByVal value As Double ) As Boolean 

00182         Public Declare Sub set_obj_bound Lib "lpsolve51.dll" Alias "set_obj_bound" (  

       »           ByVal lp As Integer , ByVal obj_bound As Double ) 

00183         Public Declare Function set_obj_fn Lib "lpsolve51.dll" Alias "set_obj_fn" (  

       »           ByVal lp As Integer , ByRef row As Double ) As Boolean 

00184         Public Declare Function set_obj_fnex Lib "lpsolve51.dll" Alias "set_obj_fnex" 

       »           ( ByVal lp As Integer , ByVal count As Integer , ByRef row As Double , ByRef 

       »           colno As Integer ) As Boolean 

00185         Public Declare Function set_outputfile Lib "lpsolve51.dll" Alias  

       »           "set_outputfile" ( ByVal lp As Integer , ByVal filename As String ) As  

       »           Boolean 

00186         Public Declare Sub set_pivoting Lib "lpsolve51.dll" Alias "set_pivoting" (  

       »           ByVal lp As Integer , ByVal piv_rule As lpsolve_piv_rules ) 

00187         Public Declare Sub set_preferdual Lib "lpsolve51.dll" Alias "set_preferdual"  

       »           ( ByVal lp As Integer , ByVal dodual As Boolean ) 

00188         Public Declare Sub set_presolve Lib "lpsolve51.dll" Alias "set_presolve" (  

       »           ByVal lp As Integer , ByVal do_presolve As lpsolve_presolve ) 

00189         Public Declare Sub set_print_sol Lib "lpsolve51.dll" Alias "set_print_sol" (  

       »           ByVal lp As Integer , ByVal print_sol As Integer ) 

00190         Public Declare Function set_PseudoCosts Lib "lpsolve51.dll" Alias  

       »           "set_PseudoCosts" ( ByVal lp As Integer , ByRef clower As Double , ByRef  

       »           cupper As Double , ByRef updatelimit As Integer ) As Boolean 

00191         Public Declare Function set_rh Lib "lpsolve51.dll" Alias "set_rh" ( ByVal lp  

       »           As Integer , ByVal row As Integer , ByVal value As Double ) As Boolean 

00192         Public Declare Function set_rh_range Lib "lpsolve51.dll" Alias "set_rh_range" 

       »           ( ByVal lp As Integer , ByVal row As Integer , ByVal deltavalue As Double )  

       »           As Boolean 

00193         Public Declare Sub set_rh_vec Lib "lpsolve51.dll" Alias "set_rh_vec" ( ByVal  

       »           lp As Integer , ByRef rh As Double ) 

00194         Public Declare Function set_row Lib "lpsolve51.dll" Alias "set_row" ( ByVal lp 

       »           As Integer , ByVal row_no As Integer , ByRef row As Double ) As Boolean 

00195         Public Declare Function set_row_name Lib "lpsolve51.dll" Alias "set_row_name" 

       »           ( ByVal lp As Integer , ByVal row As Integer , ByVal new_name As String ) As 

       »           Boolean 

00196         Public Declare Function set_rowex Lib "lpsolve51.dll" Alias "set_rowex" (  

       »           ByVal lp As Integer , ByVal row_no As Integer , ByVal count As Integer ,  

       »           ByRef row As Double , ByRef colno As Integer ) As Boolean 

00197         Public Declare Sub set_scalelimit Lib "lpsolve51.dll" Alias "set_scalelimit"  

       »           ( ByVal lp As Integer , ByVal scalelimit As Double ) 

00198         Public Declare Sub set_scaling Lib "lpsolve51.dll" Alias "set_scaling" ( ByVal 

       »           lp As Integer , ByVal scalemode As lpsolve_scales ) 

00199         Public Declare Function set_semicont Lib "lpsolve51.dll" Alias "set_semicont" 

       »           ( ByVal lp As Integer , ByVal column As Integer , ByVal must_be_sc As  

       »           Boolean ) As Boolean 

00200         Public Declare Sub set_sense Lib "lpsolve51.dll" Alias "set_sense" ( ByVal lp  

       »           As Integer , ByVal maximize As Boolean ) 

00201         Public Declare Sub set_simplextype Lib "lpsolve51.dll" Alias  

       »           "set_simplextype" ( ByVal lp As Integer , ByVal simplextype As  

       »           lpsolve_simplextypes ) 

00202         Public Declare Sub set_solutionlimit Lib "lpsolve51.dll" Alias  

       »           "set_solutionlimit" ( ByVal lp As Integer , ByVal limit As Integer ) 

00203         Public Declare Sub set_timeout Lib "lpsolve51.dll" Alias "set_timeout" ( ByVal 

       »           lp As Integer , ByVal sectimeout As Integer ) 

00204         Public Declare Sub set_trace Lib "lpsolve51.dll" Alias "set_trace" ( ByVal lp  

       »           As Integer , ByVal trace As Boolean ) 

00205         Public Declare Function set_upbo Lib "lpsolve51.dll" Alias "set_upbo" ( ByVal  

       »           lp As Integer , ByVal column As Integer , ByVal value As Double ) As Boolean 

00206         Public Declare Function set_var_branch Lib "lpsolve51.dll" Alias  

       »           "set_var_branch" ( ByVal lp As Integer , ByVal column As Integer , ByVal  

       »           branch_mode As lpsolve_branch ) As Boolean 

00207         Public Declare Function set_var_weights Lib "lpsolve51.dll" Alias  

       »           "set_var_weights" ( ByVal lp As Integer , ByRef weights As Double ) As  

       »           Boolean 

00208         Public Declare Sub set_verbose Lib "lpsolve51.dll" Alias "set_verbose" ( ByVal 

       »           lp As Integer , ByVal verbose As Integer ) 

00209         Public Declare Function set_XLI Lib "lpsolve51.dll" Alias "set_XLI" ( ByVal lp 

       »           As Integer , ByVal filename As String ) As Boolean 

00210         Public Declare Function solve Lib "lpsolve51.dll" Alias "solve" ( ByVal lp As  

       »           Integer ) As lpsolve_return 

00211         Public Declare Function str_add_column Lib "lpsolve51.dll" Alias  

       »           "str_add_column" ( ByVal lp As Integer , ByVal col_string As String ) As  

       »           Boolean 

00212         Public Declare Function str_add_constraint Lib "lpsolve51.dll" Alias  

       »           "str_add_constraint" ( ByVal lp As Integer , ByVal row_string As String ,  

       »           ByVal constr_type As lpsolve_constr_types , ByVal rh As Double ) As Boolean 

00213         Public Declare Function str_add_lag_con Lib "lpsolve51.dll" Alias  

       »           "str_add_lag_con" ( ByVal lp As Integer , ByVal row_string As String , ByVal 

       »           con_type As lpsolve_constr_types , ByVal rhs As Double ) As Boolean 

00214         Public Declare Function str_set_obj_fn Lib "lpsolve51.dll" Alias  

       »           "str_set_obj_fn" ( ByVal lp As Integer , ByVal row_string As String ) As  

       »           Boolean 

00215         Public Declare Function str_set_rh_vec Lib "lpsolve51.dll" Alias  

       »           "str_set_rh_vec" ( ByVal lp As Integer , ByVal rh_string As String ) As  

       »           Boolean 

00216         Public Declare Function time_elapsed Lib "lpsolve51.dll" Alias "time_elapsed" 

       »           ( ByVal lp As Integer ) As Double 

00217         Public Declare Sub unscale Lib "lpsolve51.dll" Alias "unscale" ( ByVal lp As  

       »           Integer ) 

00218         Public Declare Function write_basis Lib "lpsolve51.dll" Alias "write_basis" (  

       »           ByVal lp As Integer , ByVal filename As String ) As Boolean 

00219         Public Declare Function write_freemps Lib "lpsolve51.dll" Alias  

       »           "write_freemps" ( ByVal lp As Integer , ByVal filename As String ) As  

       »           Boolean 

00220         Public Declare Function write_lp Lib "lpsolve51.dll" Alias "write_lp" ( ByVal  

       »           lp As Integer , ByVal filename As String ) As Boolean 

00221         Public Declare Function write_mps Lib "lpsolve51.dll" Alias "write_mps" (  

       »           ByVal lp As Integer , ByVal filename As String ) As Boolean 

00222         Public Declare Function write_XLI Lib "lpsolve51.dll" Alias "write_XLI" (  

       »           ByVal lp As Integer , ByVal filename As String , ByVal options As String ,  

       »           ByVal results As Boolean ) As Boolean 

00223      

00224         '---------------------------------------------------------------------------- 

       »           ------------------------------------------------- 

00225      

00226         'possible type of constraints  

00227         Public Enum lpsolve_constr_types 

00228             LE = 1 

00229             EQ = 3 

00230             GE = 2 

00231             FR = 0 

00232         End Enum 

00233      

00234         'Possible Scalings  

00235         Public Enum lpsolve_scales 

00236             SCALE_EXTREME = 1 

00237             SCALE_RANGE = 2 

00238             SCALE_MEAN = 3 

00239             SCALE_GEOMETRIC = 4 

00240             SCALE_CURTISREID = 7 

00241             SCALE_QUADRATIC = 8 

00242             SCALE_LOGARITHMIC = 16 

00243             SCALE_USERWEIGHT = 31 

00244             SCALE_POWER2 = 32 

00245             SCALE_EQUILIBRATE = 64 

00246             SCALE_INTEGERS = 128 

00247         End Enum 

00248      

00249         'Possible Improvements  

00250         Public Enum lpsolve_improves 

00251             IMPROVE_NONE = 0 

00252             IMPROVE_FTRAN = 1 

00253             IMPROVE_BTRAN = 2 

00254             IMPROVE_SOLVE = lpsolve_improves . IMPROVE_FTRAN + lpsolve_improves .  

       »               IMPROVE_BTRAN 

00255             IMPROVE_INVERSE = 4 

00256         End Enum 

00257      

00258         Public Enum lpsolve_piv_rules 

00259             PRICER_FIRSTINDEX = 0 

00260             PRICER_DANTZIG = 1 

00261             PRICER_DEVEX = 2 

00262             PRICER_STEEPESTEDGE = 3 

00263             PRICE_PRIMALFALLBACK = 4 

00264             PRICE_MULTIPLE = 8 

00265             PRICE_PARTIAL = 16 

00266             PRICE_ADAPTIVE = 32 

00267             PRICE_HYBRID = 64 

00268             PRICE_RANDOMIZE = 128 

00269             PRICE_AUTOPARTIALCOLS = 256 

00270             PRICE_AUTOPARTIALROWS = 512 

00271             PRICE_LOOPLEFT = 1024 

00272             PRICE_LOOPALTERNATE = 2048 

00273             PRICE_AUTOPARTIAL = lpsolve_piv_rules . PRICE_AUTOPARTIALCOLS +  

       »               lpsolve_piv_rules . PRICE_AUTOPARTIALROWS 

00274         End Enum 

00275      

00276         Public Enum lpsolve_presolve 

00277             PRESOLVE_NONE = 0 

00278             PRESOLVE_ROWS = 1 

00279             PRESOLVE_COLS = 2 

00280             PRESOLVE_LINDEP = 4 

00281             PRESOLVE_SOS = 32 

00282             PRESOLVE_REDUCEMIP = 64 

00283             PRESOLVE_DUALS = 128 

00284             PRESOLVE_SENSDUALS = 256 

00285         End Enum 

00286      

00287         Public Enum lpsolve_anti_degen 

00288             ANTIDEGEN_NONE = 0 

00289             ANTIDEGEN_FIXEDVARS = 1 

00290             ANTIDEGEN_COLUMNCHECK = 2 

00291             ANTIDEGEN_STALLING = 4 

00292             ANTIDEGEN_NUMFAILURE = 8 

00293             ANTIDEGEN_LOSTFEAS = 16 

00294             ANTIDEGEN_INFEASIBLE = 32 

00295             ANTIDEGEN_DYNAMIC = 64 

00296             ANTIDEGEN_DURINGBB = 128 

00297         End Enum 

00298      

00299         Public Enum lpsolve_basiscrash 

00300             CRASH_NOTHING = 0 

00301             CRASH_MOSTFEASIBLE = 2 

00302         End Enum 

00303      

00304         Public Enum lpsolve_simplextypes 

00305             SIMPLEX_PRIMAL_PRIMAL = 5 

00306             SIMPLEX_DUAL_PRIMAL = 6 

00307             SIMPLEX_PRIMAL_DUAL = 9 

00308             SIMPLEX_DUAL_DUAL = 10 

00309         End Enum 

00310      

00311         'B&B strategies  

00312         Public Enum lpsolve_BBstrategies 

00313             NODE_FIRSTSELECT = 0 

00314             NODE_GAPSELECT = 1 

00315             NODE_RANGESELECT = 2 

00316             NODE_FRACTIONSELECT = 3 

00317             NODE_PSEUDOCOSTSELECT = 4 

00318             NODE_PSEUDONONINTSELECT = 5 

00319             NODE_PSEUDORATIOSELECT = 6 

00320             NODE_USERSELECT = 7 

00321             NODE_WEIGHTREVERSEMODE = 8 

00322             NODE_BRANCHREVERSEMODE = 16 

00323             NODE_GREEDYMODE = 32 

00324             NODE_PSEUDOCOSTMODE = 64 

00325             NODE_DEPTHFIRSTMODE = 128 

00326             NODE_RANDOMIZEMODE = 256 

00327             NODE_GUBMODE = 512 

00328             NODE_DYNAMICMODE = 1024 

00329             NODE_RESTARTMODE = 2048 

00330         End Enum 

00331      

00332         'possible return values of lp solver  

00333         Public Enum lpsolve_return 

00334             NOMEMORY = - 2 

00335             OPTIMAL = 0 

00336             SUBOPTIMAL = 1 

00337             INFEASIBLE = 2 

00338             UNBOUNDED = 3 

00339             DEGENERATE = 4 

00340             NUMFAILURE = 5 

00341             USERABORT = 6 

00342             TIMEOUT = 7 

00343             PROCFAIL = 10 

00344             PROCBREAK = 11 

00345             FEASFOUND = 12 

00346             NOFEASFOUND = 13 

00347         End Enum 

00348      

00349         'possible branch values  

00350         Public Enum lpsolve_branch 

00351             BRANCH_CEILING = 0 

00352             BRANCH_FLOOR = 1 

00353             BRANCH_AUTOMATIC = 2 

00354         End Enum 

00355      

00356         'possible message values  

00357         Public Enum lpsolve_msgmask 

00358             MSG_PRESOLVE = 1 

00359             MSG_LPFEASIBLE = 8 

00360             MSG_LPOPTIMAL = 16 

00361             MSG_MILPEQUAL = 32 

00362             MSG_MILPFEASIBLE = 128 

00363             MSG_MILPBETTER = 512 

00364         End Enum 

00365      

00366         Private Function SetEnvironmentVariable ( ByRef name As String , ByRef value As 

       »           String ) As Boolean 

00367      

00368             SetEnvironmentVariable = SetEnvironmentVariableA ( name , value ) 

00369      

00370         End Function 

00371      

00372         Private Function GetEnvironmentVariable ( ByRef name As String ) As String 

00373             Dim l As Integer 

00374             Dim buf As String 

00375      

00376             l = GetEnvironmentVariableA ( name , vbNullString , 0 ) 

00377             If l > 0 Then 

00378                 buf = Space ( l ) 

00379                 l = GetEnvironmentVariableA ( name , buf , Len ( buf )) 

00380                 GetEnvironmentVariable = Mid ( buf , 1 , l ) 

00381             End If 

00382      

00383         End Function 

00384      



00385         Public Function Init ( Optional ByVal dllPath As String = "" ) As Boolean 

00386             Static bEnvChanged As Boolean 

00387             Dim Path As String 

00388             Dim buf As String 

00389      

00390             If Len ( dllPath ) = 0 Then 

00391                 dllPath = CurDir () 

00392             End If 

00393             buf = dllPath 

00394             If Right ( buf , 1 ) <> "\" Then 

00395                 buf = buf & "\" 

00396             End If 

00397             buf = buf & "lpsolve51.dll" 

00398             On Error Resume Next 

00399             Init = ( Len ( Dir ( buf , FileAttribute . Normal )) > 0 ) 

00400             If Init Then 

00401                 If Not bEnvChanged Then 

00402                     bEnvChanged = True 

00403                     Path = GetEnvironmentVariable ( "PATH" ) 

00404                     If InStr ( 1 , Path & ";" , dllPath & ";" , CompareMethod . Text ) = 0  

       »                       Then 

00405                         SetEnvironmentVariable ( "PATH" , dllPath & ";" & Path ) 

00406                     End If 

00407                 End If 

00408             End If 

00409      

00410         End Function 

00411      

00412     End Class 

00001     Imports System . IO 

00002      

00003     Module Module1 

00004      

00005      

00006      

00007         Public Function TomaObjetoGraphics ( ByVal pbox As PictureBox ) As Graphics 

00008             'crea un bitmap de las mismas dimesiones que el picturebox  

00009             Dim bmp As Bitmap 

00010             bmp = New Bitmap ( pbox . Width , pbox . Height ) 

00011             'asigna el bitmap al picturebox  

00012      

00013             pbox . Image = bmp 

00014             '---------------------------------  

00015             'esta línea parece importante  

00016             'la he añadido y al hacer pruebas  

00017             'la memoria se comporta mejor!!!  

00018             pbox . Invalidate () 

00019             '------------------------------------  

00020             'crea un objeto graphics a partir del bitmap  

00021             Dim G2 As Graphics 

00022             G2 = Graphics . FromImage ( bmp ) 

00023      

00024             'devuelve el objeto Graphics  

00025             Return G2 

00026      

00027         End Function 

00028      

00029      



00030         Public Sub FiltraTexto ( ByVal Caja As TextBox ) 

00031             'Esta rutina repasa el contenido de la caja de texto y  

00032             'evita que existan más de una coma seguida  

00033             'evita más de 2 punto y coma en toda la cadena  

00034             'también evita dos signos menos seguidos  

00035             'Si se deja pasar, ocasionaría errores de conversión a single!!!  

00036             Dim i As Long 

00037             Dim cadena1 As String 

00038             Dim cadena2 As String 

00039             Dim l As String 

00040      

00041             cadena1 = Caja . Text 

00042             cadena2 = "" 

00043      

00044             Dim contpc As Long 'contador de punto y coma  

00045             Dim contc As Long 'contador de coma  

00046             Dim contm As Long 'contador de signo menos  

00047             Dim marcai As Long 'marca de inicio  

00048             contpc = 0 

00049             contc = 0 

00050             contm = 0 

00051             marcai = 1 

00052             For i = 1 To cadena1 . Length 

00053                 l = Mid ( cadena1 , i , 1 ) 

00054      

00055                 If l = "," Then contc = contc + 1 

00056                 If l = "-" Then contm = contm + 1 

00057                 If l = ";" Then contpc = contpc + 1 : contc = 0 : contm = 0 :  

       »                   marcai = i + 1 

00058      

00059                 If ( l = "," And contc > 1 ) Or ( l = "-" And ( contm > 1 Or marcai <> 

       »                   i )) Or ( l = ";" And contpc > 2 ) Then 

00060      

00061                 Else 

00062                     cadena2 = cadena2 & l 

00063                 End If 

00064      

00065             Next i 

00066             Caja . Text = cadena2 

00067         End Sub 

00068      

00069      

00070         Public Function DialogoColor ( ByVal ColorInicial As Color ) As Color 

00071             'Muestra cuadro de diálogo de color  

00072             Dim MiDialogo As New ColorDialog 

00073      

00074             'permite elegir cualquier color incluso personalizados  

00075             MiDialogo . AllowFullOpen = True 

00076             MiDialogo . AnyColor = True 

00077             MiDialogo . FullOpen = True 

00078      

00079             MiDialogo . ShowHelp = True 

00080      

00081             MiDialogo . Color = ColorInicial 

00082             MiDialogo . ShowDialog () 

00083             Return MiDialogo . Color 

00084      

00085      

00086         End Function 

00087      



00088         Public Function CopiaImagenPortapapeles ( ByVal pbox As PictureBox ) 

00089             'Copia la imagen al portapapeles  

00090             'los datos NO permanecerán en el portapapeles aunque se cierre el  

       »               programa  

00091             'si se ponía true petaba (no sé porqué) en XP  

00092             Clipboard . SetDataObject ( pbox . Image , False ) 

00093         End Function 

00094         Public Function ExportaImagen ( ByVal pbox As PictureBox ) 

00095      

00096             'Esta opción de menú muestra el cuadro de diálogo  

00097             'de grabar fichero y maneja las opciones de exportar  

00098             'la imagen del picturebox a un formato gráfico  

00099      

00100             Dim saveFileDialog1 As New SaveFileDialog 

00101      

00102             saveFileDialog1 . Filter = "Graphics Interchange Format  

       »               (*.gif)|*.gif|Bitmap Image (*.bmp)|*.bmp|Tagged Image File Format  

       »               (*.tif)|*.tif|Portable Network Graphics format (*.png)|*.png|Scalable 

       »               Vector Graphics (*.svg)|*.svg" 

00103             saveFileDialog1 . FilterIndex = 1 'formato por defecto .gif  

00104             saveFileDialog1 . Title = "Exportar Imagen del Grafo" 

00105             saveFileDialog1 . RestoreDirectory = True 

00106      

00107             If saveFileDialog1 . ShowDialog () = DialogResult . OK Then 

00108                 Try 

00109                     'Selecciona el formato gráfico que ha escogido el usuario  

00110                     Select Case saveFileDialog1 . FilterIndex 

00111                         Case 1 

00112                             pbox . Image . Save ( saveFileDialog1 . FileName , System .  

       »                               Drawing . Imaging . ImageFormat . Gif ) 

00113                         Case 2 

00114                             pbox . Image . Save ( saveFileDialog1 . FileName , System .  

       »                               Drawing . Imaging . ImageFormat . Bmp ) 

00115                         Case 3 

00116                             pbox . Image . Save ( saveFileDialog1 . FileName , System .  

       »                               Drawing . Imaging . ImageFormat . Tiff ) 

00117                         Case 4 

00118                             pbox . Image . Save ( saveFileDialog1 . FileName , System .  

       »                               Drawing . Imaging . ImageFormat . Png ) 

00119                         Case 5 

00120                             Dim f1 As New Form1 

00121                             f1 . DibujaGrafoSVG ( saveFileDialog1 . FileName ) 

00122                     End Select 

00123                 Catch ex As Exception 

00124                     MsgBox ( "Ha fallado el proceso de exportar imagen." & vbCrLf &  

       »                       ex . Message , MsgBoxStyle . Exclamation , "Grafos - Excepción" ) 

00125                     Exit Function 

00126                 Finally 

00127      

00128                 End Try 

00129             End If 

00130      

00131      

00132      

00133         End Function 

00134      



00135         Public Function InterceptaTeclas ( ByVal e As Object ) 

00136      

00137             'no permite la pulsación de punto decimal  

00138             If e . KeyChar = "." Then 

00139                 e . Handled = True 

00140             End If 

00141             'sólo numeros, separador ; y coma decimal  

00142             If e . KeyChar = "-" Or ( e . KeyChar >= "0" And e . KeyChar <= "9" ) Or e .  

       »               KeyChar = "," Or e . KeyChar = Chr ( Keys . Delete ) Or e . KeyChar = Chr ( Keys  

       »               . Back ) Then 

00143                 'caracter permitido  

00144             Else 

00145                 e . Handled = True 

00146             End If 

00147      

00148      

00149         End Function 

00150      

00151         Public Sub LeeFicheroTexto ( ByVal TrayectoriaFichero As String , ByRef Texto  

       »           As String ) 

00152             'Abre el fichero para leer  

00153             Try 

00154      

00155                 Dim s As Stream = File . OpenRead ( TrayectoriaFichero ) 

00156                 Dim sr As StreamReader = New StreamReader ( TrayectoriaFichero ,  

       »                   System . Text . Encoding . Default , False ) 

00157      

00158                 Texto = sr . ReadToEnd 

00159                 sr . Close () 

00160                 sr = Nothing 

00161             Catch ex As Exception 

00162                 'MsgBox("Ha fallado la operación de abrir el fichero." & vbCrLf &  

       »                   ex.Message, MsgBoxStyle.Exclamation, "Grafos - Excepción")  

00163                 Exit Sub 

00164             Finally 

00165      

00166             End Try 

00167             FileClose () 

00168         End Sub 

00169      

00170         Public Sub EscribeFicheroTexto ( ByVal TrayectoriaFichero As String , ByVal  

       »           Texto As String ) 

00171             'Abre el fichero para guardar  

00172             'si existe el fichero lo borra  

00173      

00174      

00175             Try 

00176                 Dim sw As StreamWriter = New StreamWriter ( TrayectoriaFichero ) 

00177      

00178                 sw . Write ( Texto ) 

00179                 sw . Close () 

00180                 sw = Nothing 

00181             Catch ex As Exception 

00182                 'MsgBox("Ha fallado la operación de guardar el fichero." & vbCrLf &  

       »                   ex.Message, MsgBoxStyle.Exclamation, "Grafos - Excepción")  

00183                 Exit Sub 

00184             Finally 

00185                 '¿se habrá cerrado?  

00186      

00187             End Try 

00188             FileClose () 

00189      



00190         End Sub 

00191     End Module 

00001     Public Class Splash 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents PictureBox1 As System . Windows . Forms . PictureBox 

00033         Friend WithEvents GroupBox1 As System . Windows . Forms . GroupBox 

00034         Friend WithEvents Label4 As System . Windows . Forms . Label 

00035         Friend WithEvents lblVersion As System . Windows . Forms . Label 

00036         Friend WithEvents lblDescripcion As System . Windows . Forms . Label 

00037         Friend WithEvents lblCopyR As System . Windows . Forms . Label 

00038         Friend WithEvents lblTitle As System . Windows . Forms . Label 

00039         Friend WithEvents lblCopyR2 As System . Windows . Forms . Label 

00040         Friend WithEvents linkGrafos As System . Windows . Forms . LinkLabel 

00041         Friend WithEvents PictureBox2 As System . Windows . Forms . PictureBox 

00042         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00043             Dim resources As System . Resources . ResourceManager = New System . Resources  

       »               . ResourceManager ( GetType ( Splash )) 

00044             Me . PictureBox1 = New System . Windows . Forms . PictureBox 

00045             Me . GroupBox1 = New System . Windows . Forms . GroupBox 

00046             Me . lblCopyR2 = New System . Windows . Forms . Label 

00047             Me . lblCopyR = New System . Windows . Forms . Label 

00048             Me . lblTitle = New System . Windows . Forms . Label 

00049             Me . lblVersion = New System . Windows . Forms . Label 

00050             Me . Label4 = New System . Windows . Forms . Label 

00051             Me . lblDescripcion = New System . Windows . Forms . Label 

00052             Me . linkGrafos = New System . Windows . Forms . LinkLabel 

00053             Me . PictureBox2 = New System . Windows . Forms . PictureBox 

00054             Me . SuspendLayout () 

00055             '  

00056             'PictureBox1  

00057             '  

00058             Me . PictureBox1 . BackColor = System . Drawing . Color . Black 

00059             Me . PictureBox1 . Dock = System . Windows . Forms . DockStyle . Top 

00060             Me . PictureBox1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00061             Me . PictureBox1 . Name = "PictureBox1" 

00062             Me . PictureBox1 . Size = New System . Drawing . Size ( 450 , 72 ) 

00063             Me . PictureBox1 . TabIndex = 0 

00064             Me . PictureBox1 . TabStop = False 

00065             '  

00066             'GroupBox1  

00067             '  

00068             Me . GroupBox1 . BackColor = System . Drawing . Color . LightSlateGray 

00069             Me . GroupBox1 . Location = New System . Drawing . Point ( 8 , 224 ) 

00070             Me . GroupBox1 . Name = "GroupBox1" 

00071             Me . GroupBox1 . Size = New System . Drawing . Size ( 435 , 8 ) 

00072             Me . GroupBox1 . TabIndex = 1 

00073             Me . GroupBox1 . TabStop = False 

00074             '  

00075             'lblCopyR2  

00076             '  

00077             Me . lblCopyR2 . Font = New System . Drawing . Font ( "Verdana" , 7.0 !) 

00078             Me . lblCopyR2 . Location = New System . Drawing . Point ( 8 , 240 ) 

00079             Me . lblCopyR2 . Name = "lblCopyR2" 

00080             Me . lblCopyR2 . Size = New System . Drawing . Size ( 440 , 112 ) 

00081             Me . lblCopyR2 . TabIndex = 2 

00082             Me . lblCopyR2 . Text = "Advertencia: este programa está protegido por las  

       »               leyes de derechos de autor y ot" & _ 

00083             "ros tratados internacionales. Grafos es un software libre y gratuito.  

       »               Se distrib" & _ 

00084             "uye bajo las condiciones: Reconocimiento-NoComercial-CompartirIgual  

       »               2.1. (Creati" & _ 

00085             "ve Commons License). La comercialización sin consentimiento del autor  

       »               de este pr" & _ 

00086             "ograma o cualquier parte del mismo, está penada por la ley con severas  

       »               sanciones" & _ 

00087             " civiles y penales, y será objeto de todas las acciones judiciales que  

       »               correspon" & _ 

00088             "dan."" & vbcrlf & ""Grafos incluye la librería lp_solve 5.x Copyright  

       »               1991, 2005 F" & _ 

00089             "ree Software Foundation, Inc. bajo licencia LGPL." 

00090             Me . lblCopyR2 . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00091             '  

00092             'lblCopyR  

00093             '  

00094             Me . lblCopyR . Font = New System . Drawing . Font ( "Verdana" , 8.25 !, System .  

       »               Drawing . FontStyle . Bold , System . Drawing . GraphicsUnit . Point , CType ( 0 ,  

       »               Byte )) 

00095             Me . lblCopyR . ForeColor = System . Drawing . Color . FromArgb ( CType ( 0 , Byte ),  

       »               CType ( 0 , Byte ), CType ( 64 , Byte )) 

00096             Me . lblCopyR . Location = New System . Drawing . Point ( 16 , 176 ) 

00097             Me . lblCopyR . Name = "lblCopyR" 

00098             Me . lblCopyR . Size = New System . Drawing . Size ( 424 , 16 ) 

00099             Me . lblCopyR . TabIndex = 4 

00100             Me . lblCopyR . Text = "(cc) 2003..2005 - Alejandro Rodríguez Villalobos" 

00101             Me . lblCopyR . TextAlign = System . Drawing . ContentAlignment . MiddleRight 

00102             '  

00103             'lblTitle  

00104             '  

00105             Me . lblTitle . BackColor = System . Drawing . Color . Black 

00106             Me . lblTitle . Font = New System . Drawing . Font ( "Impact" , 36.0 !, System .  

       »               Drawing . FontStyle . Bold , System . Drawing . GraphicsUnit . Point , CType ( 0 ,  

       »               Byte )) 

00107             Me . lblTitle . ForeColor = System . Drawing . Color . White 

00108             Me . lblTitle . Location = New System . Drawing . Point ( 8 , 8 ) 

00109             Me . lblTitle . Name = "lblTitle" 

00110             Me . lblTitle . Size = New System . Drawing . Size ( 216 , 56 ) 

00111             Me . lblTitle . TabIndex = 5 

00112             Me . lblTitle . Text = "Grafos" 

00113             '  

00114             'lblVersion  

00115             '  

00116             Me . lblVersion . BackColor = System . Drawing . Color . Black 

00117             Me . lblVersion . Font = New System . Drawing . Font ( "Verdana" , 8.25 !, System .  

       »               Drawing . FontStyle . Bold , System . Drawing . GraphicsUnit . Point , CType ( 0 ,  

       »               Byte )) 

00118             Me . lblVersion . ForeColor = System . Drawing . Color . FromArgb ( CType ( 255 , Byte ) 

       »               , CType ( 128 , Byte ), CType ( 0 , Byte )) 

00119             Me . lblVersion . Location = New System . Drawing . Point ( 288 , 48 ) 

00120             Me . lblVersion . Name = "lblVersion" 

00121             Me . lblVersion . Size = New System . Drawing . Size ( 152 , 16 ) 

00122             Me . lblVersion . TabIndex = 6 

00123             Me . lblVersion . Text = "versión: " 

00124             Me . lblVersion . TextAlign = System . Drawing . ContentAlignment . MiddleRight 

00125             '  

00126             'Label4  

00127             '  

00128             Me . Label4 . Font = New System . Drawing . Font ( "Verdana" , 8.25 !, System .  

       »               Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point , CType ( 0  

       »               , Byte )) 

00129             Me . Label4 . ForeColor = System . Drawing . Color . FromArgb ( CType ( 0 , Byte ),  

       »               CType ( 0 , Byte ), CType ( 64 , Byte )) 

00130             Me . Label4 . Location = New System . Drawing . Point ( 120 , 192 ) 

00131             Me . Label4 . Name = "Label4" 

00132             Me . Label4 . Size = New System . Drawing . Size ( 320 , 24 ) 

00133             Me . Label4 . TabIndex = 7 

00134             Me . Label4 . Text = "arodriguez@omp.upv.es" 

00135             Me . Label4 . TextAlign = System . Drawing . ContentAlignment . MiddleRight 

00136             '  

00137             'lblDescripcion  

00138             '  

00139             Me . lblDescripcion . Font = New System . Drawing . Font ( "Verdana" , 8.25 !,  

       »               System . Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point ,  

       »               CType ( 0 , Byte )) 

00140             Me . lblDescripcion . ForeColor = System . Drawing . Color . Lavender 

00141             Me . lblDescripcion . Location = New System . Drawing . Point ( 5 , 80 ) 

00142             Me . lblDescripcion . Name = "lblDescripcion" 

00143             Me . lblDescripcion . Size = New System . Drawing . Size ( 440 , 64 ) 

00144             Me . lblDescripcion . TabIndex = 8 

00145             Me . lblDescripcion . Text = "Programa para la construcción, edición y  

       »               análisis de grafos en modo tabular o grá" & _ 

00146             "fico. Permite exportar el grafo a diferentes formatos de ficheros  

       »               gráficos. Cont" & _ 

00147             "empla valores de mínimo, máximo y coste en los arcos; y coste en los  

       »               nodos. Arco" & _ 

00148             "s bidireccionales, etc." 

00149             Me . lblDescripcion . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00150             '  

00151             'linkGrafos  

00152             '  

00153             Me . linkGrafos . ActiveLinkColor = System . Drawing . Color . FromArgb ( CType ( 255 , 

       »               Byte ), CType ( 128 , Byte ), CType ( 0 , Byte )) 

00154             Me . linkGrafos . Anchor = CType (( System . Windows . Forms . AnchorStyles . Top Or  

       »               System . Windows . Forms . AnchorStyles . Right ), System . Windows . Forms .  

       »               AnchorStyles ) 

00155             Me . linkGrafos . AutoSize = True 

00156             Me . linkGrafos . BackColor = System . Drawing . Color . Black 

00157             Me . linkGrafos . Font = New System . Drawing . Font ( "Verdana" , 8.25 !, System .  

       »               Drawing . FontStyle . Regular , System . Drawing . GraphicsUnit . Point , CType ( 0  

       »               , Byte )) 

00158             Me . linkGrafos . ForeColor = System . Drawing . Color . White 

00159             Me . linkGrafos . LinkColor = System . Drawing . Color . White 

00160             Me . linkGrafos . Location = New System . Drawing . Point ( 272 , 8 ) 

00161             Me . linkGrafos . Name = "linkGrafos" 

00162             Me . linkGrafos . RightToLeft = System . Windows . Forms . RightToLeft . No 

00163             Me . linkGrafos . Size = New System . Drawing . Size ( 170 , 17 ) 

00164             Me . linkGrafos . TabIndex = 9 

00165             Me . linkGrafos . TabStop = True 

00166             Me . linkGrafos . Text = "más información en la web..." 

00167             Me . linkGrafos . VisitedLinkColor = System . Drawing . Color . White 

00168             '  

00169             'PictureBox2  

00170             '  

00171             Me . PictureBox2 . Cursor = System . Windows . Forms . Cursors . Hand 

00172             Me . PictureBox2 . Image = CType ( resources . GetObject ( "PictureBox2.Image" ),  

       »               System . Drawing . Image ) 

00173             Me . PictureBox2 . Location = New System . Drawing . Point ( 8 , 176 ) 

00174             Me . PictureBox2 . Name = "PictureBox2" 

00175             Me . PictureBox2 . Size = New System . Drawing . Size ( 90 , 33 ) 

00176             Me . PictureBox2 . SizeMode = System . Windows . Forms . PictureBoxSizeMode .  

       »               AutoSize 

00177             Me . PictureBox2 . TabIndex = 10 

00178             Me . PictureBox2 . TabStop = False 

00179             '  

00180             'Splash  

00181             '  

00182             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00183             Me . BackColor = System . Drawing . Color . LightSlateGray 

00184             Me . ClientSize = New System . Drawing . Size ( 450 , 359 ) 

00185             Me . Controls . Add ( Me . PictureBox2 ) 

00186             Me . Controls . Add ( Me . linkGrafos ) 

00187             Me . Controls . Add ( Me . Label4 ) 

00188             Me . Controls . Add ( Me . lblDescripcion ) 

00189             Me . Controls . Add ( Me . lblVersion ) 

00190             Me . Controls . Add ( Me . lblTitle ) 

00191             Me . Controls . Add ( Me . lblCopyR2 ) 

00192             Me . Controls . Add ( Me . GroupBox1 ) 

00193             Me . Controls . Add ( Me . PictureBox1 ) 

00194             Me . Controls . Add ( Me . lblCopyR ) 

00195             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle .  

       »               FixedToolWindow 

00196             Me . MaximizeBox = False 

00197             Me . MinimizeBox = False 

00198             Me . Name = "Splash" 

00199             Me . ShowInTaskbar = False 

00200             Me . StartPosition = System . Windows . Forms . FormStartPosition . CenterScreen 

00201             Me . Text = "Acerca de Grafos" 

00202             Me . TopMost = True 

00203             Me . ResumeLayout ( False ) 

00204      

00205         End Sub 

00206      

00207     # End Region 

00208      

00209      

00210      

00211      

00212      

00213         Private Sub Splash_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

00214      

00215             Dim nombre As String 

00216             nombre = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . ProductName 

00217      

00218             Me . Text = "Acerca de " & nombre 

00219      

00220             'Me.lblVersion.Text = Me.ProductVersion  

00221             Dim version As String 

00222             version = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . FileMajorPart 

00223             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileMinorPart 

00224             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileBuildPart 

00225      

00226             Me . lblTitle . Text = System . Diagnostics . FileVersionInfo . GetVersionInfo (  

       »               System . Reflection . Assembly . GetExecutingAssembly . Location ) . ProductName 

00227             Me . lblVersion . Text = "versión: " & version 

00228             Me . lblDescripcion . Text = System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . Comments 

00229             Me . lblCopyR . Text = System . Diagnostics . FileVersionInfo . GetVersionInfo (  

       »               System . Reflection . Assembly . GetExecutingAssembly . Location ) .  

       »               LegalCopyright 

00230             Me . lblCopyR2 . Text = System . Diagnostics . FileVersionInfo . GetVersionInfo (  

       »               System . Reflection . Assembly . GetExecutingAssembly . Location ) .  

       »               LegalTrademarks 

00231      

00232         End Sub 

00233      

00234      

00235         Private Sub linkGrafos_LinkClicked ( ByVal sender As System . Object , ByVal e As 

       »           System . Windows . Forms . LinkLabelLinkClickedEventArgs ) Handles linkGrafos .  

       »           LinkClicked 

00236             ' inicia Navegador y navega hacia la página de Grafos  

00237             Process . Start ( "http://ttt.upv.es/~arodrigu/grafos/" ) 

00238         End Sub 

00239      

00240         Private Sub PictureBox2_Click ( ByVal sender As System . Object , ByVal e As  

       »           System . EventArgs ) Handles PictureBox2 . Click 

00241             ' inicia Navegador y navega hacia la página de licencia de Grafos  

00242             Process . Start ( "http://ttt.upv.es/~arodrigu/grafos/http://creativecommons.org/licenses/by-nc-sa/3.0/deed.es" ) 

00243      

00244         End Sub 

00245     End Class 

00001     Public Class Splash0 

00002         Inherits System . Windows . Forms . Form 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'Form reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         Friend WithEvents PictureBox1 As System . Windows . Forms . PictureBox 

00033         Friend WithEvents Timer1 As System . Windows . Forms . Timer 

00034         Friend WithEvents lblCopyR As System . Windows . Forms . Label 

00035         Friend WithEvents lblVersion As System . Windows . Forms . Label 

00036         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00037             Me . components = New System . ComponentModel . Container 

00038             Dim resources As System . Resources . ResourceManager = New System . Resources  

       »               . ResourceManager ( GetType ( Splash0 )) 

00039             Me . PictureBox1 = New System . Windows . Forms . PictureBox 

00040             Me . Timer1 = New System . Windows . Forms . Timer ( Me . components ) 

00041             Me . lblCopyR = New System . Windows . Forms . Label 

00042             Me . lblVersion = New System . Windows . Forms . Label 

00043             Me . SuspendLayout () 

00044             '  

00045             'PictureBox1  

00046             '  

00047             Me . PictureBox1 . Image = CType ( resources . GetObject ( "PictureBox1.Image" ),  

       »               System . Drawing . Image ) 

00048             Me . PictureBox1 . Location = New System . Drawing . Point ( 0 , 0 ) 

00049             Me . PictureBox1 . Name = "PictureBox1" 

00050             Me . PictureBox1 . Size = New System . Drawing . Size ( 433 , 361 ) 

00051             Me . PictureBox1 . SizeMode = System . Windows . Forms . PictureBoxSizeMode .  

       »               AutoSize 

00052             Me . PictureBox1 . TabIndex = 0 

00053             Me . PictureBox1 . TabStop = False 

00054             '  

00055             'Timer1  

00056             '  

00057             Me . Timer1 . Interval = 4000 

00058             '  

00059             'lblCopyR  

00060             '  

00061             Me . lblCopyR . BackColor = System . Drawing . Color . Black 

00062             Me . lblCopyR . BorderStyle = System . Windows . Forms . BorderStyle . FixedSingle 

00063             Me . lblCopyR . Dock = System . Windows . Forms . DockStyle . Bottom 

00064             Me . lblCopyR . ForeColor = System . Drawing . Color . White 

00065             Me . lblCopyR . Location = New System . Drawing . Point ( 0 , 344 ) 

00066             Me . lblCopyR . Name = "lblCopyR" 

00067             Me . lblCopyR . Size = New System . Drawing . Size ( 432 , 24 ) 

00068             Me . lblCopyR . TabIndex = 1 

00069             Me . lblCopyR . Text = "(cc) 2003..2005 - Alejandro Rodríguez Villalobos" 

00070             Me . lblCopyR . TextAlign = System . Drawing . ContentAlignment . MiddleRight 

00071             '  

00072             'lblVersion  

00073             '  

00074             Me . lblVersion . BackColor = System . Drawing . Color . Black 

00075             Me . lblVersion . Font = New System . Drawing . Font ( "Verdana" , 8.25 !, System .  

       »               Drawing . FontStyle . Bold , System . Drawing . GraphicsUnit . Point , CType ( 0 ,  

       »               Byte )) 

00076             Me . lblVersion . ForeColor = System . Drawing . Color . FromArgb ( CType ( 255 , Byte ) 

       »               , CType ( 128 , Byte ), CType ( 0 , Byte )) 

00077             Me . lblVersion . Location = New System . Drawing . Point ( 5 , 348 ) 

00078             Me . lblVersion . Name = "lblVersion" 

00079             Me . lblVersion . Size = New System . Drawing . Size ( 152 , 16 ) 

00080             Me . lblVersion . TabIndex = 7 

00081             Me . lblVersion . Text = "versión: " 

00082             Me . lblVersion . TextAlign = System . Drawing . ContentAlignment . MiddleLeft 

00083             '  

00084             'Splash0  

00085             '  

00086             Me . AutoScaleBaseSize = New System . Drawing . Size ( 5 , 13 ) 

00087             Me . ClientSize = New System . Drawing . Size ( 432 , 368 ) 

00088             Me . Controls . Add ( Me . lblVersion ) 

00089             Me . Controls . Add ( Me . lblCopyR ) 

00090             Me . Controls . Add ( Me . PictureBox1 ) 

00091             Me . FormBorderStyle = System . Windows . Forms . FormBorderStyle . None 

00092             Me . Name = "Splash0" 

00093             Me . ShowInTaskbar = False 

00094             Me . StartPosition = System . Windows . Forms . FormStartPosition . CenterScreen 

00095             Me . Text = "Splash0" 

00096             Me . TopMost = True 

00097             Me . ResumeLayout ( False ) 

00098      

00099         End Sub 

00100      

00101     # End Region 

00102      

00103         Private Sub Timer1_Tick ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles Timer1 . Tick 

00104             Me . Visible = False 

00105         End Sub 

00106      

00107      

00108      

00109         Private Sub Splash0_Load ( ByVal sender As System . Object , ByVal e As System .  

       »           EventArgs ) Handles MyBase . Load 

00110      

00111             Dim CopyR As String 

00112             CopyR = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . LegalCopyright 

00113             Me . lblCopyR . Text = CopyR 

00114      

00115             Dim version As String 

00116             version = System . Diagnostics . FileVersionInfo . GetVersionInfo ( System .  

       »               Reflection . Assembly . GetExecutingAssembly . Location ) . FileMajorPart 

00117             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileMinorPart 

00118             version = version & "." & System . Diagnostics . FileVersionInfo .  

       »               GetVersionInfo ( System . Reflection . Assembly . GetExecutingAssembly .  

       »               Location ) . FileBuildPart 

00119      

00120             Me . lblVersion . Text = "versión: " & version 

00121      

00122      

00123      

00124             Timer1 . Enabled = True 

00125         End Sub 

00126     End Class 

00001     Public Class Dijkstra 

00002         Inherits System . Windows . Forms . UserControl 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'UserControl1 reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00033             '  

00034             'Dijkstra  

00035             '  

00036             Me . Name = "Dijkstra" 

00037             Me . Size = New System . Drawing . Size ( 248 , 152 ) 

00038      

00039         End Sub 

00040      

00041     # End Region 

00042      

00043      

00044         Private Const cSinEstatus As Integer = 0 

00045         Private Const cCandidato As Integer = 1 

00046         Private Const cProcesado As Integer = 2 

00047         Private Const cMaximo As Single = 999999999999999999 

00048         Private Const cMinimo As Single = - 999999999999999999 

00049      

00050         'Declaraciones de Eventos  

00051         Public Event Fin ( ByVal TextoRespuesta As String , ByVal MatrizArcosMinimos As 

       »           Array )  'ver parámetros de solución  

00052         Public Event Fallo ( ByVal TextoError As String ) 

00053         'Declaraciones de Variables  

00054         Public DatosIncorrectos As Boolean = False 

00055      



00056         'Declara la estructura del objeto Arco o relación entre nodos  

00057         Public Structure Arco 

00058             'Dim Texto As String 'etiqueta  

00059             'Dim Min As Single 'valor de mínimo  

00060             'Dim Max As Single 'valor de máximo  

00061             Dim Coste As Single 'valor de coste  

00062      

00063             Dim EnRuta As Boolean 

00064             'Dim Col As Color 'color del arco  

00065             'Dim Grosor As Single 'trazo del arco  

00066             Dim Nd1 As Integer 'nodo origen  

00067             Dim Nd2 As Integer 'nodo destino  

00068             Dim Camino As Boolean 

00069             'Dim B As Boolean 'doble flecha si o no  

00070         End Structure 

00071      

00072         'Declara la estructura del objeto Nodo  

00073         Public Structure Nodo 

00074             Dim Texto As String 'etiqueta  

00075      

00076             Dim EnArco As Long 

00077             Dim Estatus As Integer 

00078             Dim Distancia As Single 

00079      

00080             'Dim Valor As Single 'valor del nodo  

00081             'Dim X As Single 'coordenadas  

00082             'Dim Y As Single  

00083             'Dim Z As Single  

00084             'Dim Col As Color 'color de relleno del nodo  

00085             'Dim Radio As Single 'radio del nodo  

00086             'Dim Grosor As Single 'trazo del nodo  

00087         End Structure 

00088      

00089         'Totales de Nodos y Arcos  

00090         Public TotalNodos As Long 

00091         Public TotalArcos As Long 

00092      

00093         'Crea las colecciones para ambos objetos  

00094         Public Nodos ( 1 ) As Nodo 

00095         Public Arcos ( 1 ) As Arco 

00096      

00097      



00098         Public Function Inicio ( ByVal NodoInicio As Integer , Optional ByVal NodoFin  

       »           As Integer = - 1 , Optional ByVal CCritico As Boolean = False ) 

00099      

00100             'el parámetro es el nodo de inicio  

00101             'para el cálculo de la ruta mínima  

00102             '-------------------------------  

00103             'Avisar en caso de error  

00104             If NodoInicio < 0 Or NodoInicio > TotalNodos - 1 Then 

00105                 RaiseEvent Fallo ( "El nodo inicial no pertenece al grafo." & vbCrLf & 

       »                   "Consulte con el programador." ) 

00106                 'salir en caso de error  

00107                 Exit Function 

00108             End If 

00109      

00110             'Avisar en caso de error  

00111             If NodoFin <> - 1 Then 

00112                 If NodoFin < 0 Or NodoFin > TotalNodos - 1 Then 

00113                     RaiseEvent Fallo ( "El nodo final no pertenece al grafo." &  

       »                       vbCrLf & "Consulte con el programador." ) 

00114                     'salir en caso de error  

00115                     Exit Function 

00116                 End If 

00117             End If 

00118      

00119      

00120      

00121             '-------------------------------  

00122             'Chequear la integridad de las propiedades  

00123             If DatosIncorrectos = True Then Exit Function 

00124             '-------------------------------  

00125      

00126             'Inicio cálculo de tiempo  

00127             Dim TInicio As Date = Now 

00128      

00129             If CCritico = False Then 

00130                 '-------------------------------  

00131                 'Llamar al proceso de cálculo  

00132                 'arbol mínimo  

00133                 CaminoMinimo ( NodoInicio ) 

00134                 '-------------------------------  

00135             Else 

00136                 '-------------------------------  

00137                 'Llamar al proceso de cálculo  

00138                 'arbol máximo  

00139                 CaminoMaximo ( NodoInicio ) 

00140                 '-------------------------------  

00141             End If 

00142      

00143             'fin cálculo de tiempo  

00144             Dim tiempoproceso As Long 

00145             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

00146      

00147      

00148             'Busca camino hacia atrás desde el nodo fin  

00149             If NodoFin <> - 1 Then 

00150                 Dim Ndo As Integer 

00151                 Ndo = NodoFin 

00152      

00153                 Do 

00154                     If Nodos ( Ndo ) . EnArco = - 1 Then 

00155                         'Exit Do 'camino incompleto  

00156                         RaiseEvent Fallo ( "No existe un camino entre ese par de  

       »                           nodos." ) 

00157                         'salir en caso de error  

00158                         Exit Function 

00159                     End If 

00160                     Arcos ( Nodos ( Ndo ) . EnArco ) . Camino = True 

00161                     Ndo = Arcos ( Nodos ( Ndo ) . EnArco ) . Nd1 

00162                 Loop Until Ndo = NodoInicio 

00163      

00164             End If 

00165      

00166      

00167      

00168             'prepara los resultados para ser devueltos  

00169             '------------------------------------------------  

00170             Dim TextoResultado As String 

00171             Dim CosteTotal As Single = 0 

00172             Dim i , j As Long 

00173             Dim MatrizSolucion ( TotalNodos - 1 , TotalNodos - 1 ) As Integer 

00174      

00175      

00176             If CCritico = False Then 

00177                 If NodoFin <> - 1 Then 

00178                     TextoResultado = "CAMINO MÍNIMO - ALGORITMO DE DIJKSTRA" &  

       »                       vbCrLf 

00179                 Else 

00180                     TextoResultado = "ÁRBOL MÍNIMO - ALGORITMO DE DIJKSTRA" &  

       »                       vbCrLf 

00181                 End If 

00182             Else 

00183                 If NodoFin <> - 1 Then 

00184                     TextoResultado = "CAMINO CRÍTICO - ALGORITMO DE DIJKSTRA" &  

       »                       vbCrLf 

00185                 Else 

00186                     TextoResultado = "ÁRBOL MÁXIMO - ALGORITMO DE DIJKSTRA" &  

       »                       vbCrLf 

00187                 End If 

00188             End If 

00189      

00190             TextoResultado = TextoResultado &  

       »               "---------------------------------------" & vbCrLf 

00191             TextoResultado = TextoResultado & "" & vbCrLf 

00192      

00193             TextoResultado = TextoResultado & "Tiempo de proceso = " & tiempoproceso 

       »               & " segundos" & vbCrLf & vbCrLf 

00194             TextoResultado = TextoResultado & "Arcos calculados desde el nodo  

       »               inicial (" & Nodos ( NodoInicio ) . Texto & ")" 

00195      

00196             If NodoFin <> - 1 Then 

00197                 TextoResultado = TextoResultado & " hasta el nodo fin (" & Nodos (  

       »                   NodoFin ) . Texto & ")" 

00198             End If 

00199             TextoResultado = TextoResultado & ":" & vbCrLf & vbCrLf 

00200      

00201             For i = 0 To TotalArcos - 1 

00202                 If Arcos ( i ) . EnRuta = True Then 

00203                     If NodoFin <> - 1 Then 

00204                         If Arcos ( i ) . Camino = True Then 

00205                             'Marca sólo el camino  

00206                             TextoResultado = TextoResultado & " * " & Nodos ( Arcos  

       »                               ( i ) . Nd1 ) . Texto & " ----(" & Arcos ( i ) . Coste & ")---> " 

       »                               & Nodos ( Arcos ( i ) . Nd2 ) . Texto & vbCrLf 

00207                             MatrizSolucion ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = 1 

00208                             CosteTotal = CosteTotal + Arcos ( i ) . Coste 

00209                         Else 

00210                         End If 

00211                     Else 

00212                         'Marca todo el arbol  

00213                         TextoResultado = TextoResultado & " " & Nodos ( Arcos ( i ) .  

       »                           Nd1 ) . Texto & " ----(" & Arcos ( i ) . Coste & ")---> " & Nodos  

       »                           ( Arcos ( i ) . Nd2 ) . Texto & vbCrLf 

00214                         MatrizSolucion ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = 1 

00215                     End If 

00216                 End If 

00217             Next i 

00218      

00219             If NodoFin <> - 1 Then 

00220                 TextoResultado = TextoResultado & vbCrLf & "Coste total = " &  

       »                   CosteTotal & vbCrLf 

00221             End If 

00222      

00223      

00224             If CCritico = False Then 

00225                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos con  

       »                   coste mínimo:" & vbCrLf & vbCrLf 

00226             Else 

00227                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos con  

       »                   coste máximo:" & vbCrLf & vbCrLf 

00228             End If 

00229      

00230             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00231             For i = 0 To TotalNodos - 1 

00232                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00233             Next i 

00234             TextoResultado = TextoResultado & vbCrLf 

00235      

00236             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00237                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00238                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00239                     TextoResultado = TextoResultado & MatrizSolucion ( i , j ) & vbTab 

00240                 Next j 

00241                 TextoResultado = TextoResultado & vbCrLf 

00242             Next i 

00243      

00244      

00245      

00246             '-------------------------------  

00247             'fin del proceso devuelve resultados  

00248             RaiseEvent Fin ( TextoResultado , MatrizSolucion ) 

00249             '-------------------------------  

00250         End Function 

00251      

00252      



00253         Public Property MatrizNodos () As Array 

00254             'Lectura de propiedades  

00255             Get 

00256                 'para devolver un valor desde la dll a la aplicación  

00257      

00258             End Get 

00259             Set ( ByVal Value As Array ) 

00260                 'para poner un valor desde la aplicación a la dll  

00261      

00262                 Dim i As Long 

00263                 'comprobar la integridad de los datos antes de proseguir  

00264                 i = UBound ( Value ) 

00265                 If i > 0 Then 

00266                     'dimensiona el total de nodos  

00267                     TotalNodos = i + 1 

00268                     'toma los datos de nodos y los pone en la estructura  

00269                     For i = 0 To UBound ( Value ) 

00270                         ReDim Preserve Nodos ( i ) 

00271                         Nodos ( i ) . Texto = Value ( i ) 

00272                     Next i 

00273                 Else 

00274                     'no hay suficientes nodos  

00275                     RaiseEvent Fallo ( "Deben existir al menos dos Nodos y un Arco  

       »                       para definir un grafo." ) 

00276                     DatosIncorrectos = True 

00277                 End If 

00278      

00279             End Set 

00280         End Property 

00281         Public Property MatrizArcos () As Array 

00282             'Lectura de propiedades  

00283             Get 

00284                 'para devolver un valor desde la dll a la aplicación  

00285      

00286             End Get 

00287             Set ( ByVal Value As Array ) 

00288                 'para poner un valor desde la aplicación a la dll  

00289                 Dim i As Long 

00290                 Dim j As Long 

00291      

00292                 'comprobar la integridad de los datos antes de proseguir  

00293                 i = UBound ( Value , 1 ) 'primera dimensión de la matriz  

00294                 j = UBound ( Value , 2 ) 'segunda dimensión de la matriz  

00295      

00296                 If i = j And i = TotalNodos - 1 Then 

00297                     'Recorre la matriz para tomar los datos y ponerlos en  

00298                     'la estructura de arcos  

00299                     TotalArcos = 0 

00300                     For i = 0 To TotalNodos - 1 

00301                         For j = 0 To TotalNodos - 1 

00302                             'el algoritmo de Dijkstra no debe tener pesos  

00303                             'de arco menores que cero  

00304                             If i <> j And Value ( i , j ) >= 0 Then 

00305                                 TotalArcos = TotalArcos + 1 

00306                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

00307      

00308                                 Arcos ( TotalArcos - 1 ) . Nd1 = i 

00309                                 Arcos ( TotalArcos - 1 ) . Nd2 = j 

00310                                 Arcos ( TotalArcos - 1 ) . Coste = Value ( i , j ) 

00311                             End If 

00312                             If i = j And Value ( i , j ) >= 0 Then 

00313                                 'arco sobre un mismo nodo no permitido  

00314                                 RaiseEvent Fallo ( "Se ha encontrado un arco sobre  

       »                                   sí mismo en el nodo (" & Nodos ( i ) . Texto & ")." &  

       »                                   vbCrLf & "Esto no está permitido en el Algoritmo  

       »                                   de Dijkstra." ) 

00315                                 DatosIncorrectos = True 

00316                             End If 

00317      

00318                         Next j 

00319                     Next i 

00320      

00321                 Else 

00322                     'no hay suficientes arcos  

00323                     RaiseEvent Fallo ( "Las dimensiones de la matriz de Arcos no  

       »                       concuerdan con el total de nodos." ) 

00324                     DatosIncorrectos = True 

00325                 End If 

00326                 If TotalArcos = 0 Then 

00327                     'no hay suficientes arcos  

00328                     RaiseEvent Fallo ( "Debe existir al menos un Arco entre dos Nodos 

       »                       para definir un grafo." ) 

00329                     DatosIncorrectos = True 

00330                 End If 

00331      

00332             End Set 

00333         End Property 

00334      

00335      



00336         Sub CaminoMinimo ( ByVal NdInicial As Integer ) 

00337             Dim Candidatos As New Collection () 

00338             Dim Indice As Integer 

00339             Dim MejorNd As Integer 

00340             Dim MejorDist As Single 

00341             Dim NuevaDist As Single 

00342             Dim Nd As Integer 

00343             Dim ANodo As Integer 

00344             Dim Arc As Integer 

00345      

00346             'Resetea el camino mínimo  

00347             ResetCamino () 

00348      

00349             'Comienza el algoritmo poniendo el nodo de inicio en los candidatos  

00350             Candidatos . Add ( NdInicial ) 

00351      

00352             'El proceso termina cuando la lista de candidatos está vacia  

00353             Do While Candidatos . Count > 0 

00354                 'Busca el nodo de la colección con menor distancia total  

00355                 'Ese será marcado como mejor nodo  

00356                 MejorDist = cMaximo 

00357                 For Indice = 1 To Candidatos . Count 

00358                     NuevaDist = Nodos ( Candidatos ( Indice )) . Distancia 

00359                     If NuevaDist < MejorDist Then 

00360                         MejorDist = NuevaDist 

00361                         MejorNd = Indice 

00362                     End If 

00363                 Next 

00364                 'toma ese nodo como referencia  

00365                 Nd = Candidatos ( MejorNd ) 

00366                 'antes de quitarlo de la colección  

00367                 Candidatos . Remove ( MejorNd ) 

00368                 'y de marcarlo como procesado  

00369                 Nodos ( Nd ) . Estatus = cProcesado 

00370      

00371                 'Rastrea todos los arcos  

00372                 For Arc = 0 To UBound ( Arcos ) 

00373                     'en busca de arcos de origen el nodo actual  

00374                     If Arcos ( Arc ) . Nd1 = Nd Then 

00375                         'y que no sea un arco sobre el mismo nodo  

00376                         If Arcos ( Arc ) . Nd2 <> Nd Then 

00377                             'toma el nodo de destino  

00378                             ANodo = Arcos ( Arc ) . Nd2 

00379      

00380                             If Nodos ( ANodo ) . Estatus = cSinEstatus Then 

00381                                 Candidatos . Add ( ANodo ) 

00382      

00383                                 Nodos ( ANodo ) . Estatus = cCandidato 

00384                                 Nodos ( ANodo ) . Distancia = MejorDist + Arcos ( Arc ) .  

       »                                   Coste 

00385                                 Nodos ( ANodo ) . EnArco = Arc 

00386                             ElseIf Nodos ( ANodo ) . Estatus = cCandidato Then 

00387                                 NuevaDist = MejorDist + Arcos ( Arc ) . Coste 

00388      

00389                                 If NuevaDist < Nodos ( ANodo ) . Distancia Then 

00390                                     Nodos ( ANodo ) . Distancia = NuevaDist 

00391                                     Nodos ( ANodo ) . EnArco = Arc 

00392                                 End If 

00393                             End If 

00394      

00395                         End If 

00396                     End If 

00397                 Next Arc 

00398             Loop 

00399      

00400             'subraya los arcos de la solución  

00401             Dim i As Long 

00402             For i = 0 To UBound ( Nodos ) 

00403                 If Not ( Nodos ( i ) . EnArco = - 1 ) Then Arcos ( Nodos ( i ) . EnArco ) . EnRuta =  

       »                   True 

00404             Next i 

00405      

00406         End Sub 

00407         Sub CaminoMaximo ( ByVal NdInicial As Integer ) 

00408             Dim Candidatos As New Collection () 

00409             Dim Indice As Integer 

00410             Dim MejorNd As Integer 

00411             Dim MejorDist As Single 

00412             Dim NuevaDist As Single 

00413             Dim Nd As Integer 

00414             Dim ANodo As Integer 

00415             Dim Arc As Integer 

00416      

00417             'Resetea el camino mínimo  

00418             ResetCamino () 

00419      

00420             'Comienza el algoritmo poniendo el nodo de inicio en los candidatos  

00421             Candidatos . Add ( NdInicial ) 

00422      

00423             'El proceso termina cuando la lista de candidatos está vacia  

00424             Do While Candidatos . Count > 0 

00425                 'Busca el nodo de la colección con mayor distancia total  

00426                 'Ese será marcado como mejor nodo  

00427                 MejorDist = cMinimo 

00428                 For Indice = 1 To Candidatos . Count 

00429                     NuevaDist = Nodos ( Candidatos ( Indice )) . Distancia 

00430                     If NuevaDist >= MejorDist Then 

00431                         MejorDist = NuevaDist 

00432                         MejorNd = Indice 

00433                     End If 

00434                 Next 

00435                 'toma ese nodo como referencia  

00436                 Nd = Candidatos ( MejorNd ) 

00437                 'antes de quitarlo de la colección  

00438                 Candidatos . Remove ( MejorNd ) 

00439                 'y de marcarlo como procesado  

00440                 Nodos ( Nd ) . Estatus = cProcesado 

00441      

00442                 'Rastrea todos los arcos  

00443                 For Arc = 0 To UBound ( Arcos ) 

00444                     'en busca de arcos de origen el nodo actual  

00445                     If Arcos ( Arc ) . Nd1 = Nd Then 

00446                         'y que no sea un arco sobre el mismo nodo  

00447                         If Arcos ( Arc ) . Nd2 <> Nd Then 

00448                             'toma el nodo de destino  

00449                             ANodo = Arcos ( Arc ) . Nd2 

00450      

00451                             If Nodos ( ANodo ) . Estatus = cSinEstatus Then 

00452                                 Candidatos . Add ( ANodo ) 

00453      

00454                                 Nodos ( ANodo ) . Estatus = cCandidato 

00455                                 Nodos ( ANodo ) . Distancia = MejorDist + Arcos ( Arc ) .  

       »                                   Coste 

00456                                 Nodos ( ANodo ) . EnArco = Arc 

00457                             ElseIf Nodos ( ANodo ) . Estatus = cCandidato Then 

00458                                 NuevaDist = MejorDist + Arcos ( Arc ) . Coste 

00459      

00460                                 If NuevaDist >= Nodos ( ANodo ) . Distancia Then 

00461                                     Nodos ( ANodo ) . Distancia = NuevaDist 

00462                                     Nodos ( ANodo ) . EnArco = Arc 

00463                                 End If 

00464                             End If 

00465      

00466                         End If 

00467                     End If 

00468                 Next Arc 

00469             Loop 

00470      

00471             'subraya los arcos de la solución  

00472             Dim i As Long 

00473             For i = 0 To UBound ( Nodos ) 

00474                 If Not ( Nodos ( i ) . EnArco = - 1 ) Then Arcos ( Nodos ( i ) . EnArco ) . EnRuta =  

       »                   True 

00475             Next i 

00476      

00477         End Sub 

00478      

00479         Sub ResetCamino () 

00480             'Inicializa los arrays para el cálculo del algoritmo  

00481      

00482             Dim i As Long 

00483             For i = 0 To UBound ( Nodos ) 

00484                 Nodos ( i ) . EnArco = - 1 

00485                 Nodos ( i ) . Estatus = cSinEstatus 

00486                 Nodos ( i ) . Distancia = 0 

00487             Next i 

00488      

00489             For i = 0 To UBound ( Arcos ) 

00490                 Arcos ( i ) . EnRuta = False 

00491                 Arcos ( i ) . Camino = False 

00492             Next i 

00493      

00494         End Sub 

00495      

00496      

00497         Protected Overrides Sub Finalize () 

00498             MyBase . Finalize () 

00499         End Sub 

00500     End Class 

00001     Public Class BellmanFord 

00002         Inherits System . Windows . Forms . UserControl 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'UserControl1 reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00033             '  

00034             'BellmanFord  

00035             '  

00036             Me . Name = "BellmanFord" 

00037      

00038         End Sub 

00039      

00040     # End Region 

00041      

00042         Private Const cSinEstatus As Integer = 0 

00043         'Private Const cCandidato As Integer = 1  

00044         Private Const cProcesado As Integer = 2 

00045         Private Const cMaximo As Single = 999999999999999999 

00046         Private Const cMinimo As Single = - 999999999999999999 

00047      

00048         'Declaraciones de Eventos  

00049         Public Event Fin ( ByVal TextoRespuesta As String , ByVal MatrizArcosMinimos As 

       »           Array )  'ver parámetros de solución  

00050         Public Event Fallo ( ByVal TextoError As String ) 

00051         'Declaraciones de Variables  

00052         Public DatosIncorrectos As Boolean = False 

00053      



00054         'Declara la estructura del objeto Arco o relación entre nodos  

00055         Public Structure Arco 

00056             'Dim Texto As String 'etiqueta  

00057             'Dim Min As Single 'valor de mínimo  

00058             'Dim Max As Single 'valor de máximo  

00059             Dim Coste As Single 'valor de coste  

00060      

00061             Dim Camino As Boolean 

00062             'Dim Col As Color 'color del arco  

00063             'Dim Grosor As Single 'trazo del arco  

00064             Dim Nd1 As Integer 'nodo origen  

00065             Dim Nd2 As Integer 'nodo destino  

00066      

00067             'Dim Camino As Boolean  

00068             'Dim B As Boolean 'doble flecha si o no  

00069         End Structure 

00070      

00071         'Declara la estructura del objeto Nodo  

00072         Public Structure Nodo 

00073             Dim Texto As String 'etiqueta  

00074      

00075             Dim Precedente As Long 

00076             Dim Estatus As Integer 

00077             Dim Distancia As Single 

00078      

00079             'Dim Valor As Single 'valor del nodo  

00080             'Dim X As Single 'coordenadas  

00081             'Dim Y As Single  

00082             'Dim Z As Single  

00083             'Dim Col As Color 'color de relleno del nodo  

00084             'Dim Radio As Single 'radio del nodo  

00085             'Dim Grosor As Single 'trazo del nodo  

00086         End Structure 

00087      

00088         'Totales de Nodos y Arcos  

00089         Public TotalNodos As Long 

00090         Public TotalArcos As Long 

00091      

00092         'Crea las colecciones para ambos objetos  

00093         Public Nodos ( 1 ) As Nodo 

00094         Public Arcos ( 1 ) As Arco 

00095      



00096         Public Property MatrizNodos () As Array 

00097             'Lectura de propiedades  

00098             Get 

00099                 'para devolver un valor desde la dll a la aplicación  

00100      

00101             End Get 

00102             Set ( ByVal Value As Array ) 

00103                 'para poner un valor desde la aplicación a la dll  

00104                 DatosIncorrectos = False 

00105                 Dim i As Long 

00106                 'comprobar la integridad de los datos antes de proseguir  

00107                 i = UBound ( Value ) 

00108                 If i > 0 Then 

00109                     'dimensiona el total de nodos  

00110                     TotalNodos = i + 1 

00111                     'toma los datos de nodos y los pone en la estructura  

00112                     For i = 0 To UBound ( Value ) 

00113                         ReDim Preserve Nodos ( i ) 

00114                         Nodos ( i ) . Texto = Value ( i ) 

00115                     Next i 

00116                 Else 

00117                     'no hay suficientes nodos  

00118                     RaiseEvent Fallo ( "Deben existir al menos dos Nodos y un Arco  

       »                       para definir un grafo." ) 

00119                     DatosIncorrectos = True 

00120                 End If 

00121      

00122             End Set 

00123         End Property 

00124         Public Property MatrizArcos () As Array 

00125             'Lectura de propiedades  

00126             Get 

00127                 'para devolver un valor desde la dll a la aplicación  

00128      

00129             End Get 

00130             Set ( ByVal Value As Array ) 

00131                 'para poner un valor desde la aplicación a la dll  

00132                 Dim i As Long 

00133                 Dim j As Long 

00134                 DatosIncorrectos = False 

00135                 'comprobar la integridad de los datos antes de proseguir  

00136                 i = UBound ( Value , 1 ) 'primera dimensión de la matriz  

00137                 j = UBound ( Value , 2 ) 'segunda dimensión de la matriz  

00138      

00139                 If i = j And i = TotalNodos - 1 Then 

00140                     'Recorre la matriz para tomar los datos y ponerlos en  

00141                     'la estructura de arcos  

00142                     TotalArcos = 0 

00143                     For i = 0 To TotalNodos - 1 

00144                         For j = 0 To TotalNodos - 1 

00145                             'el algoritmo de BellmanFord puede tener pesos  

00146                             'de arco menores que cero  

00147                             'para indicar que no existe arco se usará la  

00148                             'cMaximo= 999999999999999999  

00149                             'cMinimo = -999999999999999999  

00150                             If i <> j And Value ( i , j ) < cMaximo And Value ( i , j ) > 

       »                               cMinimo Then 

00151                                 TotalArcos = TotalArcos + 1 

00152                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

00153      

00154                                 Arcos ( TotalArcos - 1 ) . Nd1 = i 

00155                                 Arcos ( TotalArcos - 1 ) . Nd2 = j 

00156                                 Arcos ( TotalArcos - 1 ) . Coste = Value ( i , j ) 

00157                             End If 

00158                             If i = j Then 

00159                                 'arco sobre un mismo nodo no permitido  

00160                                 'RaiseEvent Fallo("Se ha encontrado un arco sobre  

       »                                   sí mismo en el nodo (" & Nodos(i).Texto & ")." &  

       »                                   vbCrLf & "Esto no está permitido en el Algoritmo  

       »                                   de BellmanFord.")  

00161                                 'DatosIncorrectos = True  

00162                             End If 

00163      

00164                         Next j 

00165                     Next i 

00166      

00167                 Else 

00168                     'no hay suficientes arcos  

00169                     RaiseEvent Fallo ( "Las dimensiones de la matriz de Arcos no  

       »                       concuerdan con el total de nodos." ) 

00170                     DatosIncorrectos = True 

00171                 End If 

00172                 If TotalArcos = 0 Then 

00173                     'no hay suficientes arcos  

00174                     RaiseEvent Fallo ( "Debe existir al menos un Arco entre dos Nodos 

       »                       para definir un grafo." ) 

00175                     DatosIncorrectos = True 

00176                 End If 

00177      

00178             End Set 

00179         End Property 

00180      



00181         Public Function Inicio ( ByVal NodoInicio As Integer , Optional ByVal NodoFin  

       »           As Integer = - 1 , Optional ByVal Maximo As Boolean = False ) 

00182      

00183             'el parámetro es el nodo de inicio  

00184             'para el cálculo de la ruta mínima  

00185             '-------------------------------  

00186             'Avisar en caso de error  

00187             If NodoInicio < 0 Or NodoInicio > TotalNodos - 1 Then 

00188                 RaiseEvent Fallo ( "El nodo inicial no pertenece al grafo." & vbCrLf & 

       »                   "Consulte con el programador." ) 

00189                 'salir en caso de error  

00190                 Exit Function 

00191             End If 

00192      

00193             'Avisar en caso de error  

00194             If NodoFin <> - 1 Then 

00195                 If NodoFin < 0 Or NodoFin > TotalNodos - 1 Then 

00196                     RaiseEvent Fallo ( "El nodo final no pertenece al grafo." &  

       »                       vbCrLf & "Consulte con el programador." ) 

00197                     'salir en caso de error  

00198                     Exit Function 

00199                 End If 

00200             End If 

00201      

00202      

00203      

00204             'Inicio cálculo de tiempo  

00205             Dim TInicio As Date = Now 

00206      

00207      

00208             '-------------------------------  

00209             'Llamar al proceso de cálculo  

00210             'arbol mínimo  

00211             CaminoMinimo ( NodoInicio , NodoFin , Maximo ) 

00212             '-------------------------------  

00213      

00214      

00215             If DatosIncorrectos = True Then 

00216      

00217                 'TextoResultado = TextoResultado & "NO SE HA ENCONTRADO SOLUCIÓN >  

       »                   "  

00218                 'TextoResultado = TextoResultado & "Nodos no conectados o  

       »                   existencia de lazo" & vbCrLf  

00219      

00220                 RaiseEvent Fallo ( "No se encuentra solución." & vbCrLf & "Los nodos  

       »                   no están conectados o existe un lazo." ) 

00221                 DatosIncorrectos = False 

00222                 Exit Function 

00223             End If 

00224      

00225      

00226             'fin cálculo de tiempo  

00227             Dim tiempoproceso As Long 

00228             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

00229      

00230             'prepara los resultados para ser devueltos  

00231             '------------------------------------------------  

00232             Dim TextoResultado As String 

00233             Dim CosteTotal As Single = 0 

00234             Dim i , j As Long 

00235             Dim MatrizSolucion ( TotalNodos - 1 , TotalNodos - 1 ) As Integer 

00236      

00237      

00238             If Maximo = False Then 

00239                 TextoResultado = "CAMINO MÍNIMO - ALGORITMO DE BELLMAN-FORD" &  

       »                   vbCrLf 

00240             Else 

00241                 TextoResultado = "CAMINO MÁXIMO - ALGORITMO DE BELLMAN-FORD" &  

       »                   vbCrLf 

00242             End If 

00243      

00244             TextoResultado = TextoResultado &  

       »               "-----------------------------------------" & vbCrLf 

00245             TextoResultado = TextoResultado & "" & vbCrLf 

00246      

00247             TextoResultado = TextoResultado & "Tiempo de proceso = " & tiempoproceso 

       »               & " segundos" & vbCrLf & vbCrLf 

00248      

00249             TextoResultado = TextoResultado & "Arcos calculados desde el nodo  

       »               inicial (" & Nodos ( NodoInicio ) . Texto & ")" 

00250             TextoResultado = TextoResultado & " hasta el nodo fin (" & Nodos ( NodoFin  

       »               ) . Texto & ")" 

00251      

00252             TextoResultado = TextoResultado & ":" & vbCrLf & vbCrLf 

00253      

00254             For i = 0 To TotalArcos - 1 

00255      

00256                 If Arcos ( i ) . Camino = True Then 

00257                     'Marca el camino  

00258                     TextoResultado = TextoResultado & " * " & Nodos ( Arcos ( i ) . Nd1 )  

       »                       . Texto & " ----(" & Arcos ( i ) . Coste & ")---> " & Nodos ( Arcos ( i  

       »                       ) . Nd2 ) . Texto & vbCrLf 

00259                     MatrizSolucion ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = 1 

00260                     CosteTotal = CosteTotal + Arcos ( i ) . Coste 

00261      

00262                 End If 

00263      

00264             Next i 

00265      

00266             TextoResultado = TextoResultado & vbCrLf & "Coste total = " & CosteTotal 

       »               & vbCrLf 

00267      

00268      

00269             If Maximo = False Then 

00270                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos con  

       »                   coste mínimo:" & vbCrLf & vbCrLf 

00271             Else 

00272                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos con  

       »                   coste máximo:" & vbCrLf & vbCrLf 

00273             End If 

00274      

00275             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00276             For i = 0 To TotalNodos - 1 

00277                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00278             Next i 

00279             TextoResultado = TextoResultado & vbCrLf 

00280      

00281             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00282                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00283                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00284                     TextoResultado = TextoResultado & MatrizSolucion ( i , j ) & vbTab 

00285                 Next j 

00286                 TextoResultado = TextoResultado & vbCrLf 

00287             Next i 

00288      

00289      

00290      

00291      

00292      



00293             '-------------------------------  

00294             'fin del proceso devuelve resultados  

00295             RaiseEvent Fin ( TextoResultado , MatrizSolucion ) 

00296             '-------------------------------  

00297         End Function 

00298      

00299      



00300         Sub CaminoMinimo ( ByVal NodoInicio As Integer , ByVal NodoFin As Integer ,  

       »           ByVal Maximo As Boolean ) 

00301      

00302             'Inicializa el algoritmo  

00303             ResetCamino ( NodoInicio , Maximo ) 

00304      

00305             Dim i , j As Integer 

00306             Dim Arc As Integer 

00307             Dim Contador As Integer 

00308             Dim Ndo , k As Integer 

00309      

00310             Contador = 1 

00311      

00312             Do 

00313      

00314                 For Arc = 0 To TotalArcos - 1 

00315                     i = Arcos ( Arc ) . Nd1 

00316                     j = Arcos ( Arc ) . Nd2 

00317      

00318                     If Maximo = False Then 

00319                         If Nodos ( i ) . Distancia + Arcos ( Arc ) . Coste < Nodos ( j ) .  

       »                           Distancia Then 

00320                             Nodos ( j ) . Distancia = Nodos ( i ) . Distancia + Arcos ( Arc ) .  

       »                               Coste 

00321                             Nodos ( j ) . Precedente = i 

00322                         End If 

00323                     Else 

00324                         If Nodos ( i ) . Distancia + Arcos ( Arc ) . Coste > Nodos ( j ) .  

       »                           Distancia Then 

00325                             Nodos ( j ) . Distancia = Nodos ( i ) . Distancia + Arcos ( Arc ) .  

       »                               Coste 

00326                             Nodos ( j ) . Precedente = i 

00327                         End If 

00328                     End If 

00329      

00330                 Next Arc 

00331      

00332                 Contador = Contador + 1 

00333             Loop Until Contador = TotalNodos 

00334             If PotencialFactible ( Maximo ) = False Then 

00335                 DatosIncorrectos = True 

00336             Else 

00337                 '-----------------  

00338                 Ndo = NodoFin 

00339                 Dim fin As Boolean = False 

00340                 Do 

00341                     Nodos ( Ndo ) . Estatus = cProcesado 

00342                     'Busca arco con nodo precedente  

00343                     For k = 0 To TotalArcos - 1 

00344                         If Arcos ( k ) . Nd1 = Nodos ( Ndo ) . Precedente And Arcos ( k ) . Nd2 = 

       »                           Ndo Then 

00345                             Arcos ( k ) . Camino = True 

00346                             Exit For 

00347                         End If 

00348                     Next k 

00349      

00350                     Ndo = Nodos ( Ndo ) . Precedente 

00351      

00352                     If Ndo = - 1 Then fin = True 

00353                     If fin = False Then 

00354                         If Nodos ( Ndo ) . Estatus = cProcesado Then 

00355                             fin = True 

00356                         End If 

00357                     End If 

00358      

00359                     If fin Then 

00360                         'no hay solución completa  

00361                         DatosIncorrectos = True 

00362                         'salir en caso de error  

00363                         Exit Do 

00364                     End If 

00365                 Loop Until Ndo = NodoInicio 

00366             End If 

00367      

00368      

00369      

00370         End Sub 

00371      

00372      

00373         Function PotencialFactible ( ByVal maximo As Boolean ) As Boolean 

00374      

00375             Dim i , j , arc As Integer 

00376             Dim factible As Boolean 

00377             factible = True 

00378      

00379             For arc = 0 To TotalArcos - 1 

00380                 i = Arcos ( arc ) . Nd1 

00381                 j = Arcos ( arc ) . Nd2 

00382      

00383                 If maximo = False Then 

00384      

00385                     If Nodos ( i ) . Distancia + Arcos ( arc ) . Coste >= Nodos ( j ) . Distancia  

       »                       Then 

00386                         factible = True 

00387                     Else 

00388                         factible = False 

00389                         Exit For 

00390                     End If 

00391                 Else 

00392                     If Nodos ( i ) . Distancia + Arcos ( arc ) . Coste <= Nodos ( j ) . Distancia  

       »                       Then 

00393                         factible = True 

00394                     Else 

00395                         factible = False 

00396                         Exit For 

00397                     End If 

00398                 End If 

00399             Next arc 

00400      

00401             Return factible 

00402      

00403         End Function 

00404      



00405         Sub ResetCamino ( ByVal NodoInicio As Integer , ByVal Maximo As Boolean ) 

00406             'Inicializa los arrays para el cálculo del algoritmo  

00407      

00408             Dim i As Long 

00409             For i = 0 To UBound ( Nodos ) 

00410                 If i = NodoInicio Then 

00411                     Nodos ( i ) . Precedente = 0 

00412                     Nodos ( i ) . Distancia = 0 

00413                 Else 

00414                     Nodos ( i ) . Precedente = - 1 

00415                     If Maximo = False Then 

00416                         Nodos ( i ) . Distancia = cMaximo 

00417                     Else 

00418                         Nodos ( i ) . Distancia = cMinimo 

00419                     End If 

00420                 End If 

00421                 Nodos ( i ) . Estatus = cSinEstatus 

00422             Next i 

00423      

00424             For i = 0 To UBound ( Arcos ) 

00425                 Arcos ( i ) . Camino = False 

00426             Next i 

00427      

00428         End Sub 

00429      

00430         Protected Overrides Sub Finalize () 

00431             MyBase . Finalize () 

00432         End Sub 

00433     End Class 

00001     Public Class Kruskal 

00002         Inherits System . Windows . Forms . UserControl 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'UserControl1 reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00033             '  

00034             'Kruskal  

00035             '  

00036             Me . Name = "Kruskal" 

00037      

00038         End Sub 

00039      

00040     # End Region 

00041         'Declaraciones de Eventos  

00042         Public Event Fin ( ByVal TextoRespuesta As String , ByVal MatrizArcosMinimos As 

       »           Array )  'ver parámetros de solución  

00043         Public Event Fallo ( ByVal TextoError As String ) 

00044         'Declaraciones de Variables  

00045         Public DatosIncorrectos As Boolean = False 

00046      

00047         Private Const cSinEstatus As Integer = 0 

00048         'Private Const cCandidato As Integer = 1  

00049         'Private Const cProcesado As Integer = 2  

00050         Private Const cMaximo As Single = 999999999999999999 

00051         Private Const cMinimo As Single = - 999999999999999999 

00052      

00053      

00054      



00055         'Declara la estructura del objeto Arco o relación entre nodos  

00056         Public Structure Arco 

00057             'Dim Texto As String 'etiqueta  

00058             'Dim Min As Single 'valor de mínimo  

00059             'Dim Max As Single 'valor de máximo  

00060             Dim Coste As Single 'valor de coste  

00061      

00062             Dim Camino As Boolean 

00063             'Dim Col As Color 'color del arco  

00064             'Dim Grosor As Single 'trazo del arco  

00065             Dim Nd1 As Integer 'nodo origen  

00066             Dim Nd2 As Integer 'nodo destino  

00067      

00068             'Dim Camino As Boolean  

00069             'Dim B As Boolean 'doble flecha si o no  

00070         End Structure 

00071      

00072         'Declara la estructura del objeto Nodo  

00073         Public Structure Nodo 

00074             Dim Texto As String 'etiqueta  

00075      

00076             'Dim Precedente As Long  

00077             Dim Estatus As Integer 

00078             'Dim Distancia As Single  

00079      

00080             'Dim Valor As Single 'valor del nodo  

00081             'Dim X As Single 'coordenadas  

00082             'Dim Y As Single  

00083             'Dim Z As Single  

00084             'Dim Col As Color 'color de relleno del nodo  

00085             'Dim Radio As Single 'radio del nodo  

00086             'Dim Grosor As Single 'trazo del nodo  

00087         End Structure 

00088      

00089         'Totales de Nodos y Arcos  

00090         Public TotalNodos As Long 

00091         Public TotalArcos As Long 

00092      

00093         'Crea las colecciones para ambos objetos  

00094         Public Nodos ( 1 ) As Nodo 

00095         Public Arcos ( 1 ) As Arco 

00096      



00097         Public Property MatrizNodos () As Array 

00098             'Lectura de propiedades  

00099             Get 

00100                 'para devolver un valor desde la dll a la aplicación  

00101      

00102             End Get 

00103             Set ( ByVal Value As Array ) 

00104                 'para poner un valor desde la aplicación a la dll  

00105                 DatosIncorrectos = False 

00106                 Dim i As Long 

00107                 'comprobar la integridad de los datos antes de proseguir  

00108                 i = UBound ( Value ) 

00109                 If i > 0 Then 

00110                     'dimensiona el total de nodos  

00111                     TotalNodos = i + 1 

00112                     'toma los datos de nodos y los pone en la estructura  

00113                     For i = 0 To UBound ( Value ) 

00114                         ReDim Preserve Nodos ( i ) 

00115                         Nodos ( i ) . Texto = Value ( i ) 

00116                         Nodos ( i ) . Estatus = cSinEstatus 

00117                     Next i 

00118                 Else 

00119                     'no hay suficientes nodos  

00120                     RaiseEvent Fallo ( "Deben existir al menos dos Nodos y un Arco  

       »                       para definir un grafo." ) 

00121                     DatosIncorrectos = True 

00122                 End If 

00123      

00124             End Set 

00125         End Property 

00126         Public Property MatrizArcos () As Array 

00127             'Lectura de propiedades  

00128             Get 

00129                 'para devolver un valor desde la dll a la aplicación  

00130      

00131             End Get 

00132             Set ( ByVal Value As Array ) 

00133                 'para poner un valor desde la aplicación a la dll  

00134                 Dim i As Long 

00135                 Dim j As Long 

00136                 DatosIncorrectos = False 

00137                 'comprobar la integridad de los datos antes de proseguir  

00138                 i = UBound ( Value , 1 ) 'primera dimensión de la matriz  

00139                 j = UBound ( Value , 2 ) 'segunda dimensión de la matriz  

00140      

00141                 If i = j And i = TotalNodos - 1 Then 

00142                     'Recorre la matriz para tomar los datos y ponerlos en  

00143                     'la estructura de arcos  

00144                     TotalArcos = 0 

00145                     For i = 0 To TotalNodos - 1 

00146                         For j = 0 To TotalNodos - 1 

00147                             'el algoritmo de Kruskal puede tener pesos  

00148                             'de arco menores que cero  

00149                             'para indicar que no existe arco se usará la  

00150                             'cMaximo= 999999999999999999  

00151                             'cMinimo = -999999999999999999  

00152                             If i <> j And Value ( i , j ) < cMaximo And Value ( i , j ) > 

       »                               cMinimo Then 

00153                                 TotalArcos = TotalArcos + 1 

00154                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

00155      

00156                                 Arcos ( TotalArcos - 1 ) . Nd1 = i 

00157                                 Arcos ( TotalArcos - 1 ) . Nd2 = j 

00158                                 Arcos ( TotalArcos - 1 ) . Coste = Value ( i , j ) 

00159                             End If 

00160                             'If i = j Then  

00161                             'arco sobre un mismo nodo no permitido  

00162                             'RaiseEvent Fallo("Se ha encontrado un arco sobre sí  

       »                               mismo en el nodo (" & Nodos(i).Texto & ")." & vbCrLf  

       »                               & "Esto no está permitido en el Algoritmo de  

       »                               Kruskal.")  

00163                             'DatosIncorrectos = True  

00164                             'End If  

00165      

00166                         Next j 

00167                     Next i 

00168      

00169                 Else 

00170                     'no hay suficientes arcos  

00171                     RaiseEvent Fallo ( "Las dimensiones de la matriz de Arcos no  

       »                       concuerdan con el total de nodos." ) 

00172                     DatosIncorrectos = True 

00173                 End If 

00174                 If TotalArcos = 0 Then 

00175                     'no hay suficientes arcos  

00176                     RaiseEvent Fallo ( "Debe existir al menos un Arco entre dos Nodos 

       »                       para definir un grafo." ) 

00177                     DatosIncorrectos = True 

00178                 End If 

00179      

00180             End Set 

00181         End Property 

00182         Public Function Inicio ( ByVal maximo As Boolean ) 

00183      

00184      

00185      

00186             'Inicio cálculo de tiempo  

00187             Dim TInicio As Date = Now 

00188      

00189      

00190             '-------------------------------  

00191             'Llamar al proceso de cálculo  

00192             'arbol mínimo  

00193             ArbolMinimo ( maximo ) 

00194             '-------------------------------  

00195      

00196      

00197      

00198             'fin cálculo de tiempo  

00199             Dim tiempoproceso As Long 

00200             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

00201      

00202      

00203             'prepara los resultados para ser devueltos  

00204             '------------------------------------------------  

00205             Dim TextoResultado As String 

00206             Dim CosteTotal As Single = 0 

00207             Dim i , j As Long 

00208             Dim MatrizSolucion ( TotalNodos - 1 , TotalNodos - 1 ) As Integer 

00209      

00210      

00211             If maximo = False Then 

00212                 TextoResultado = "ÁRBOL DE VALOR TOTAL MÍNIMO - ALGORITMO DE  

       »                   KRUSKAL" & vbCrLf 

00213             Else 

00214                 TextoResultado = "ÁRBOL DE VALOR TOTAL MÁXIMO - ALGORITMO DE  

       »                   KRUSKAL" & vbCrLf 

00215      

00216             End If 

00217      

00218             TextoResultado = TextoResultado &  

       »               "--------------------------------------------------" & vbCrLf 

00219             TextoResultado = TextoResultado & "" & vbCrLf 

00220      

00221             TextoResultado = TextoResultado & "Tiempo de proceso = " & tiempoproceso 

       »               & " segundos" & vbCrLf & vbCrLf 

00222      

00223      

00224             For i = 0 To TotalArcos - 1 

00225      

00226                 If Arcos ( i ) . Camino = True Then 

00227                     'Marca el camino  

00228                     TextoResultado = TextoResultado & " * " & Nodos ( Arcos ( i ) . Nd1 )  

       »                       . Texto & " ----(" & Arcos ( i ) . Coste & ")---> " & Nodos ( Arcos ( i  

       »                       ) . Nd2 ) . Texto & vbCrLf 

00229                     MatrizSolucion ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = 1 

00230                     CosteTotal = CosteTotal + Arcos ( i ) . Coste 

00231      

00232                 End If 

00233      

00234             Next i 

00235      

00236             TextoResultado = TextoResultado & vbCrLf & "Coste total = " & CosteTotal 

       »               & vbCrLf 

00237             If maximo = False Then 

00238                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos del  

       »                   árbol con coste mínimo:" & vbCrLf & vbCrLf 

00239             Else 

00240                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos del  

       »                   árbol con coste máximo:" & vbCrLf & vbCrLf 

00241             End If 

00242      

00243             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00244             For i = 0 To TotalNodos - 1 

00245                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00246             Next i 

00247             TextoResultado = TextoResultado & vbCrLf 

00248      

00249             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00250                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00251                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00252                     TextoResultado = TextoResultado & MatrizSolucion ( i , j ) & vbTab 

00253                 Next j 

00254                 TextoResultado = TextoResultado & vbCrLf 

00255             Next i 

00256      

00257      

00258      

00259      

00260             '-------------------------------  

00261             'fin del proceso devuelve resultados  

00262             RaiseEvent Fin ( TextoResultado , MatrizSolucion ) 

00263             '-------------------------------  

00264         End Function 

00265      



00266         Sub ArbolMinimo ( ByVal maximo As Boolean ) 

00267      

00268             'Comienza Algoritmo de Kruskal  

00269      

00270      

00271             Dim OrdenArco ( TotalArcos - 1 ) As Long 

00272             Dim ArcoOrdenado ( TotalArcos - 1 ) As Boolean 

00273             Dim i , j , k As Integer 

00274             Dim minCoste As Single 

00275             Dim minArco As Long 

00276             Dim arbol As Integer 

00277      

00278             'inicializa variables  

00279             For i = 0 To TotalArcos - 1 

00280                 ArcoOrdenado ( i ) = False 

00281                 OrdenArco ( i ) = - 1 

00282                 Arcos ( i ) . Camino = False 

00283             Next i 

00284      

00285             'ordena arcos en de menor a mayor  

00286             For i = 0 To TotalArcos - 1 

00287                 If maximo = False Then 

00288                     minCoste = cMaximo 'maximo valor posible  

00289                 Else 

00290                     minCoste = cMinimo 'maximo valor posible  

00291                 End If 

00292      

00293                 minArco = - 1 

00294      

00295                 'busca mínimo  

00296                 For j = 0 To TotalArcos - 1 

00297                     If ArcoOrdenado ( j ) = False Then 

00298      

00299                         If maximo = False Then 

00300                             If Arcos ( j ) . Coste <= minCoste Then 

00301                                 minCoste = Arcos ( j ) . Coste 

00302                                 minArco = j 

00303                             End If 

00304                         Else 

00305                             If Arcos ( j ) . Coste >= minCoste Then 

00306                                 minCoste = Arcos ( j ) . Coste 

00307                                 minArco = j 

00308                             End If 

00309      

00310                         End If 

00311                     End If 

00312                 Next j 

00313      

00314                 OrdenArco ( i ) = minArco 

00315                 ArcoOrdenado ( minArco ) = True 

00316      

00317             Next i 

00318             arbol = 0 

00319      

00320             Dim n1 , n2 As Integer 

00321             Dim a1 , a2 As Integer 

00322             'recorre todos los arcos en orden de menor a mayor  

00323             'buscando aquellos cuyos nodos no están ya cubiertos  

00324             For i = 0 To TotalArcos - 1 

00325      

00326                 j = OrdenArco ( i ) 

00327                 n1 = Arcos ( j ) . Nd1 

00328                 n2 = Arcos ( j ) . Nd2 

00329                 'se crea un arbol nuevo  

00330                 If Nodos ( n1 ) . Estatus = Nodos ( n2 ) . Estatus And Nodos ( n2 ) . Estatus =  

       »                   cSinEstatus Then 

00331                     arbol = arbol + 1 

00332      

00333                     Nodos ( n1 ) . Estatus = arbol 

00334                     Nodos ( n1 ) . Estatus = arbol 

00335                     Arcos ( j ) . Camino = True 

00336      

00337                 End If 

00338      

00339                 'se añade un nodo suelto a un arbol  

00340                 If Nodos ( n1 ) . Estatus <> Nodos ( n2 ) . Estatus And ( Nodos ( n1 ) . Estatus =  

       »                   cSinEstatus Or Nodos ( n2 ) . Estatus = cSinEstatus ) Then 

00341      

00342                     If Nodos ( n1 ) . Estatus = cSinEstatus Then 

00343                         Nodos ( n1 ) . Estatus = Nodos ( n2 ) . Estatus 

00344                     End If 

00345                     If Nodos ( n2 ) . Estatus = cSinEstatus Then 

00346                         Nodos ( n2 ) . Estatus = Nodos ( n1 ) . Estatus 

00347                     End If 

00348                     Arcos ( j ) . Camino = True 

00349      

00350                 End If 

00351      

00352                 'se fusionan dos arboles  

00353                 If Nodos ( n1 ) . Estatus <> Nodos ( n2 ) . Estatus And ( Nodos ( n1 ) . Estatus <> 

       »                   cSinEstatus And Nodos ( n2 ) . Estatus <> cSinEstatus ) Then 

00354                     a1 = Nodos ( n1 ) . Estatus 

00355                     a2 = Nodos ( n2 ) . Estatus 

00356                     Arcos ( j ) . Camino = True 

00357      

00358                     For k = 0 To TotalArcos - 1 

00359                         If Nodos ( Arcos ( k ) . Nd1 ) . Estatus = a2 Then 

00360                             Nodos ( Arcos ( k ) . Nd1 ) . Estatus = a1 

00361                         End If 

00362                         If Nodos ( Arcos ( k ) . Nd2 ) . Estatus = a2 Then 

00363                             Nodos ( Arcos ( k ) . Nd2 ) . Estatus = a1 

00364                         End If 

00365                     Next k 

00366      

00367                 End If 

00368      

00369      

00370             Next i 

00371      

00372         End Sub 

00373      

00374      

00375     End Class 

00001     Public Class Prim 

00002         Inherits System . Windows . Forms . UserControl 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'UserControl1 reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00033             components = New System . ComponentModel . Container () 

00034         End Sub 

00035      

00036     # End Region 

00037         'Declaraciones de Eventos  

00038         Public Event Fin ( ByVal TextoRespuesta As String , ByVal MatrizArcosMinimos As 

       »           Array )  'ver parámetros de solución  

00039         Public Event Fallo ( ByVal TextoError As String ) 

00040         'Declaraciones de Variables  

00041         Public DatosIncorrectos As Boolean = False 

00042      

00043         Private Const cSinEstatus As Integer = 0 

00044         Private Const cCandidato As Integer = 1 

00045         Private Const cProcesado As Integer = 2 

00046         Private Const cMaximo As Single = 999999999999999999 

00047         Private Const cMinimo As Single = - 999999999999999999 

00048      

00049      

00050      



00051         'Declara la estructura del objeto Arco o relación entre nodos  

00052         Public Structure Arco 

00053             'Dim Texto As String 'etiqueta  

00054             'Dim Min As Single 'valor de mínimo  

00055             'Dim Max As Single 'valor de máximo  

00056             Dim Coste As Single 'valor de coste  

00057      

00058             Dim Camino As Boolean 

00059             'Dim Col As Color 'color del arco  

00060             'Dim Grosor As Single 'trazo del arco  

00061             Dim Nd1 As Integer 'nodo origen  

00062             Dim Nd2 As Integer 'nodo destino  

00063      

00064             'Dim Camino As Boolean  

00065             'Dim B As Boolean 'doble flecha si o no  

00066         End Structure 

00067      

00068         'Declara la estructura del objeto Nodo  

00069         Public Structure Nodo 

00070             Dim Texto As String 'etiqueta  

00071      

00072             'Dim Precedente As Long  

00073             Dim Estatus As Integer 

00074             'Dim Distancia As Single  

00075             Dim ConArco As Boolean 

00076      

00077             'Dim Valor As Single 'valor del nodo  

00078             'Dim X As Single 'coordenadas  

00079             'Dim Y As Single  

00080             'Dim Z As Single  

00081             'Dim Col As Color 'color de relleno del nodo  

00082             'Dim Radio As Single 'radio del nodo  

00083             'Dim Grosor As Single 'trazo del nodo  

00084         End Structure 

00085      

00086         'Totales de Nodos y Arcos  

00087         Public TotalNodos As Long 

00088         Public TotalArcos As Long 

00089      

00090         'Crea las colecciones para ambos objetos  

00091         Public Nodos ( 1 ) As Nodo 

00092         Public Arcos ( 1 ) As Arco 

00093         Public MArcos ( 1 , 1 ) As Single 

00094      



00095         Public Property MatrizNodos () As Array 

00096             'Lectura de propiedades  

00097             Get 

00098                 'para devolver un valor desde la dll a la aplicación  

00099      

00100             End Get 

00101             Set ( ByVal Value As Array ) 

00102                 'para poner un valor desde la aplicación a la dll  

00103                 DatosIncorrectos = False 

00104                 Dim i As Long 

00105                 'comprobar la integridad de los datos antes de proseguir  

00106                 i = UBound ( Value ) 

00107                 If i > 0 Then 

00108                     'dimensiona el total de nodos  

00109                     TotalNodos = i + 1 

00110                     'toma los datos de nodos y los pone en la estructura  

00111                     For i = 0 To UBound ( Value ) 

00112                         ReDim Preserve Nodos ( i ) 

00113                         Nodos ( i ) . Texto = Value ( i ) 

00114                     Next i 

00115                 Else 

00116                     'no hay suficientes nodos  

00117                     RaiseEvent Fallo ( "Deben existir al menos dos Nodos y un Arco  

       »                       para definir un grafo." ) 

00118                     DatosIncorrectos = True 

00119                 End If 

00120      

00121             End Set 

00122         End Property 

00123         Public Property MatrizArcos () As Array 

00124             'Lectura de propiedades  

00125             Get 

00126                 'para devolver un valor desde la dll a la aplicación  

00127      

00128             End Get 

00129             Set ( ByVal Value As Array ) 

00130                 'para poner un valor desde la aplicación a la dll  

00131                 Dim i As Long 

00132                 Dim j As Long 

00133                 DatosIncorrectos = False 

00134                 'comprobar la integridad de los datos antes de proseguir  

00135                 i = UBound ( Value , 1 ) 'primera dimensión de la matriz  

00136                 j = UBound ( Value , 2 ) 'segunda dimensión de la matriz  

00137      

00138                 If i = j And i = TotalNodos - 1 Then 

00139                     'Recorre la matriz para tomar los datos y ponerlos en  

00140                     'la estructura de arcos  

00141                     TotalArcos = 0 

00142                     For i = 0 To TotalNodos - 1 

00143                         For j = 0 To TotalNodos - 1 

00144                             'el algoritmo de Prim puede tener pesos  

00145                             'de arco menores que cero  

00146                             'para indicar que no existe arco se usará la  

00147                             'cMaximo= 999999999999999999  

00148                             'cMinimo = -999999999999999999  

00149                             If i <> j And Value ( i , j ) < cMaximo And Value ( i , j ) > 

       »                               cMinimo Then 

00150                                 TotalArcos = TotalArcos + 1 

00151                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

00152      

00153                                 Arcos ( TotalArcos - 1 ) . Nd1 = i 

00154                                 Arcos ( TotalArcos - 1 ) . Nd2 = j 

00155                                 Arcos ( TotalArcos - 1 ) . Coste = Value ( i , j ) 

00156                             End If 

00157                             'If i = j Then  

00158                             'arco sobre un mismo nodo no permitido  

00159                             'RaiseEvent Fallo("Se ha encontrado un arco sobre sí  

       »                               mismo en el nodo (" & Nodos(i).Texto & ")." & vbCrLf  

       »                               & "Esto no está permitido en el Algoritmo de Prim.")  

00160                             'DatosIncorrectos = True  

00161                             'End If  

00162      

00163                         Next j 

00164                     Next i 

00165      

00166                 Else 

00167                     'no hay suficientes arcos  

00168                     RaiseEvent Fallo ( "Las dimensiones de la matriz de Arcos no  

       »                       concuerdan con el total de nodos." ) 

00169                     DatosIncorrectos = True 

00170                 End If 

00171                 If TotalArcos = 0 Then 

00172                     'no hay suficientes arcos  

00173                     RaiseEvent Fallo ( "Debe existir al menos un Arco entre dos Nodos 

       »                       para definir un grafo." ) 

00174                     DatosIncorrectos = True 

00175                 End If 

00176      

00177             End Set 

00178         End Property 

00179         Public Function Inicio ( ByVal maximo As Boolean ) 

00180      

00181      

00182      

00183             'Inicio cálculo de tiempo  

00184             Dim TInicio As Date = Now 

00185      

00186      

00187             '-------------------------------  

00188             'Llamar al proceso de cálculo  

00189             'arbol mínimo  

00190             ArbolMinimo ( maximo ) 

00191             '-------------------------------  

00192      

00193      

00194      

00195             'fin cálculo de tiempo  

00196             Dim tiempoproceso As Long 

00197             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

00198      

00199      

00200             'prepara los resultados para ser devueltos  

00201             '------------------------------------------------  

00202             Dim TextoResultado As String 

00203             Dim CosteTotal As Single = 0 

00204             Dim i , j As Long 

00205             Dim MatrizSolucion ( TotalNodos - 1 , TotalNodos - 1 ) As Integer 

00206      

00207      

00208             If maximo = False Then 

00209                 TextoResultado = "ÁRBOL DE VALOR TOTAL MÍNIMO - ALGORITMO DE PRIM" & 

       »                   vbCrLf 

00210             Else 

00211                 TextoResultado = "ÁRBOL DE VALOR TOTAL MÁXIMO - ALGORITMO DE PRIM" & 

       »                   vbCrLf 

00212      

00213             End If 

00214      

00215             TextoResultado = TextoResultado &  

       »               "--------------------------------------------------" & vbCrLf 

00216             TextoResultado = TextoResultado & "" & vbCrLf 

00217      

00218             TextoResultado = TextoResultado & "Tiempo de proceso = " & tiempoproceso 

       »               & " segundos" & vbCrLf & vbCrLf 

00219      

00220      

00221             For i = 0 To TotalArcos - 1 

00222      

00223                 If Arcos ( i ) . Camino = True Then 

00224                     'Marca el camino  

00225                     TextoResultado = TextoResultado & " * " & Nodos ( Arcos ( i ) . Nd1 )  

       »                       . Texto & " ----(" & Arcos ( i ) . Coste & ")---> " & Nodos ( Arcos ( i  

       »                       ) . Nd2 ) . Texto & vbCrLf 

00226                     MatrizSolucion ( Arcos ( i ) . Nd1 , Arcos ( i ) . Nd2 ) = 1 

00227                     CosteTotal = CosteTotal + Arcos ( i ) . Coste 

00228      

00229                 End If 

00230      

00231             Next i 

00232      

00233             TextoResultado = TextoResultado & vbCrLf & "Coste total = " & CosteTotal 

       »               & vbCrLf 

00234             If maximo = False Then 

00235                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos del  

       »                   árbol con coste mínimo:" & vbCrLf & vbCrLf 

00236             Else 

00237                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos del  

       »                   árbol con coste máximo:" & vbCrLf & vbCrLf 

00238             End If 

00239      

00240             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00241             For i = 0 To TotalNodos - 1 

00242                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00243             Next i 

00244             TextoResultado = TextoResultado & vbCrLf 

00245      

00246             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00247                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00248                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00249                     TextoResultado = TextoResultado & MatrizSolucion ( i , j ) & vbTab 

00250                 Next j 

00251                 TextoResultado = TextoResultado & vbCrLf 

00252             Next i 

00253      

00254             '-------------------------------  

00255             'fin del proceso devuelve resultados  

00256             RaiseEvent Fin ( TextoResultado , MatrizSolucion ) 

00257             '-------------------------------  

00258         End Function 

00259      



00260         Sub ArbolMinimo ( ByVal maximo As Boolean ) 

00261      

00262             'Comienza Algoritmo de Prim  

00263             Dim i , k , a As Integer 

00264             Dim n1 , n2 As Long 

00265      

00266             'Inicializa  

00267             For i = 0 To TotalNodos - 1 

00268                 Nodos ( i ) . ConArco = False 

00269                 Nodos ( i ) . Estatus = cSinEstatus 

00270             Next i 

00271      

00272      

00273             'busca nodos con arco  

00274             For i = 0 To TotalArcos - 1 

00275                 Nodos ( Arcos ( i ) . Nd1 ) . ConArco = True 

00276                 Nodos ( Arcos ( i ) . Nd2 ) . ConArco = True 

00277                 Arcos ( i ) . Camino = False 

00278             Next i 

00279      

00280             'cuenta nodos con arco  

00281             Dim TotalNodosArco As Long = 0 

00282             For i = 0 To TotalNodos - 1 

00283                 If Nodos ( i ) . ConArco = True Then 

00284                     TotalNodosArco = TotalNodosArco + 1 

00285                 End If 

00286             Next i 

00287      

00288             'inicializa primer nodo  

00289             'aunque realmente se puede empezar por cualquier nodo  

00290             'primer nodo es el nodo 1 del arco cero  

00291             k = Arcos ( 0 ) . Nd1 

00292             Nodos ( k ) . Estatus = cProcesado 

00293      

00294             Dim nodossel As Long = 1 

00295             Dim min As Single 

00296      

00297             Do While nodossel < TotalNodosArco 

00298                 k = - 1 

00299                 If maximo = False Then 

00300                     min = cMaximo 

00301                 Else 

00302                     min = cMinimo 

00303                 End If 

00304      

00305                 For a = 0 To TotalArcos - 1 

00306                     If Arcos ( a ) . Camino = False Then 

00307                         n1 = Arcos ( a ) . Nd1 

00308                         n2 = Arcos ( a ) . Nd2 

00309      

00310                         If ( Nodos ( n1 ) . Estatus = cProcesado And Nodos ( n2 ) . Estatus = 

       »                           cSinEstatus ) Or ( Nodos ( n2 ) . Estatus = cProcesado And  

       »                           Nodos ( n1 ) . Estatus = cSinEstatus ) Then 

00311                             If maximo = False Then 

00312                                 If Arcos ( a ) . Coste < min Then 

00313                                     min = Arcos ( a ) . Coste 

00314                                     k = a 

00315                                 End If 

00316                             Else 

00317                                 If Arcos ( a ) . Coste > min Then 

00318                                     min = Arcos ( a ) . Coste 

00319                                     k = a 

00320                                 End If 

00321                             End If 

00322                         End If 

00323                     End If 

00324                 Next a 

00325      

00326                 If k <> - 1 Then 

00327                     Arcos ( k ) . Camino = True 

00328                     Nodos ( Arcos ( k ) . Nd1 ) . Estatus = cProcesado 

00329                     Nodos ( Arcos ( k ) . Nd2 ) . Estatus = cProcesado 

00330                     nodossel = nodossel + 1 

00331                 End If 

00332             Loop 

00333         End Sub 

00334      

00335     End Class 

00001     Public Class FordFulkerson 

00002         Inherits System . Windows . Forms . UserControl 

00003      

00004     # Region " Código generado por el Diseñador de Windows Forms " 

00005      

00006         Public Sub New () 

00007             MyBase . New () 

00008      

00009             'El Diseñador de Windows Forms requiere esta llamada.  

00010             InitializeComponent () 

00011      

00012             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00013      

00014         End Sub 

00015      

00016         'UserControl1 reemplaza a Dispose para limpiar la lista de componentes.  

00017         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00018             If disposing Then 

00019                 If Not ( components Is Nothing ) Then 

00020                     components . Dispose () 

00021                 End If 

00022             End If 

00023             MyBase . Dispose ( disposing ) 

00024         End Sub 

00025      

00026         'Requerido por el Diseñador de Windows Forms  

00027         Private components As System . ComponentModel . IContainer 

00028      

00029         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00030         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00031         'No lo modifique con el editor de código.  

00032         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00033             components = New System . ComponentModel . Container 

00034         End Sub 

00035      

00036     # End Region 

00037         'Declaraciones de Eventos  

00038         Public Event Fin ( ByVal TextoRespuesta As String , ByVal MatrizArcosMinimos As 

       »           Array )  'ver parámetros de solución  

00039         Public Event Fallo ( ByVal TextoError As String ) 

00040         'Declaraciones de Variables  

00041         Public DatosIncorrectos As Boolean = False 

00042      

00043         Private Const cSinEstatus As Integer = 0 

00044         Private Const cCandidato As Integer = 1 

00045         Private Const cProcesado As Integer = 2 

00046         Private Const cMaximo As Single = 999999999999999999 

00047         Private Const cMinimo As Single = - 999999999999999999 

00048      

00049      

00050      

00051      

00052      

00053      



00054         'Declara la estructura del objeto Arco o relación entre nodos  

00055         Public Structure Arco 

00056             'Dim Texto As String 'etiqueta  

00057             Dim Min As Single 'valor de mínimo  

00058             Dim Max As Single 'valor de máximo  

00059             'Dim Coste As Single 'valor de coste  

00060      

00061             Dim Camino As Boolean 

00062             'Dim Col As Color 'color del arco  

00063             'Dim Grosor As Single 'trazo del arco  

00064             Dim Nd1 As Integer 'nodo origen  

00065             Dim Nd2 As Integer 'nodo destino  

00066      

00067             'Dim Camino As Boolean  

00068             'Dim B As Boolean 'doble flecha si o no  

00069         End Structure 

00070      

00071         'Declara la estructura del objeto Nodo  

00072         Public Structure Nodo 

00073             Dim Texto As String 'etiqueta  

00074      

00075             'Dim Precedente As Long  

00076             Dim Estatus As Integer 

00077             'Dim Distancia As Single  

00078      

00079             'Dim Valor As Single 'valor del nodo  

00080             'Dim X As Single 'coordenadas  

00081             'Dim Y As Single  

00082             'Dim Z As Single  

00083             'Dim Col As Color 'color de relleno del nodo  

00084             'Dim Radio As Single 'radio del nodo  

00085             'Dim Grosor As Single 'trazo del nodo  

00086         End Structure 

00087      

00088         'Totales de Nodos y Arcos  

00089         Public TotalNodos As Long 

00090         Public TotalArcos As Long 

00091      

00092         'Crea las colecciones para ambos objetos  

00093         Public Nodos ( 1 ) As Nodo 

00094         Public Arcos ( 1 ) As Arco 

00095      

00096         'Matriz de capacidades y matriz de flujos  

00097         Public Capacidad ( 0 , 0 ) As Single 

00098         Public Flujo ( 0 , 0 ) As Single 

00099         Public FlujoMaximo As Single 

00100      

00101         Public Cola () As Integer 

00102         Public Estado () As Integer 

00103         Public Pred () As Integer 

00104      

00105         Public Primero , Ultimo As Integer 

00106      

00107      



00108         Public Property MatrizNodos () As Array 

00109             'Lectura de propiedades  

00110             Get 

00111                 'para devolver un valor desde la dll a la aplicación  

00112      

00113             End Get 

00114             Set ( ByVal Value As Array ) 

00115                 'para poner un valor desde la aplicación a la dll  

00116                 DatosIncorrectos = False 

00117                 Dim i As Long 

00118                 'comprobar la integridad de los datos antes de proseguir  

00119                 i = UBound ( Value ) 

00120                 If i > 0 Then 

00121                     'dimensiona el total de nodos  

00122                     TotalNodos = i + 1 

00123                     'toma los datos de nodos y los pone en la estructura  

00124                     For i = 0 To UBound ( Value ) 

00125                         ReDim Preserve Nodos ( i ) 

00126                         Nodos ( i ) . Texto = Value ( i ) 

00127                         Nodos ( i ) . Estatus = cSinEstatus 

00128                     Next i 

00129                 Else 

00130                     'no hay suficientes nodos  

00131                     RaiseEvent Fallo ( "Deben existir al menos dos Nodos y un Arco  

       »                       para definir un grafo." ) 

00132                     DatosIncorrectos = True 

00133                 End If 

00134      

00135             End Set 

00136         End Property 

00137         Public Property MatrizArcos () As Array 

00138             'Lectura de propiedades  

00139             Get 

00140                 'para devolver un valor desde la dll a la aplicación  

00141      

00142             End Get 

00143             Set ( ByVal Value As Array ) 

00144                 'para poner un valor desde la aplicación a la dll  

00145                 Dim i As Long 

00146                 Dim j As Long 

00147                 DatosIncorrectos = False 

00148                 'comprobar la integridad de los datos antes de proseguir  

00149                 i = UBound ( Value , 1 ) 'primera dimensión de la matriz  

00150                 j = UBound ( Value , 2 ) 'segunda dimensión de la matriz  

00151      

00152                 If i = j And i = TotalNodos - 1 Then 

00153                     'Recorre la matriz para tomar los datos y ponerlos en  

00154                     'la estructura de arcos  

00155      

00156                     ReDim Capacidad ( i , j ) 

00157                     ReDim Flujo ( i , j ) 

00158                     'Capacidad = Value  

00159      

00160                     ReDim Cola ( i + 2 ) 'totalnodos+2  

00161                     ReDim Estado ( i ) 'totalnodos  

00162                     ReDim Pred ( i ) 'totalnodos  

00163      

00164      

00165                     TotalArcos = 0 

00166                     For i = 0 To TotalNodos - 1 

00167                         For j = 0 To TotalNodos - 1 

00168                             'el algoritmo de FordFulkerson no puede tener  

       »                               capacidades  

00169                             'de arco menores que cero  

00170                             'para indicar que no existe arco se usará la  

00171                             'cMaximo= 999999999999999999  

00172                             'cMinimo = -999999999999999999  

00173      

00174      

00175                             If i <> j And Value ( i , j ) < cMaximo And Value ( i , j ) > 

       »                               cMinimo Then 

00176                                 TotalArcos = TotalArcos + 1 

00177                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

00178      

00179                                 Arcos ( TotalArcos - 1 ) . Nd1 = i 

00180                                 Arcos ( TotalArcos - 1 ) . Nd2 = j 

00181      

00182                                 'no se permiten capacidades negativas  

00183                                 If Value ( i , j ) >= 0 Then 

00184                                     Arcos ( TotalArcos - 1 ) . Max = Value ( i , j ) 

00185                                     Capacidad ( i , j ) = Value ( i , j ) 

00186                                 Else 

00187                                     Arcos ( TotalArcos - 1 ) . Max = 0 

00188                                     Capacidad ( i , j ) = 0 

00189                                 End If 

00190                             End If 

00191                             If i = j Then 

00192                                 'arco sobre un mismo nodo no permitido  

00193                                 Capacidad ( i , j ) = 0 

00194                             End If 

00195      

00196                         Next j 

00197                     Next i 

00198      



00199                 Else 

00200                     'no hay suficientes arcos  

00201                     RaiseEvent Fallo ( "Las dimensiones de la matriz de Arcos no  

       »                       concuerdan con el total de nodos." ) 

00202                     DatosIncorrectos = True 

00203                 End If 

00204                 If TotalArcos = 0 Then 

00205                     'no hay suficientes arcos  

00206                     RaiseEvent Fallo ( "Debe existir al menos un Arco entre dos Nodos 

       »                       para definir un grafo." ) 

00207                     DatosIncorrectos = True 

00208                 End If 

00209      

00210             End Set 

00211         End Property 

00212      



00213         Public Function Inicio ( ByVal NodoInicio As Long , ByVal NodoFin As Long ,  

       »           ByVal maximo As Boolean ) 

00214      

00215             'Inicio cálculo de tiempo  

00216             Dim TInicio As Date = Now 

00217      

00218             '-------------------------------  

00219             'Llamar al proceso de cálculo  

00220             'arbol mínimo  

00221             AlgoritmoFlujoMaximo ( NodoInicio , NodoFin , maximo ) 

00222             '-------------------------------  

00223      

00224             'fin cálculo de tiempo  

00225             Dim tiempoproceso As Long 

00226             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

00227      

00228      

00229             'prepara los resultados para ser devueltos  

00230             '------------------------------------------------  

00231             Dim TextoResultado As String 

00232             Dim CosteTotal As Single = 0 

00233             Dim i , j As Long 

00234             Dim MatrizSolucion ( TotalNodos - 1 , TotalNodos - 1 ) As Integer 

00235      

00236             'Pone la matriz de flujo en la matriz solución  

00237             For i = 0 To TotalNodos - 1 

00238                 For j = 0 To TotalNodos - 1 

00239                     MatrizSolucion ( i , j ) = Flujo ( i , j ) 

00240                 Next j 

00241             Next i 

00242      

00243             If maximo = False Then 

00244                 TextoResultado = "ÁRBOL DE FLUJO MÍNIMO - ALGORITMO DE FORD  

       »                   FULKERSON" & vbCrLf 

00245             Else 

00246                 TextoResultado = "ÁRBOL DE FLUJO MÁXIMO - ALGORITMO DE FORD  

       »                   FULKERSON" & vbCrLf 

00247             End If 

00248      

00249             TextoResultado = TextoResultado &  

       »               "---------------------------------------------------" & vbCrLf 

00250             TextoResultado = TextoResultado & "" & vbCrLf 

00251      

00252             TextoResultado = TextoResultado & "Tiempo de proceso = " & tiempoproceso 

       »               & " segundos" & vbCrLf & vbCrLf 

00253      

00254      

00255             'For i = 0 To TotalArcos - 1  

00256      

00257             'If Arcos(i).Camino = True Then  

00258             'Marca el camino  

00259             'TextoResultado = TextoResultado & " * " & Nodos(Arcos(i).Nd1).Texto  

       »               & " ----(" & Arcos(i).Min & ")---> " & Nodos(Arcos(i).Nd2).Texto &  

       »               vbCrLf  

00260             'MatrizSolucion(Arcos(i).Nd1, Arcos(i).Nd2) = 1  

00261             'CosteTotal = CosteTotal + Arcos(i).Min  

00262      

00263             'End If  

00264      

00265             'Next i  

00266      

00267      

00268             'Flujos  

00269             TextoResultado = TextoResultado & vbCrLf & "Flujo máximo = " &  

       »               FlujoMaximo & vbCrLf 

00270             If maximo = False Then 

00271                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos con  

       »                   flujo mínimo:" & vbCrLf & vbCrLf 

00272             Else 

00273                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Arcos con  

       »                   flujo máximo:" & vbCrLf & vbCrLf 

00274             End If 

00275      

00276             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00277             For i = 0 To TotalNodos - 1 

00278                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00279             Next i 

00280             TextoResultado = TextoResultado & vbCrLf 

00281      

00282             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00283                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00284                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00285                     TextoResultado = TextoResultado & MatrizSolucion ( i , j ) & vbTab 

00286                 Next j 

00287                 TextoResultado = TextoResultado & vbCrLf 

00288             Next i 

00289      

00290             'Capacidades residuales  

00291             TextoResultado = TextoResultado & vbCrLf & "Matriz de Capacidades  

       »               Residuales:" & vbCrLf & vbCrLf 

00292      

00293             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00294             For i = 0 To TotalNodos - 1 

00295                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00296             Next i 

00297             TextoResultado = TextoResultado & vbCrLf 

00298      

00299             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00300                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00301                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00302                     TextoResultado = TextoResultado & ( Capacidad ( i , j ) -  

       »                       MatrizSolucion ( i , j )) & vbTab 

00303                 Next j 

00304                 TextoResultado = TextoResultado & vbCrLf 

00305             Next i 

00306      

00307             '-------------------------------  

00308             'fin del proceso devuelve resultados  

00309             RaiseEvent Fin ( TextoResultado , MatrizSolucion ) 

00310             '-------------------------------  

00311         End Function 

00312      



00313         Sub AlgoritmoFlujoMaximo ( ByVal NodoInicio As Long , ByVal NodoFin As Long ,  

       »           ByVal maximo As Boolean ) 

00314      

00315             'Inicializa la matriz de flujo  

00316             Dim i , j , u As Long 

00317             For i = 0 To TotalNodos - 1 

00318                 For j = 0 To TotalNodos - 1 

00319                     Flujo ( i , j ) = 0 

00320                 Next j 

00321             Next i 

00322      

00323             'Inicializa Flujo máximo  

00324             FlujoMaximo = 0 

00325      

00326             Dim incremento As Single 

00327      

00328             'Algoritmo principal  

00329             While CaminoAumento ( NodoInicio , NodoFin ) 

00330      

00331                 'Determina la cantidad en la que se puede incrementar el flujo  

00332                 incremento = cMaximo 

00333                 u = TotalNodos - 1 

00334                 Do While Pred ( u ) >= 0 

00335                     incremento = Minimo ( incremento , Capacidad ( Pred ( u ), u ) - Flujo (  

       »                       Pred ( u ), u )) 

00336                     u = Pred ( u ) 

00337                 Loop 

00338      

00339                 'Ahora incrementa el flujo  

00340                 u = TotalNodos - 1 

00341                 Do While Pred ( u ) >= 0 

00342                     Flujo ( Pred ( u ), u ) = Flujo ( Pred ( u ), u ) + incremento 

00343                     Flujo ( u , Pred ( u )) = Flujo ( u , Pred ( u )) - incremento 

00344                     u = Pred ( u ) 

00345                 Loop 

00346      

00347                 FlujoMaximo = FlujoMaximo + incremento 

00348      

00349             End While 

00350             'Fin  

00351             Beep () 

00352         End Sub 

00353      



00354         Function CaminoAumento ( ByVal NodoInicio As Long , ByVal NodoFin As Long ) 

00355             Dim u , v As Integer 

00356      

00357             For u = 0 To TotalNodos - 1 

00358                 Estado ( u ) = cSinEstatus 

00359             Next u 

00360      

00361             Primero = 0 

00362             Ultimo = 0 

00363      

00364             EnCola ( NodoInicio ) 

00365             Pred ( NodoInicio ) = - 1 

00366      

00367             While Primero <> Ultimo 

00368                 u = FueraCola () 

00369      

00370                 'busca todos los nodos adyacentes v sin estatus  

00371                 'si la capacidad de u a v en la red residual es positiva  

00372                 'entonces pone en la cola v  

00373      

00374                 For v = 0 To TotalNodos - 1 

00375                     If Estado ( v ) = cSinEstatus And ( Capacidad ( u , v ) - Flujo ( u , v )) 

       »                       > 0 Then 

00376                         EnCola ( v ) 

00377                         Pred ( v ) = u 

00378                     End If 

00379                 Next v 

00380             End While 

00381      

00382             'si el estado del nodo final es procesado  

00383             'significa que se ha encontrado  

00384             If Estado ( NodoFin ) = cProcesado Then 

00385                 Return True 

00386             Else 

00387                 Return False 

00388             End If 

00389      

00390         End Function 

00391         Sub EnCola ( ByVal x As Integer ) 

00392             Cola ( Ultimo ) = x 

00393             Ultimo = Ultimo + 1 

00394             Estado ( x ) = cCandidato 

00395         End Sub 

00396         Function FueraCola () As Integer 

00397             Dim x As Integer 

00398             x = Cola ( Primero ) 

00399             Primero = Primero + 1 

00400             Estado ( x ) = cProcesado 

00401             Return x 

00402         End Function 

00403         Function Minimo ( ByVal x As Single , ByVal y As Single ) As Single 

00404             If x < y Then Return x 

00405             If y <= x Then Return y 

00406         End Function 

00407     End Class 

00001     Public Class FloydWarshall 

00002      

00003         Inherits System . Windows . Forms . UserControl 

00004      

00005     # Region " Código generado por el Diseñador de Windows Forms " 

00006      

00007         Public Sub New () 

00008             MyBase . New () 

00009      

00010             'El Diseñador de Windows Forms requiere esta llamada.  

00011             InitializeComponent () 

00012      

00013             'Agregar cualquier inicialización después de la llamada a  

       »               InitializeComponent()  

00014      

00015         End Sub 

00016      

00017         'UserControl1 reemplaza a Dispose para limpiar la lista de componentes.  

00018         Protected Overloads Overrides Sub Dispose ( ByVal disposing As Boolean ) 

00019             If disposing Then 

00020                 If Not ( components Is Nothing ) Then 

00021                     components . Dispose () 

00022                 End If 

00023             End If 

00024             MyBase . Dispose ( disposing ) 

00025         End Sub 

00026      

00027         'Requerido por el Diseñador de Windows Forms  

00028         Private components As System . ComponentModel . IContainer 

00029      

00030         'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento  

00031         'Puede modificarse utilizando el Diseñador de Windows Forms.  

00032         'No lo modifique con el editor de código.  

00033         < System . Diagnostics . DebuggerStepThrough ()> Private Sub InitializeComponent () 

00034             components = New System . ComponentModel . Container 

00035         End Sub 

00036      

00037     # End Region 

00038         'Declaraciones de Eventos  

00039         Public Event Fin ( ByVal TextoRespuesta As String , ByVal MatrizArcosMinimos As 

       »           Array )  'ver parámetros de solución  

00040         Public Event Fallo ( ByVal TextoError As String ) 

00041         'Declaraciones de Variables  

00042         Public DatosIncorrectos As Boolean = False 

00043      

00044         'Private Const cSinEstatus As Integer = 0  

00045         'Private Const cCandidato As Integer = 1  

00046         'Private Const cProcesado As Integer = 2  

00047         Private Const cMaximo As Single = 999999999999999999 

00048         Private Const cMinimo As Single = - 999999999999999999 

00049      

00050      



00051         'Declara la estructura del objeto Arco o relación entre nodos  

00052         Public Structure Arco 

00053             'Dim Texto As String 'etiqueta  

00054             'Dim Min As Single 'valor de mínimo  

00055             'Dim Max As Single 'valor de máximo  

00056             Dim Coste As Single 'valor de coste  

00057      

00058             Dim Camino As Boolean 

00059             'Dim Col As Color 'color del arco  

00060             'Dim Grosor As Single 'trazo del arco  

00061             Dim Nd1 As Integer 'nodo origen  

00062             Dim Nd2 As Integer 'nodo destino  

00063      

00064             'Dim Camino As Boolean  

00065             'Dim B As Boolean 'doble flecha si o no  

00066         End Structure 

00067      

00068         'Declara la estructura del objeto Nodo  

00069         Public Structure Nodo 

00070             Dim Texto As String 'etiqueta  

00071      

00072             'Dim Precedente As Long  

00073             'Dim Estatus As Integer  

00074             'Dim Distancia As Single  

00075      

00076             'Dim Valor As Single 'valor del nodo  

00077             'Dim X As Single 'coordenadas  

00078             'Dim Y As Single  

00079             'Dim Z As Single  

00080             'Dim Col As Color 'color de relleno del nodo  

00081             'Dim Radio As Single 'radio del nodo  

00082             'Dim Grosor As Single 'trazo del nodo  

00083         End Structure 

00084      

00085         'Totales de Nodos y Arcos  

00086         Public TotalNodos As Long 

00087         Public TotalArcos As Long 

00088      

00089         'Crea las colecciones para ambos objetos  

00090         Public Nodos ( 1 ) As Nodo 

00091         Public Arcos ( 1 ) As Arco 

00092      

00093         'Matriz de caminos y distancias  

00094         Public Distancias ( 0 , 0 ) As Single 

00095         Public Caminos ( 0 , 0 ) As Long 

00096      

00097      

00098         Public Ciclo As Boolean 

00099      

00100      



00101         Public Property MatrizNodos () As Array 

00102             'Lectura de propiedades  

00103             Get 

00104                 'para devolver un valor desde la dll a la aplicación  

00105             End Get 

00106             Set ( ByVal Value As Array ) 

00107                 'para poner un valor desde la aplicación a la dll  

00108                 DatosIncorrectos = False 

00109                 Dim i As Long 

00110                 'comprobar la integridad de los datos antes de proseguir  

00111                 i = UBound ( Value ) 

00112                 If i > 0 Then 

00113                     'dimensiona el total de nodos  

00114                     TotalNodos = i + 1 

00115                     'toma los datos de nodos y los pone en la estructura  

00116                     For i = 0 To UBound ( Value ) 

00117                         ReDim Preserve Nodos ( i ) 

00118                         Nodos ( i ) . Texto = Value ( i ) 

00119                     Next i 

00120                 Else 

00121                     'no hay suficientes nodos  

00122                     RaiseEvent Fallo ( "Deben existir al menos dos Nodos y un Arco  

       »                       para definir un grafo." ) 

00123                     DatosIncorrectos = True 

00124                 End If 

00125             End Set 

00126         End Property 

00127         Public Property MatrizArcos () As Array 

00128             'Lectura de propiedades  

00129             Get 

00130                 'para devolver un valor desde la dll a la aplicación  

00131      

00132             End Get 

00133             Set ( ByVal Value As Array ) 

00134                 'para poner un valor desde la aplicación a la dll  

00135                 Dim i As Long 

00136                 Dim j As Long 

00137                 DatosIncorrectos = False 

00138                 'comprobar la integridad de los datos antes de proseguir  

00139                 i = UBound ( Value , 1 ) 'primera dimensión de la matriz  

00140                 j = UBound ( Value , 2 ) 'segunda dimensión de la matriz  

00141      

00142                 If i = j And i = TotalNodos - 1 Then 

00143                     'Recorre la matriz para tomar los datos y ponerlos en  

00144                     'la estructura de arcos  

00145      

00146                     ReDim Distancias ( i , j ) 

00147                     ReDim Caminos ( i , j ) 

00148      

00149                     TotalArcos = 0 

00150                     For i = 0 To TotalNodos - 1 

00151                         For j = 0 To TotalNodos - 1 

00152                             'el algoritmo de FloyWarshall puede tener costes  

00153                             'de arco menores que cero  

00154                             'para indicar que no existe arco se usará la  

00155                             'cMaximo= 999999999999999999  

00156                             'cMinimo = -999999999999999999  

00157                             'según corresponda maximizar o minimizar  

00158                             Distancias ( i , j ) = Value ( i , j ) 

00159      

00160                             If i <> j And Value ( i , j ) < cMaximo And Value ( i , j ) > 

       »                               cMinimo Then 

00161                                 TotalArcos = TotalArcos + 1 

00162                                 ReDim Preserve Arcos ( TotalArcos - 1 ) 

00163      

00164                                 Arcos ( TotalArcos - 1 ) . Nd1 = i 

00165                                 Arcos ( TotalArcos - 1 ) . Nd2 = j 

00166      

00167                                 'si se permiten costes negativos  

00168                                 'If Value(i, j) = cMaximo Then  

00169                                 Arcos ( TotalArcos - 1 ) . Coste = Value ( i , j ) 

00170      

00171                                 'Else  

00172                                 'Arcos(TotalArcos - 1).Coste = 0  

00173                                 'Distancias(i, j) = 0  

00174                                 'End If  

00175                             End If 

00176      

00177                             If i = j Then 

00178                                 'arco sobre un mismo nodo no permitido  

00179                                 Distancias ( i , j ) = 0 

00180                             End If 

00181      

00182                         Next j 

00183                     Next i 

00184      

00185                 Else 

00186                     'no hay suficientes arcos  

00187                     RaiseEvent Fallo ( "Las dimensiones de la matriz de Arcos no  

       »                       concuerdan con el total de nodos." ) 

00188                     DatosIncorrectos = True 

00189                 End If 

00190                 If TotalArcos = 0 Then 

00191                     'no hay suficientes arcos  

00192                     RaiseEvent Fallo ( "Debe existir al menos un Arco entre dos Nodos 

       »                       para definir un grafo." ) 

00193                     DatosIncorrectos = True 

00194                 End If 

00195      

00196             End Set 

00197         End Property 

00198      



00199         Public Function Inicio ( ByVal maximo As Boolean ) 

00200      

00201             'Inicio cálculo de tiempo  

00202             Dim TInicio As Date = Now 

00203      

00204             '-------------------------------  

00205             'Llamar al proceso de cálculo  

00206             'cámino mínimo/máximo entre todos los pares de nodos  

00207             Algoritmo ( maximo ) 

00208             '-------------------------------  

00209      

00210             'fin cálculo de tiempo  

00211             Dim tiempoproceso As Long 

00212             tiempoproceso = DateDiff ( DateInterval . Second , TInicio , Now ) 

00213      

00214             'prepara los resultados para ser devueltos  

00215             '------------------------------------------------  

00216             Dim TextoResultado As String 

00217             Dim CosteTotal As Single = 0 

00218             Dim i , j , k As Long 

00219             Dim MatrizSolucion ( TotalNodos - 1 , TotalNodos - 1 ) As Integer 

00220      

00221             'Pone la matriz de flujo en la matriz solución  

00222             For i = 0 To TotalNodos - 1 

00223                 For j = 0 To TotalNodos - 1 

00224                     MatrizSolucion ( i , j ) = 0 'ATENCIÓN!!!!  

00225                 Next j 

00226             Next i 

00227      

00228             If maximo = False Then 

00229                 TextoResultado = "ÁRBOL DE CAMINOS MÍNIMOS - ALGORITMO DE FLOYD  

       »                   WARSHALL" & vbCrLf 

00230             Else 

00231                 TextoResultado = "ÁRBOL DE CAMINOS MÁXIMOS - ALGORITMO DE FLOYD  

       »                   WARSHALL" & vbCrLf 

00232             End If 

00233      

00234             TextoResultado = TextoResultado &  

       »               "------------------------------------------------------" & vbCrLf 

00235             TextoResultado = TextoResultado & "" & vbCrLf 

00236      

00237             TextoResultado = TextoResultado & "Tiempo de proceso = " & tiempoproceso 

       »               & " segundos" & vbCrLf & vbCrLf 

00238      

00239      

00240             For i = 0 To TotalNodos - 1 

00241                 For j = 0 To TotalNodos - 1 

00242                     For k = 0 To TotalArcos - 1 

00243                         If Arcos ( k ) . Nd1 = i And Arcos ( k ) . Nd2 = j Then 

00244                             If Caminos ( i , j ) <> - 1 Then 

00245                                 'Marca el camino  

00246                                 MatrizSolucion ( Caminos ( i , j ), j ) = 1 

00247                             End If 

00248                             Exit For 

00249                         End If 

00250                     Next k 

00251                 Next j 

00252             Next i 

00253      

00254      

00255      

00256             If maximo = False Then 

00257                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Distancias  

       »                   mínimas:" & vbCrLf & vbCrLf 

00258             Else 

00259                 TextoResultado = TextoResultado & vbCrLf & "Matriz de Distancias  

       »                   máximas:" & vbCrLf & vbCrLf 

00260             End If 

00261      

00262             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00263             For i = 0 To TotalNodos - 1 

00264                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00265             Next i 

00266             TextoResultado = TextoResultado & vbCrLf 

00267      

00268             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00269                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00270                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00271                     TextoResultado = TextoResultado & Distancias ( i , j ) & vbTab 

00272                 Next j 

00273                 TextoResultado = TextoResultado & vbCrLf 

00274             Next i 

00275      

00276             'Matriz de caminos  

00277             TextoResultado = TextoResultado & vbCrLf & "Matriz de Caminos:" & vbCrLf 

       »               & vbCrLf 

00278      

00279             TextoResultado = TextoResultado & "N1\N2" & vbTab 

00280             For i = 0 To TotalNodos - 1 

00281                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00282             Next i 

00283             TextoResultado = TextoResultado & vbCrLf 

00284      

00285             For i = 0 To UBound ( MatrizSolucion , 1 ) 

00286                 TextoResultado = TextoResultado & Nodos ( i ) . Texto & vbTab 

00287                 For j = 0 To UBound ( MatrizSolucion , 2 ) 

00288                     If Caminos ( i , j ) <> - 1 Then 

00289                         TextoResultado = TextoResultado & Nodos ( Caminos ( i , j )) .  

       »                           Texto & vbTab 

00290                     Else 

00291                         TextoResultado = TextoResultado & "-" & vbTab 

00292                     End If 

00293                 Next j 

00294                 TextoResultado = TextoResultado & vbCrLf 

00295             Next i 

00296      

00297             'listado de todos los caminos  

00298             TextoResultado = TextoResultado & vbCrLf & "Listado de Caminos:" &  

       »               vbCrLf & vbCrLf 

00299      

00300             Dim cadena As String 

00301      

00302             For i = 0 To TotalNodos - 1 

00303                 For j = 0 To TotalNodos - 1 

00304      

00305                     cadena = Nodos ( i ) . Texto & " --(" & Distancias ( i , j ) & ")--> " & 

       »                       Nodos ( j ) . Texto 

00306                     cadena = cadena & " = " & Ruta ( i , j , True ) 

00307                     TextoResultado = TextoResultado & cadena & vbCrLf 

00308      

00309                 Next j 

00310             Next i 

00311      

00312      

00313             '-------------------------------  

00314             'fin del proceso devuelve resultados  

00315             RaiseEvent Fin ( TextoResultado , MatrizSolucion ) 

00316             '-------------------------------  

00317         End Function 

00318         Function Algoritmo ( ByVal maximo As Boolean ) 

00319      

00320             Dim i , j , k As Long 

00321             Dim n As Single 

00322             Dim ciclo As Boolean 

00323      

00324             'Inicia la matriz de caminos Pi  

00325             For i = 0 To TotalNodos - 1 

00326                 For j = 0 To TotalNodos - 1 

00327      

00328                     If Distancias ( i , j ) = cMaximo Or Distancias ( i , j ) = cMinimo Or 

       »                       ( i = j ) Then 

00329                         Caminos ( i , j ) = - 1 'valor nulo  

00330                     Else 

00331                         Caminos ( i , j ) = i 

00332                     End If 

00333      

00334                 Next j 

00335             Next i 

00336      

00337             ciclo = False 

00338      

00339             k = 0 

00340             While ( k <= TotalNodos - 1 ) And ( Not ciclo ) 

00341                 For i = 0 To TotalNodos - 1 

00342                     If Distancias ( i , k ) <> cMaximo And Distancias ( i , k ) <> cMinimo 

       »                       Then 

00343                         For j = 0 To TotalNodos - 1 

00344                             If Distancias ( k , j ) <> cMaximo And Distancias ( k , j ) < 

       »                               > cMinimo Then 

00345      

00346                                 If maximo = False Then 

00347                                     n = Distancias ( i , k ) + Distancias ( k , j ) 

00348                                     If Distancias ( i , j ) > n Then 

00349                                         Distancias ( i , j ) = n 

00350                                         Caminos ( i , j ) = Caminos ( k , j ) 

00351                                     End If 

00352                                 End If 

00353      

00354                                 If maximo = True Then 

00355                                     n = Distancias ( i , k ) + Distancias ( k , j ) 

00356                                     If Distancias ( i , j ) < n Then 

00357                                         Distancias ( i , j ) = n 

00358                                         Caminos ( i , j ) = Caminos ( k , j ) 

00359                                     End If 

00360                                 End If 

00361      

00362                             End If 

00363                         Next j 

00364                     End If 

00365                     If maximo = False Then 

00366                         ciclo = ciclo Or ( Distancias ( i , i ) < 0 ) 

00367                     End If 

00368                     If maximo = True Then 

00369                         ciclo = ciclo Or ( Distancias ( i , i ) > 0 ) 

00370                     End If 

00371                 Next i 

00372      

00373                 k = k + 1 

00374             End While 

00375      

00376         End Function 

00377         Function Ruta ( ByVal i As Long , ByVal j As Long , ByVal reset As Boolean ) As  

       »           String 

00378             'Devuelve una cadena de texto con la ruta de i a j  

00379      

00380             Static cadena As String 

00381             If reset = True Then cadena = "" 

00382      

00383             If i = j Then 

00384                 If cadena . Length > 0 Then cadena = cadena & ", " 

00385                 cadena = cadena & Nodos ( i ) . Texto 

00386             Else 

00387                 If Caminos ( i , j ) = - 1 Then 

00388                     cadena = cadena & "no existe camino" 

00389                     Return cadena 

00390                 End If 

00391      

00392                 Ruta ( i , Caminos ( i , j ), False ) 

00393                 If cadena . Length > 0 Then cadena = cadena & ", " 

00394                 cadena = cadena & Nodos ( j ) . Texto 

00395                 Return cadena 

00396      

00397             End If 

00398      

00399         End Function 

00400     End Class