VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form configura
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "Configuración"
ClientHeight = 4245
ClientLeft = 45
ClientTop = 435
ClientWidth = 6855
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4245
ScaleWidth = 6855
StartUpPosition = 1 'CenterOwner
Begin MSComDlg.CommonDialog CommonDialog1
Left = 0
Top = 3720
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command4
Caption = "Guardar"
Height = 375
Left = 5280
TabIndex = 4
Top = 3720
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "Inicial"
Height = 375
Left = 3600
TabIndex = 3
Top = 3720
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "Cancelar"
Height = 375
Left = 2040
TabIndex = 2
Top = 3720
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Aceptar"
Height = 375
Left = 480
TabIndex = 1
Top = 3720
Width = 1215
End
Begin VB.Frame Frame1
Caption = "Ventana de diseño"
Height = 3615
Left = 120
TabIndex = 0
Top = 50
Width = 6615
Begin VB.OptionButton Option2
Caption = "Inglés"
Height = 255
Left = 3840
TabIndex = 27
Top = 3120
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "Español"
Height = 255
Left = 2400
TabIndex = 26
Top = 3120
Value = -1 'True
Width = 1455
End
Begin VB.TextBox Text1
Height = 285
Left = 1320
TabIndex = 15
Top = 480
Width = 495
End
Begin VB.TextBox Text2
Height = 285
Left = 1320
TabIndex = 14
Top = 840
Width = 495
End
Begin VB.TextBox Text3
Height = 285
Left = 3120
TabIndex = 13
Top = 1200
Width = 495
End
Begin VB.CheckBox Check1
Caption = "Grid Vertical"
Height = 255
Left = 480
TabIndex = 12
Top = 2040
Width = 2175
End
Begin VB.CheckBox Check2
Caption = "Grid Horizontal"
Height = 255
Left = 480
TabIndex = 11
Top = 2400
Width = 2175
End
Begin VB.TextBox Text4
Height = 285
Left = 5880
TabIndex = 10
Top = 480
Width = 495
End
Begin VB.TextBox Text5
Height = 285
Left = 5880
TabIndex = 9
Top = 840
Width = 495
End
Begin VB.TextBox Text6
Height = 285
Left = 5280
TabIndex = 8
Top = 2040
Width = 495
End
Begin VB.TextBox Text7
Height = 285
Left = 5280
TabIndex = 7
Top = 2400
Width = 495
End
Begin VB.TextBox Text8
Height = 285
Left = 3120
TabIndex = 6
Top = 480
Width = 495
End
Begin VB.TextBox Text9
Height = 285
Left = 3120
TabIndex = 5
Top = 840
Width = 495
End
Begin VB.Label Label12
Caption = "Idioma del Interfaz:"
Height = 195
Left = 360
TabIndex = 25
Top = 3120
Width = 1815
End
Begin VB.Line Line2
X1 = 120
X2 = 6480
Y1 = 2880
Y2 = 2880
End
Begin VB.Line Line1
X1 = 120
X2 = 6480
Y1 = 1680
Y2 = 1680
End
Begin VB.Label Label1
Caption = "Xmin (m.) :"
Height = 195
Left = 240
TabIndex = 24
Top = 540
Width = 1095
End
Begin VB.Label Label2
Caption = "Ymin (m.) :"
Height = 195
Left = 240
TabIndex = 23
Top = 900
Width = 975
End
Begin VB.Label Label3
Caption = "Distancia mínima al suelo (m.) :"
Height = 195
Left = 240
TabIndex = 22
Top = 1260
Width = 2655
End
Begin VB.Label Label6
Caption = "Incremento Eje X (m.) :"
Height = 195
Left = 3840
TabIndex = 21
Top = 540
Width = 1965
End
Begin VB.Label Label7
Caption = "Incremento Eje Y (m.) :"
Height = 195
Left = 3840
TabIndex = 20
Top = 900
Width = 1845
End
Begin VB.Label Label8
Caption = "Incremento Grid Vertical :"
Height = 195
Left = 2760
TabIndex = 19
Top = 2070
Width = 2505
End
Begin VB.Label Label9
Caption = "Incremento Grid Horizontal :"
Height = 195
Left = 2760
TabIndex = 18
Top = 2430
Width = 2445
End
Begin VB.Label Label10
Caption = "Xmax (m.) :"
Height = 255
Left = 2040
TabIndex = 17
Top = 540
Width = 975
End
Begin VB.Label Label11
Caption = "Ymax (m.) :"
Height = 195
Left = 2040
TabIndex = 16
Top = 900
Width = 1020
End
End
End
Attribute VB_Name = "configura"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim aux As Variant
Dim numfich As Integer
Private Sub Command1_Click()
' Comprobamos que los valores sean correctos
If (Len(Text1.Text) = 0 Or Len(Text2.Text) = 0 Or Len(Text3.Text) = 0 Or Len(Text4.Text) = 0 Or _
Len(Text5.Text) = 0 Or Len(Text6.Text) = 0 Or Len(Text7.Text) = 0 Or Len(Text8.Text) = 0 Or _
Len(Text9.Text) = 0) Then
If Principal.idioma = "Español" Then
MsgBox "No puede dejar casillas en blanco.", vbExclamation, "MitLoop"
Else
MsgBox "Please fill in all required fields", vbExclamation, "MitLoop"
End If
ElseIf Not (IsNumeric(Text1.Text) And IsNumeric(Text2.Text) And IsNumeric(Text3.Text) And _
IsNumeric(Text4.Text) And IsNumeric(Text5.Text) And IsNumeric(Text6.Text) And _
IsNumeric(Text7.Text) And IsNumeric(Text8.Text) And IsNumeric(Text9.Text)) Then
If Principal.idioma = "Español" Then
MsgBox "Hay valores numéricos no válidos.", vbExclamation, "MitLoop"
Else
MsgBox "There are invalid numbers", vbExclamation, "MitLoop"
End If
ElseIf (CSng(Text1.Text) >= CSng(Text8.Text) Or CSng(Text2.Text) >= CSng(Text9.Text) _
Or CSng(Text3.Text) <= 0) Then
If Principal.idioma = "Español" Then
MsgBox "Introduzca valores lógicos para el rango de coordenadas.", vbExclamation, "MitLoop"
Else
MsgBox "Please insert logical values for coordinates range.", vbExclamation, "MitLoop"
End If
ElseIf (CSng(Text6.Text) <= 0 Or CSng(Text7.Text) <= 0) Then
MsgBox "Los valores de incremento de Grid han de ser positivos", vbExclamation, "MitLoop"
Else
actualizaValores
Unload Me
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
ImportaPerfil ("Default.usr")
MsgBox "Perfil cargado correctamente", vbInformation, "MitLoop"
End Sub
Private Sub ImportaPerfil(ByVal fichero As String)
Dim sigue As Boolean
Dim variableLeida As String
Dim i As Integer
Dim valor As String
sigue = True
numfich = FreeFile
fichero = Trim(fichero)
If (InStr(1, fichero, ":") = 0) Then fichero = Principal.LocalPath & "perfiles\" & Trim(fichero)
If (Right(fichero, 4) <> ".usr") Then fichero = fichero & ".usr"
Open fichero For Input As numfich
' Leemos la primera línea. Para que sea un fichero válido
' esta primera linea ha de ser la cadena "MitLoop 2.0"
Line Input #numfich, aux
If aux <> "MitLoop 2.0" Then
MsgBox "Formato de fichero incorrecto", vbCritical, "MitLoop"
sigue = False
End If
If (sigue = True) Then
' Leer los valores del fichero y meterlos
' en las vbles del formulario principal.
While (Not EOF(numfich) And sigue = True)
Line Input #numfich, aux
i = InStr(1, aux, ",")
variableLeida = Mid(aux, 1, i - 1)
valor = Mid(aux, i + 1, Len(aux))
Select Case LCase(variableLeida)
Case Is = "xmax"
Principal.xmaxima = CSng(valor)
Principal.xmaxorig = CSng(valor)
Text8.Text = CStr(valor)
Case Is = "xmin"
Principal.xminima = CSng(valor)
Principal.xminorig = CSng(valor)
Text1.Text = CStr(valor)
Case Is = "ymax"
Principal.ymaxima = CSng(valor)
Principal.ymaxorig = CSng(valor)
Text9.Text = CStr(valor)
Case Is = "ymin"
Principal.yminima = CSng(valor)
Principal.yminorig = CSng(valor)
Text2.Text = CStr(valor)
Case Is = "gridh"
If (valor = True) Then
Principal.GridHorizontal = True
Check2.Value = 1
Else
Principal.GridHorizontal = False
Check2.Value = 0
End If
Case Is = "gridv"
If (valor = True) Then
Principal.GridVertical = True
Check1.Value = 1
Else
Principal.GridVertical = False
Check1.Value = 0
End If
Case Is = "incrgridh"
'If (valor = 1) Then
' Principal.incrementoGridH = 1
'Else
Principal.incrementoGridH = CSng(valor)
Text7.Text = CStr(valor)
'End If
Case Is = "incrgridv"
'If (valor = 1) Then
' Principal.incrementoGridV = 1
'Else
Principal.incrementoGridV = CSng(valor)
Text6.Text = CStr(valor)
'End If
Case Is = "alturaminima"
Principal.distanciaMinimaAlSuelo = valor
Text3.Text = CStr(valor)
Case Is = "incrx"
If (CSng(valor) <= 0) Then
Principal.incrementox = 5
Else
Principal.incrementox = CSng(valor)
End If
Case Is = "incry"
If (CSng(valor) <= 0) Then
Principal.incrementoy = 5
Else
Principal.incrementoy = Principal.incrementox
End If
Case Else
MsgBox "El fichero de configuracion contiene valores no válidos", vbCritical, "MitLoop"
sigue = False
End Select
Wend
End If
End Sub
Private Sub Command4_Click()
With CommonDialog1
.DefaultExt = ".usr"
.Filter = "Perfil de Usuario de MitLoop (*.usr)|*.usr|Todos los archivos (*.*)|*.*"
.Flags = &H4 Or &H2
.ShowSave
End With
' Comprobamos que los valores sean correctos
If (Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "") Then
MsgBox "No puede dejar casillas en blanco.", vbExclamation, "MitLoop"
ElseIf (CSng(Text4.Text) <= 0 Or CSng(Text5.Text) <= 0 _
Or CSng(Text3.Text) <= 0 Or CSng(Text6.Text) < 0 _
Or CSng(Text7.Text) < 0) Then
MsgBox "Los valores en las casillas deben ser positivos.", vbExclamation, "MitLoop"
ElseIf (Len(CommonDialog1.filename) <> 0) Then
actualizaValores
numfich = FreeFile
aux = Trim(CommonDialog1.filename)
If (Right(aux, 4) <> ".usr") Then aux = aux & ".usr"
Open aux For Output As numfich
Print #numfich, "MitLoop 2.0"
Print #numfich, "xmin," & CStr(Principal.xminima)
Print #numfich, "xmax," & CStr(Principal.xmaxima)
Print #numfich, "ymin," & CStr(Principal.yminima)
Print #numfich, "ymax," & CStr(Principal.ymaxima)
Print #numfich, "GridH," & CStr(Principal.GridHorizontal)
Print #numfich, "GridV," & CStr(Principal.GridVertical)
Print #numfich, "incrGridH," & CStr(Principal.incrementoGridH)
Print #numfich, "incrGridV," & CStr(Principal.incrementoGridV)
Print #numfich, "alturaminima," & CStr(Principal.distanciaMinimaAlSuelo)
Print #numfich, "incrx," & CStr(Principal.incrementox)
Print #numfich, "incry," & CStr(Principal.incrementoy)
Close numfich
MsgBox "Se ha grabado el perfil correctamente", vbInformation, "MitLoop"
actualizaIndex (CommonDialog1.filename)
Unload Me
End If
End Sub
Sub actualizaIndex(ByVal nombrePerfil As String)
Dim Perfiles() As String
Dim aux As Integer
Dim idIndexIn As Integer
Dim idIndexOut As Integer
Dim cadena As String
Dim itera As Boolean
Dim escribe As Boolean
Dim contador As Integer
Dim yaExistePerfil As Boolean
aux = InStr(1, nombrePerfil, "\")
itera = True
escribe = True
contador = 0 ' Contador de lineas procesadas.
yaExistePerfil = False
' Quitamos del nombre la ruta y nos quedamos solo con nombre + extension
While (aux <> 0)
nombrePerfil = Mid(nombrePerfil, aux + 1, Len(nombrePerfil) - aux)
aux = InStr(1, nombrePerfil, "\")
Wend
aux = InStr(1, nombrePerfil, ".")
If (aux <> 0) Then nombrePerfil = Mid(nombrePerfil, 1, aux - 1)
idIndexIn = FreeFile
idIndexOut = FreeFile
' Abrimos el fichero para entrada y salida
Open (Principal.LocalPath & "index.usr") For Input As idIndexIn
' Comprobamos que no exista ya un perfil con ese nombre.
While (Not EOF(idIndexIn) And itera = True)
Line Input #idIndexIn, cadena
contador = contador + 1
If (nombrePerfil = Trim(cadena)) Then
yaExistePerfil = True
End If
Wend
Close idIndexIn
' Si no existe el perfil, se abre el fichero en modo append y se añade el perfil
If (yaExistePerfil = False) Then
Open (Principal.LocalPath & "index.usr") For Append As idIndexOut
Print #idIndexOut, nombrePerfil
Close idIndexOut
End If
' Si existe el perfil, solo hay que grabar el fichero del perfil y no hace falta
' modificar el index.usr
End Sub
Private Sub Form_Load()
If Principal.idioma = "Español" Then
Option1.Value = True
Else
Option2.Value = True
End If
If Principal.GridHorizontal = True Then Check2.Value = 1
If Principal.GridVertical = True Then Check1.Value = 1
Text1.Text = CStr(Principal.xminima)
Text2.Text = CStr(Principal.yminima)
Text3.Text = CStr(Principal.distanciaMinimaAlSuelo)
Text4.Text = CStr(Principal.incrementox)
Text5.Text = CStr(Principal.incrementoy)
Text6.Text = CStr(Principal.incrementoGridV)
Text7.Text = CStr(Principal.incrementoGridH)
Text8.Text = CStr(Principal.xmaxima)
Text9.Text = CStr(Principal.ymaxima)
End Sub
Sub actualizaValores()
Principal.xminima = CSng(Text1.Text)
Principal.yminima = CSng(Text2.Text)
Principal.distanciaMinimaAlSuelo = CSng(Text3.Text)
Principal.incrementox = CSng(Text4.Text)
Principal.incrementoy = CSng(Text5.Text)
Principal.incrementoGridV = CSng(Text6.Text)
Principal.incrementoGridH = CSng(Text7.Text)
Principal.xmaxima = CSng(Text8.Text)
Principal.ymaxima = CSng(Text9.Text)
Principal.StatusBar1.Panels(6).Text = "División eje X = " & Principal.incrementoGridV & " m."
Principal.StatusBar1.Panels(7).Text = "División eje Y = " & Principal.incrementoGridH & " m."
If (Check2.Value = 1) Then
Principal.GridHorizontal = True
Else
Principal.GridHorizontal = False
End If
If (Check1.Value = 1) Then
Principal.GridVertical = True
Else
Principal.GridVertical = False
End If
If Option1.Value = True Then
ponEnEspañol
Else
ponEnIngles
End If
' Redibujamos pantalla por si se ha modificado algún valor
' que afecte a la presentación.
Module1.RedibujaImagen
End Sub
Public Sub ponEnIngles()
Principal.idioma = "Ingles"
Principal.Toolbar1.Buttons(1).ToolTipText = "New Project"
Principal.Toolbar1.Buttons(2).ToolTipText = "Open Existing Project"
Principal.Toolbar1.Buttons(3).ToolTipText = "Save Actual Project"
Principal.Toolbar1.Buttons(8).ToolTipText = "New Horizontal Restriction"
Principal.Toolbar1.Buttons(10).ToolTipText = "New Simplex Phase"
Principal.Toolbar1.Buttons(11).ToolTipText = "New Horizontal Duplex Phase"
Principal.Toolbar1.Buttons(12).ToolTipText = "New Vertical Duplex Phase"
Principal.Toolbar1.Buttons(13).ToolTipText = "New Type I Triplex Phase"
Principal.Toolbar1.Buttons(14).ToolTipText = "New Type II Triplex Phase"
Principal.Toolbar1.Buttons(15).ToolTipText = "New Cuadruplex Phase"
Principal.Toolbar1.Buttons(17).ToolTipText = "New Normal Obstacle"
Principal.Toolbar1.Buttons(18).ToolTipText = "New Lifted Grounded Obstacle"
Principal.Toolbar1.Buttons(19).ToolTipText = "New Lifted Obstacle"
Principal.Toolbar1.Buttons(21).ToolTipText = "Manual Solve"
Principal.Toolbar1.Buttons(22).ToolTipText = "Automatic Optimization"
Principal.Toolbar1.Buttons(24).ToolTipText = "Results"
' Escondemos los menús en Español y mostramos los de inglés
Principal.Archivo.Visible = False
Principal.Insertar.Visible = False
Principal.Perfiles.Visible = False
Principal.Herramientas.Visible = False
Principal.Ayuda.Visible = False
Principal.File.Visible = True
Principal.InsertItem.Visible = True
Principal.ProfilesMenu.Visible = True
Principal.Tools.Visible = True
Principal.HelpMenu.Visible = True
End Sub
Public Sub ponEnEspañol()
Principal.idioma = "Español"
Principal.Toolbar1.Buttons(1).ToolTipText = "Nuevo Proyecto"
Principal.Toolbar1.Buttons(2).ToolTipText = "Abrir Proyecto Existente"
Principal.Toolbar1.Buttons(3).ToolTipText = "Grabar Proyecto Actual"
Principal.Toolbar1.Buttons(8).ToolTipText = "Nueva Restricción Horizontal"
Principal.Toolbar1.Buttons(10).ToolTipText = "Nueva Fase Símplex"
Principal.Toolbar1.Buttons(11).ToolTipText = "Nueva Fase Dúplex Horizontal"
Principal.Toolbar1.Buttons(12).ToolTipText = "Nueva Fase Dúplex Vertical"
Principal.Toolbar1.Buttons(13).ToolTipText = "Nueva Fase Tríplex Tipo I"
Principal.Toolbar1.Buttons(14).ToolTipText = "Nueva Fase Tríplex Tipo II"
Principal.Toolbar1.Buttons(15).ToolTipText = "Nueva Fase Cuádruplex"
Principal.Toolbar1.Buttons(17).ToolTipText = "Nuevo Obstáculo Normal"
Principal.Toolbar1.Buttons(18).ToolTipText = "Nuevo Obstáculo Elevado Apoyado"
Principal.Toolbar1.Buttons(19).ToolTipText = "Nuevo Obstáculo Elevado "
Principal.Toolbar1.Buttons(21).ToolTipText = "Cálculo Manual"
Principal.Toolbar1.Buttons(22).ToolTipText = "Optimización Automática"
Principal.Toolbar1.Buttons(24).ToolTipText = "Resultados"
' Escondemos los menús en inglés y mostramos los de español
Principal.Archivo.Visible = True
Principal.Insertar.Visible = True
Principal.Perfiles.Visible = True
Principal.Herramientas.Visible = True
Principal.Ayuda.Visible = True
Principal.File.Visible = False
Principal.InsertItem.Visible = False
Principal.ProfilesMenu.Visible = False
Principal.Tools.Visible = False
Principal.HelpMenu.Visible = False
End Sub
Private Sub Option1_Click()
Principal.idioma = "Español"
Label3.Caption = "Distancia mínima al suelo (m.) :"
Check1.Caption = "Grid Vertical "
Check2.Caption = "Grid Horizontal "
Label6.Caption = "Incremento eje X (m.) :"
Label7.Caption = "Incremento eje Y (m.) :"
Label8.Caption = "Incremento Grid Vertical (m.) :"
Label9.Caption = "Incremento Grid Horizontal (m.) :"
Label12.Caption = "Idioma del Interfaz:"
Option1.Caption = "Español"
Option2.Caption = "Inglés"
Command1.Caption = "Aceptar"
Command2.Caption = "Cancelar"
Command3.Caption = "Predeterminado"
Command4.Caption = "Guardar"
End Sub
Private Sub Option2_Click()
Principal.idioma = "Inglés"
Label3.Caption = "Minimum to-ground distance (m.) :"
Check1.Caption = "Show Vertical Grid"
Check2.Caption = "Show Horizontal Grid"
Label6.Caption = "X-Axis Step (m.) :"
Label7.Caption = "Y-Axis Step (m.) :"
Label8.Caption = "Vertical Grid Step (m.) :"
Label9.Caption = "Horizontal Grid Step (m.) :"
Label12.Caption = "Interfaz Language:"
Option1.Caption = "Spanish"
Option2.Caption = "English"
Command1.Caption = "OK"
Command2.Caption = "Cancel"
Command3.Caption = "Default"
Command4.Caption = "Save as"
End Sub
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
