VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form SelConductor
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "Seleccione conductores que se utilizarán para optimización"
ClientHeight = 5835
ClientLeft = 45
ClientTop = 435
ClientWidth = 8295
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5835
ScaleWidth = 8295
StartUpPosition = 2 'CenterScreen
Begin MSComDlg.CommonDialog CommonDialog1
Left = 7200
Top = 4440
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command3
Caption = "Importar"
Height = 495
Left = 6960
TabIndex = 3
Top = 1920
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "Cancelar"
Height = 495
Left = 6960
TabIndex = 2
Top = 1200
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Aceptar"
Height = 495
Left = 6960
TabIndex = 1
Top = 480
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 5655
Left = 120
TabIndex = 0
Top = 120
Width = 6735
_ExtentX = 11880
_ExtentY = 9975
_Version = 393216
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Caption = "NOTA: Se recomienda elegir un número de conductores que sean potencia de 2."
Height = 1455
Left = 6960
TabIndex = 4
Top = 2640
Width = 1215
End
Begin VB.Image Image2
Height = 240
Left = 7800
Picture = "Selconductores.frx":0000
Top = 120
Visible = 0 'False
Width = 240
End
Begin VB.Image Image1
Height = 240
Left = 7200
Picture = "Selconductores.frx":0342
Top = 120
Visible = 0 'False
Width = 240
End
End
Attribute VB_Name = "SelConductor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim numfich As Integer
Dim filas() As String
Dim i As Integer ' Fila leida
Dim LineasTotales As Integer
Dim ColumnasTotales As Integer
Dim sigue As Boolean
Dim auxiliar As String
Dim aux As Integer
Dim auxcolor As Boolean
Dim anchos() As Integer
Dim anchoTotal As Single
Dim ArchivoPostes As String
Dim mensaje As String
Public automatico As Boolean
Public soloDimeConductor As Boolean
Public quienLlamo As String
Dim unosconductores() As String
Dim unconductor As String
Dim cadena As String
Private Sub Command1_Click()
Dim contador As Integer
Dim suma As Integer
Dim auxiliar As Variant
' Comprobamos que se ha seleccionado al menos 1 elemento, según el caso será
' conductor o poste. Si no es así se avisa.
contador = 1
suma = 0
While (contador < MSFlexGrid1.Rows)
MSFlexGrid1.Row = contador
MSFlexGrid1.col = ColumnasTotales + 2
suma = suma + CInt(MSFlexGrid1.Text)
' Añadimos elementos al array de conductores a optimizar
If MSFlexGrid1.Text = "1" Then
ReDim Preserve unosconductores(suma)
MSFlexGrid1.col = 1
unconductor = MSFlexGrid1.Text
MSFlexGrid1.col = 2
unconductor = unconductor & ";" & MSFlexGrid1.Text
MSFlexGrid1.col = 4
unconductor = unconductor & ";" & MSFlexGrid1.Text & ";"
unosconductores(suma) = unconductor
End If
contador = contador + 1
Wend
If Principal.manual = True Then
' Si estamos en manual y ha seleccionado más de 1 conductor se avisa que
' no esta permitido. En caso contrario se abre la ventana de postes.
If (suma > 1) Then
If Principal.idioma = "Español" Then
mensaje = "Solo puede seleccionar un conductor para cálculo manual"
Else
mensaje = "Only one conductor allowed in manual solve."
End If
MsgBox mensaje, vbExclamation, "MitLoop"
ElseIf suma = 1 Then
' Copiamos el conductor a la variable que vamos a ir
' arrastrando hasta llegar al formulario del lazo.
Dim filas As Integer
Dim uno As Integer
filas = 1
cadena = ""
' Buscamos el elemento seleccionado
While (filas <= MSFlexGrid1.Rows)
MSFlexGrid1.Row = filas - 1
MSFlexGrid1.col = ColumnasTotales + 2
uno = CSng(MSFlexGrid1.Text)
If (uno = 1) Then
MSFlexGrid1.col = 1
cadena = CStr(MSFlexGrid1.Text) & ";"
MSFlexGrid1.col = 2
cadena = cadena & CStr(MSFlexGrid1.Text) & ";"
MSFlexGrid1.col = 4
cadena = cadena & CStr(MSFlexGrid1.Text) & ";"
MSFlexGrid1.col = 7
cadena = cadena & CStr(MSFlexGrid1.Text) & ":"
' En cadena tendremos nombre;resist;rgm;coste:
End If
filas = filas + 1
Wend
' Si solo queremos cambiar de conductor acabamos aqui, si no seguimos
If soloDimeConductor = False Then
' Abrimos datos por defecto de postes
SelPoste.conductor = cadena
Unload Me
SelPoste.Show vbModal
Else
If quienLlamo = "Activo" Then
FormLazoActivo.conductor = cadena
Else
FormLazoPasivo.conductor = cadena
End If
Unload Me
End If
Else
If Principal.idioma = "Español" Then
mensaje = "Debe seleccionar un conductor."
Else
mensaje = "You must select one conductor."
End If
MsgBox mensaje, vbExclamation, "MitLoop"
End If
Else
' Si estamos en automatico se deja elegir los conductores que se quiera.
' Grabamos a fichero el array de conductores a optimizar
Dim nombre As String
Dim fid As Integer
Dim co As Integer
If suma > 1 Then
co = 1
nombre = App.Path & "\optimiza\opt" & CStr(Module1.elementos + 1) & ".txt"
fid = FreeFile
Open nombre For Output As fid
While (co <= UBound(unosconductores))
Print #fid, unosconductores(co)
co = co + 1
Wend
Close fid
End If
' Ponemos el label de numero recomendado de conductores oculto.
Label1.Visible = False
SelPoste.Show vbModal
Unload Me
End If
End Sub
Private Sub Command2_Click()
If quienLlamo = "Activo" Then
FormLazoActivo.conductor = ""
Else
FormLazoPasivo.conductor = ""
End If
Unload Me
End Sub
Function Coloca(ByVal filaActual As String) As Integer
Dim columna As Long
Dim dato As String
Dim anterior As Integer
Dim ancho As Integer
Dim j As Integer
' Buscamos el primer carácter antes del primer dato
aux = InStr(1, filaActual, ";")
aux = aux + 1
' Ahora tenemos en aux el primer carácter del
' primer dato, y a partir de aqui todo son datos
While (aux <> 0)
MSFlexGrid1.Row = i
columna = 1
' Rellenamos la fila actual
aux = InStr(1, filaActual, ";")
anterior = 0
While (aux <> 0)
dato = Trim(Mid(filaActual, anterior + 1, aux - 1 - anterior))
' Rellenamos el MSFlexGrid
If (i = 0) Then
With MSFlexGrid1
.Row = 0
.col = columna
.Text = dato
.CellAlignment = flexAlignCenterCenter
.Row = 0
.col = 0
End With
Else
With MSFlexGrid1
.Row = i
.col = columna
.Text = dato
.CellAlignment = flexAlignCenterCenter
End With
If columna = 1 Then
MSFlexGrid1.col = 0
Set MSFlexGrid1.CellPicture = Image1.Picture
End If
End If
' Escribimos el último dato.
If (columna = ColumnasTotales) Then
If (i <> 0) Then
j = 1
While (InStr(1, Right(filaActual, j), ";") = 0)
'MsgBox (Right(filaActual, j))
j = j + 1
Wend
dato = Right(filaActual, j - 1)
Else
dato = Trim(Mid(filaActual, aux + 1, Len(filaActual) - 1 - anterior))
End If
With MSFlexGrid1
.Row = i
.col = columna + 1
.Text = dato
.CellAlignment = flexAlignCenterCenter
End With
' Calculamos el ancho necesario para representar el dato
ancho = Len(dato) * MSFlexGrid1.FontWidth * 45
If (ancho > anchos(columna + 1)) Then
MSFlexGrid1.ColWidth(columna + 1) = ancho
anchos(columna + 1) = ancho
End If
End If
' Ponemos a 0 la casilla de control de selección
MSFlexGrid1.col = ColumnasTotales + 2
MSFlexGrid1.Text = 0
' Calculamos el ancho necesario para representar el dato
ancho = Len(dato) * MSFlexGrid1.FontWidth * 45
If (ancho > anchos(columna)) Then
MSFlexGrid1.ColWidth(columna) = ancho
anchos(columna) = ancho
End If
' Ancho de las celdas de checkboxes
MSFlexGrid1.ColWidth(0) = 300
columna = columna + 1
anterior = aux
aux = InStr(aux + 1, filaActual, ";")
Wend
Wend
' Reajustamos ancho
j = 0
anchoTotal = 0
While (j <= ColumnasTotales + 1)
anchoTotal = anchoTotal + anchos(j)
j = j + 1
Wend
If anchoTotal > 9000 Then anchoTotal = 12000
MSFlexGrid1.Width = anchoTotal + 300
SelConductor.Width = MSFlexGrid1.Width + 2000
' Reajustamos alto
j = MSFlexGrid1.Rows
If (j > 0) Then
If (j < 15) Then
MSFlexGrid1.Height = j * MSFlexGrid1.RowHeight(1) + 500
Else
MSFlexGrid1.Height = 17 * MSFlexGrid1.RowHeight(1) + 500
End If
SelConductor.Height = MSFlexGrid1.Height + 800
SelConductor.Refresh
Else
MsgBox "No hay datos para procesar.", vbInformation, "MitLoop"
End If
End Function
Sub Importa(ByVal FicheroEntradaDatos As String)
sigue = True
numfich = FreeFile
' Si el fichero ya contiene la ruta no se añade
If (InStr(1, FicheroEntradaDatos, ":") = 0) Then
FicheroEntradaDatos = Principal.LocalPath & "database\" & FicheroEntradaDatos
End If
Open FicheroEntradaDatos For Input As numfich
i = 1
'Contamos lineas del fichero
LineasTotales = 0
ColumnasTotales = 0
Line Input #numfich, auxiliar
While (Not EOF(numfich) And Len(auxiliar) <> 0)
LineasTotales = LineasTotales + 1
Line Input #numfich, auxiliar
If (i = 1) Then
aux = InStr(aux + 1, auxiliar, ";")
While (aux <> 0)
ColumnasTotales = ColumnasTotales + 1
aux = InStr(aux + 1, auxiliar, ";")
Wend
i = i + 1
' Redimensionamos +1 para incluir la ultima columna, que no la pilla
' el bucle anterior.
ReDim anchos(ColumnasTotales + 1)
End If
Wend
Close numfich
' Definimos el MSFlexGrid
With MSFlexGrid1
.Rows = LineasTotales
.Cols = ColumnasTotales + 3
.AllowUserResizing = flexResizeBoth
.CellAlignment = 4
.FontWidth = 3
End With
' Ahora vamos procesando las líneas
Open FicheroEntradaDatos For Input As numfich
i = 0
While (Not EOF(numfich) And sigue = True)
ReDim Preserve filas(i)
Line Input #numfich, filas(i)
If (Len(filas(i)) = 0) Then
sigue = False
Else
Coloca (filas(i))
i = i + 1
End If
Wend
Close numfich
' Ponemos a ancho cero la columna auxiliar
MSFlexGrid1.ColWidth(ColumnasTotales + 2) = 0
End Sub
Private Sub Command3_Click()
Dim ArchivoConductores As String
If (Principal.idioma = "Español") Then
SelConductor.Caption = "Seleccione conductores para optimización"
Else
SelConductor.Caption = "Select conductors to use in optimization process"
End If
' Importamos datos de conductores
With CommonDialog1
.DefaultExt = ".txt"
.Filter = "Archivos de texto (*.txt)|*.txt|Todos los archivos (*.*)|*.*"
.ShowOpen
End With
ArchivoConductores = CommonDialog1.filename
If Len(ArchivoConductores) <> 0 Then
If (Right(ArchivoConductores, 4) <> ".txt") Then
ArchivoConductores = ArchivoConductores & ".txt"
End If
Importa (ArchivoConductores)
End If
End Sub
Private Sub Form_Load()
If (Principal.idioma = "Español") Then
If Principal.manual = False Then
SelConductor.Caption = "Seleccione conductores para optimización"
Else
SelConductor.Caption = "Seleccione conductor"
End If
Command1.Caption = "Aceptar"
Command2.Caption = "Cancelar"
Command3.Caption = "Importar"
Else
If Principal.manual = False Then
SelConductor.Caption = "Choose conductors to use for optimize"
Else
SelConductor.Caption = "Choose one conductor"
End If
Command1.Caption = "OK"
Command2.Caption = "Cancel"
Command3.Caption = "Import"
End If
Label1.Left = (MSFlexGrid1.Left + MSFlexGrid1.Width + SelConductor.Width) / 2 - Label1.Width / 2 + 120
Label1.Top = Command3.Top + Command3.Height + 100
If (Len(Dir$(App.Path & "\database\conductores.txt")) = 0) Then
If Principal.idioma = "Español" Then
MsgBox "No se ha encontrado la base de datos de conductores por defecto." & _
" Elija a continuacion la que desea utilizar", vbInformation, "MitLoop"
Else
MsgBox "Default conductor database not found." & _
" Choose another database.", vbInformation, "MitLoop"
End If
With CommonDialog1
.Filter = "Ficheros de texto (*.txt)|*.txt|Todos los ficheros (*.*)|*.*"
.DefaultExt = "*.txt"
.Flags = &H1000 Or &H4
.ShowOpen
End With
If Len(CommonDialog1.filename) > 0 Then
Importa (CommonDialog1.filename)
End If
Else
Importa ("conductores.txt")
End If
If Principal.manual = True Then Label1.Visible = False Else Label1.Visible = True
End Sub
Private Sub Form_Resize()
If (SelConductor.Height > 10 And SelConductor.Width > 10) Then
Command1.Top = 850 * SelConductor.Height / 6375
Command1.Left = SelConductor.Width - 1215 - 225
Command2.Top = 1700 * SelConductor.Height / 6375
Command2.Left = SelConductor.Width - 1215 - 225
Command3.Top = 2550 * SelConductor.Height / 6375
Command3.Left = SelConductor.Width - 1215 - 225
Label1.Left = (MSFlexGrid1.Left + MSFlexGrid1.Width + SelConductor.Width) / 2 - Label1.Width / 2 + 120
Label1.Top = Command3.Top + Command3.Height + 100
End If
If (SelConductor.Height > 1000 And SelConductor.Width > 1000) Then
MSFlexGrid1.Height = SelConductor.Height - (6375 - 5655)
MSFlexGrid1.Width = SelConductor.Width - (8400 - 6735)
End If
End Sub
Private Sub MSFlexGrid1_Click()
Dim fila As Integer
Dim colum As Integer
Dim valor As Integer
fila = MSFlexGrid1.Row
colum = MSFlexGrid1.col
MSFlexGrid1.col = ColumnasTotales + 2
valor = CSng(MSFlexGrid1.Text)
If (valor = 0) Then
MSFlexGrid1.Text = 1
MSFlexGrid1.col = 0
Set MSFlexGrid1.CellPicture = Image2.Picture
Else
MSFlexGrid1.Text = 0
MSFlexGrid1.col = 0
Set MSFlexGrid1.CellPicture = Image1.Picture
End If
End Sub
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
