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 SelPoste
Caption = "Seleccione Postes a optimizar"
ClientHeight = 5865
ClientLeft = 60
ClientTop = 450
ClientWidth = 8250
LinkTopic = "Form1"
ScaleHeight = 5865
ScaleWidth = 8250
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command1
Caption = "Aceptar"
Height = 495
Left = 6960
TabIndex = 2
Top = 360
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "Cancelar"
Height = 495
Left = 6960
TabIndex = 1
Top = 1080
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "Importar"
Height = 495
Left = 6960
TabIndex = 0
Top = 1800
Width = 1215
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 7320
Top = 4800
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 5655
Left = 120
TabIndex = 3
Top = 120
Width = 6735
_ExtentX = 11880
_ExtentY = 9975
_Version = 393216
End
Begin VB.Image Image1
Height = 240
Left = 7080
Picture = "SelPoste.frx":0000
Top = 0
Visible = 0 'False
Width = 240
End
Begin VB.Image Image2
Height = 240
Left = 7680
Picture = "SelPoste.frx":0342
Top = 0
Visible = 0 'False
Width = 240
End
End
Attribute VB_Name = "SelPoste"
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 conductor As String
Dim unosPostes() As String
Dim unposte As String
Public soloDimeConductor As Boolean
Public quienLlamo As String
Private Sub grabapostes()
' Este procedimiento nos graba en fichero los postes a utilizar para optimizacion
' Creamos un fichero con los conductores para optimizacion.
Dim fichCond As Integer
Dim filas As Integer
Dim uno As Integer
Dim cadena As String
filas = 1
cadena = ""
fichCond = FreeFile
Open App.Path & "\optimiza\postes.txt" For Output As fichCond
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) & ":"
Print #fichCond, cadena
End If
filas = filas + 1
Wend
Close fichCond
End Sub
Private Sub Command1_Click()
Dim contador As Integer
Dim suma As Integer
Dim auxiliar As Variant
Dim mifila As Integer
Dim uno As Single
Dim cadena As String
' 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 postes a optimizar
If MSFlexGrid1.Text = "1" Then
ReDim Preserve unosPostes(suma)
MSFlexGrid1.col = 1
unposte = MSFlexGrid1.Text
MSFlexGrid1.col = 2
unposte = unposte & ";" & MSFlexGrid1.Text
MSFlexGrid1.col = 5
unposte = unposte & ";" & MSFlexGrid1.Text & ";"
unosPostes(suma) = unposte
End If
contador = contador + 1
Wend
If Principal.manual = True Then
' SI estamos en manual y se selecciona mas de un conductor, se avisa que no se puede
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
mifila = 2
cadena = ""
' Buscamos el poste seleccionado
While (mifila <= MSFlexGrid1.Rows)
MSFlexGrid1.Row = mifila - 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 = 5
cadena = cadena & CStr(MSFlexGrid1.Text) & ":"
' En cadena tendremos nombre;altura;coste:
End If
mifila = mifila + 1
Wend
' Si solo queremos cambiar de conductor acabamos aqui, si no seguimos
If soloDimeConductor = False Then
Unload Me
SelLazo.poste = cadena
SelLazo.conductor = conductor
SelLazo.Show vbModal
Else
If quienLlamo = "Activo" Then
FormLazoActivo.poste = cadena
Else
FormLazoPasivo.poste = cadena
End If
Unload Me
End If
End If
Else
' Si estamos en automatico se deja elegir los postes que se quiera.
' Grabamos a fichero el array de postes a optimizar
Dim nombre As String
Dim fid As Integer
Dim co As Integer
If Len(Dir$(App.Path & "\optimiza\optpostes.txt")) > 0 Then Kill (App.Path & "\optimiza\optpostes.txt")
If suma > 1 Then
co = 1
nombre = App.Path & "\optimiza\optpostes" & ".txt"
fid = FreeFile
Open nombre For Output As fid
While (co <= UBound(unosPostes))
Print #fid, unosPostes(co)
co = co + 1
Wend
Close fid
End If
End If
End Sub
Private Sub Command2_Click()
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)
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
MSFlexGrid1.Width = anchoTotal + 300
SelPoste.Width = MSFlexGrid1.Width + 500
' Reajustamos alto
j = MSFlexGrid1.Rows
If (j > 0) Then
If (j < 15) Then
MSFlexGrid1.Height = j * MSFlexGrid1.RowHeight(1) + 300
Else
MSFlexGrid1.Height = 17 * MSFlexGrid1.RowHeight(1) + 300
End If
SelPoste.Height = MSFlexGrid1.Height + 800
SelPoste.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()
' Importamos datos de postes
With CommonDialog1
.DefaultExt = ".txt"
.Filter = "Archivos de texto (*.txt)|*.txt|Todos los archivos (*.*)|*.*"
.ShowOpen
End With
If (Len(CommonDialog1.filename) > 0) Then Importa (CommonDialog1.filename)
End Sub
Private Sub Form_Load()
If (Principal.idioma = "Español") Then
Command1.Caption = "Aceptar"
Command2.Caption = "Cancelar"
Command3.Caption = "Importar"
If Principal.manual = True Then
Me.Caption = "Elija poste"
Else
Me.Caption = "Elija postes para optimización"
End If
Else
Command1.Caption = "OK"
Command2.Caption = "Cancel"
Command3.Caption = "Import"
If Principal.manual = True Then
Me.Caption = "Choose tower"
Else
Me.Caption = "Choose towers for optimization"
End If
End If
If (Len(Dir$(App.Path & "\database\postes.txt")) = 0) Then
If Principal.idioma = "Español" Then
MsgBox "No se ha encontrado la base de datos de postes por defecto." & _
" Elija a continuacion la que desea utilizar", vbInformation, "MitLoop"
Else
MsgBox "Default tower 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 ("postes.txt")
End If
End Sub
Private Sub Form_Resize()
If (SelPoste.Height > 10 And SelPoste.Width > 10) Then
Command1.Top = 850 * SelPoste.Height / 6375
Command1.Left = SelPoste.Width - 1215 - 225
Command2.Top = 1700 * SelPoste.Height / 6375
Command2.Left = SelPoste.Width - 1215 - 225
Command3.Top = 2550 * SelPoste.Height / 6375
Command3.Left = SelPoste.Width - 1215 - 225
End If
If (SelPoste.Height > 1000 And SelPoste.Width > 1000) Then
MSFlexGrid1.Height = SelPoste.Height - (6375 - 5655)
MSFlexGrid1.Width = SelPoste.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.
