VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Login
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "Elija Perfil de usuario"
ClientHeight = 1455
ClientLeft = 45
ClientTop = 435
ClientWidth = 4935
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1455
ScaleWidth = 4935
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton Command4
Caption = " Importar"
Height = 375
Left = 3240
TabIndex = 4
Top = 960
Width = 1455
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4080
Top = 240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command2
Caption = "Aceptar"
Height = 375
Left = 240
TabIndex = 3
Top = 960
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Nuevo"
Height = 375
Left = 1680
TabIndex = 2
Top = 960
Width = 1455
End
Begin VB.ComboBox Combo1
Height = 315
Left = 2520
TabIndex = 0
Text = "Default"
Top = 420
Width = 1455
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Perfiles disponibles:"
Height = 195
Left = 360
TabIndex = 1
Top = 480
Width = 1380
End
End
Attribute VB_Name = "Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim aux As String
Dim numfich As Integer
Private Sub Command1_Click()
configura.Show vbModal
End Sub
Private Sub Command2_Click()
aux = Combo1.Text
ImportaPerfil (aux)
Unload Me
End Sub
Private Sub Command4_Click()
' Hay que abrir el fichero de configuracion.
With CommonDialog1
.Filter = "Perfiles de Usuario (*.usr)|*.usr"
.DefaultExt = "*.usr"
.ShowOpen
End With
' Si se ha seleccionado un fichero
If (Len(CommonDialog1.filename) <> 0) Then
' Importamos el perfil que se haya seleccionado.
ImportaPerfil (CommonDialog1.filename)
Unload Me
End If
End Sub
Private Sub Form_Load()
Dim numfich As Integer
If (Principal.idioma = "Español") Then
Me.Caption = "Elija Perfil de Usuario."
Label1.Caption = "Perfiles disponibles:"
Command1.Caption = "Nuevo"
Command2.Caption = "Aceptar"
Command4.Caption = "Importar"
Else
Me.Caption = "Choose User Profile"
Label1.Caption = "Available Profiles"
Command1.Caption = "New"
Command2.Caption = "OK"
Command4.Caption = "Import"
End If
' Tenemos que rellenar el ComboBox con los perfiles
' que haya registrados en el archivo index.usr en la
' carpeta /perfiles.
' Primero comprobamos que el fichero exista.
If (Len(Dir(Principal.LocalPath & "index.usr")) = 0) Then ' Si no existe se crea.
CreaIndex
Else ' Si existe se lee.
LeeIndex
End If
' Comprobamos que exista la carpeta perfiles, y si no es así, se crea y se añade el perfil default
' Si no existe la carpeta perfiles se crea.
If (Len(Dir(Principal.LocalPath & "\perfiles", vbDirectory)) = 0) Then MkDir (Principal.LocalPath & "perfiles")
' Y ahora creamos el perfil Default.usr si es que no existe.
If (Len(Dir(Principal.LocalPath & "\perfiles\Default.usr")) = 0) Then
numfich = FreeFile
Open (Principal.LocalPath & "perfiles\Default.usr") For Output As numfich
Print #numfich, "MitLoop 2.0"
Print #numfich, "xmax,30"
Print #numfich, "xmin,-30"
Print #numfich, "ymax,40"
Print #numfich, "ymin,-10"
Print #numfich, "GridH,0"
Print #numfich, "GridV,0"
Print #numfich, "incrGridH,5"
Print #numfich, "incrGridV,5"
Print #numfich, "alturaminima,7"
Print #numfich, "incrx,5"
Print #numfich, "incry,5"
Close numfich
End If
ImportaPerfil ("default.usr")
End Sub
Sub CreaIndex()
Dim numfich As Integer
' Borramos el combobox (por si tuviera basura) e
' introducimos el perfil Default.
Dim i As Integer
i = 1
While (i <= Combo1.ListCount)
Combo1.RemoveItem (i)
i = i + 1
Wend
Combo1.AddItem ("Default")
' Creamos el fichero index
numfich = FreeFile
Open Principal.LocalPath & "index.usr" For Output As numfich
' Le añadimos el perfil Default.
Print #numfich, "Default"
Close numfich
End Sub
Sub LeeIndex()
' Limpiamos el ComboBox por si acaso habia algo.
Dim i As Integer
i = 1
While (i <= Combo1.ListCount)
Combo1.RemoveItem (i)
i = i + 1
Wend
' Abrimos el fichero y cargamos los nombres de los perfiles.
Dim numfich As Integer
numfich = FreeFile
Open (Principal.LocalPath & "index.usr") For Input As numfich
While (Not EOF(numfich))
Line Input #numfich, aux
aux = Trim(aux)
Login.Combo1.AddItem (aux)
Wend
Close numfich
End Sub
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)
Case Is = "xmin"
Principal.xminima = CSng(valor)
Principal.xminorig = CSng(valor)
Case Is = "ymax"
Principal.ymaxima = CSng(valor)
Principal.ymaxorig = CSng(valor)
Case Is = "ymin"
Principal.yminima = CSng(valor)
Principal.yminorig = CSng(valor)
Case Is = "gridh"
If (valor = True) Then
Principal.GridHorizontal = True
Else
Principal.GridHorizontal = False
End If
Case Is = "gridv"
If (valor = True) Then
Principal.GridVertical = True
Else
Principal.GridVertical = False
End If
Case Is = "incrgridh"
If (valor = 1) Then
Principal.incrementoGridH = 1
Else
Principal.incrementoGridH = CSng(valor)
End If
Case Is = "incrgridv"
If (valor = 1) Then
Principal.incrementoGridV = 1
Else
Principal.incrementoGridV = CSng(valor)
End If
Case Is = "alturaminima"
Principal.distanciaMinimaAlSuelo = 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 = CSng(valor)
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
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
