Disculpa
Juan Carlos Ruiz Pacheco
pero todavia no entiendo, te ruego disculpa y te envio el codigo fuente y un ejemplo de base de datos en formato texto, por favor, disculpa las molestias ocasionadas y lo humilde del programa, pero me intereza aprender.
Gracias.
Tiene un control picturebox con el nombre Pic y commandbutton con el nombre Command1
la base de datos se encuentra en un archivo texto tal como el que sigue:
14:21:54 Ton 000.342;
14:21:54 Ton 000.366;
14:21:54 Ton 000.388;
14:21:54 Ton 000.409;
14:21:54 Ton 000.427;
14:21:54 Ton 000.444;
14:21:54 Ton 000.462;
14:21:54 Ton 000.478;
14:21:54 Ton 000.491;
14:21:54 Ton 000.505;
14:21:54 Ton 000.517;
14:21:54 Ton 000.528;
14:21:55 Ton 000.540;
14:21:55 Ton 000.550;
14:21:55 Ton 000.560;
14:21:55 Ton 000.568;
14:21:55 Ton 000.575;
14:21:55 Ton 000.583;
14:21:55 Ton 000.589;
14:21:55 Ton 000.595;
14:21:55 Ton 000.601;
14:21:55 Ton 000.607;
14:21:55 Ton 000.613;
14:21:55 Ton 000.618;
14:21:55 Ton 000.622;
14:21:56 Ton 000.630;
14:21:56 Ton 000.636;
14:21:56 Ton 000.640;
14:21:56 Ton 000.648;
14:21:56 Ton 000.654;
14:21:56 Ton 000.660;
14:21:56 Ton 000.665;
14:21:56 Ton 000.671;
14:21:56 Ton 000.677;
14:21:56 Ton 000.683;
14:21:56 Ton 000.689;
14:21:56 Ton 000.695;
14:21:56 Ton 000.701;
14:21:57 Ton 000.705;
14:21:57 Ton 000.710;
14:21:57 Ton 000.716;
14:21:57 Ton 000.722;
14:21:57 Ton 000.730;
14:21:57 Ton 000.736;
14:21:57 Ton 000.742;
14:21:57 Ton 000.748;
14:21:57 Ton 000.753;
14:21:57 Ton 000.759;
14:21:57 Ton 000.767;
14:21:57 Ton 000.775;
14:21:58 Ton 000.781;
14:21:58 Ton 000.787;
14:21:58 Ton 000.793;
14:21:58 Ton 000.799;
14:21:58 Ton 000.804;
14:21:58 Ton 000.812;
14:21:58 Ton 000.820;
14:21:58 Ton 000.826;
14:21:58 Ton 000.832;
14:21:58 Ton 000.840;
14:21:58 Ton 000.845;
14:21:58 Ton 000.851;
14:21:58 Ton 000.859;
14:21:59 Ton 000.867;
14:21:59 Ton 000.875;
14:21:59 Ton 000.883;
14:21:59 Ton 000.890;
14:21:59 Ton 000.896;
14:21:59 Ton 000.904;
14:21:59 Ton 000.912;
14:21:59 Ton 000.922;
14:21:59 Ton 000.930;
14:21:59 Ton 000.939;
14:21:59 Ton 000.949;
14:21:59 Ton 000.959;
14:21:59 Ton 000.971;
14:22:00 Ton 000.982;
14:22:00 Ton 000.994;
14:22:00 Ton 001.008;
14:22:00 Ton 001.024;
14:22:00 Ton 001.037;
14:22:00 Ton 001.053;
14:22:00 Ton 001.067;
14:22:00 Ton 001.080;
14:22:00 Ton 001.094;
14:22:00 Ton 001.108;
14:22:00 Ton 001.119;
14:22:00 Ton 001.131;
14:22:00 Ton 001.141;
14:22:01 Ton 001.151;
14:22:01 Ton 001.161;
14:22:01 Ton 001.170;
14:22:01 Ton 001.180;
Dim fil As Integer, col As Integer, factor As Double, sw As Integer
Dim factorx As Double, contador As Integer, colx As Double
Dim datos(10000, 1)
Private Sub Command1_Click()
Dim fila As Date, columna As Double
Dim saltos(1000)
Open "C:\Documents and Settings\Administrador\Escritorio\Comunicaciones\prueba2.TXT" For Input As #1
f = 1
c = 0
sw = 0
contador = 1
brinca = 0
X = 20
datos(0, 0) = 0
datos(0, 1) = 0
Pic.ScaleMode = 6
Pic.DrawWidth = 2
Pic.Width = 115
Pic.Height = 110
Pic.ForeColor = QBColor(4)
Pic.FontSize = 24 ' Establece el tamaño en puntos.
CX = Pic.ScaleWidth ' Obtiene el centro horizontal.
CY = Pic.ScaleHeight ' Obtiene el centro vertical.
Pic.Cls ' Borra el formulario.
Pic.AutoRedraw = False
While Not EOF(1)
Input #1, entrada$
If InStr(entrada, ";") Then
zz = 6
Else
zz = 7
End If
fila = CDate(Left(entrada, 8))
columna = CDbl(Left((Right(entrada, 7)), zz)) / 1000
datos(f, c) = contador
c = c + 1
datos(f, c) = columna
c = 0
f = f + 1
valor1 = generador((contador))
Call numabs((valor1), (contador))
valor = columna
valor = generador((valor))
Call linea((valor), (fil), (col), (columna))
contador = contador + 1
Wend
Pic.AutoRedraw = True
End Sub
Private Function generador(valor As Double) As Double
Dim gen(1 To 3, 1 To 7) As Double
Dim pri(1 To 3)
Dim filotro(1 To 40)
Dim colotro(1 To 40)
pri(1) = 5
pri(2) = 2
pri(3) = 1
Z = 1
menor = 1000000
factor = 0.0001
col = 10
fil = 3
If (valor > pri(1) * 10 * factor Or valor <= pri(3) * 4 * factor) Then
Do
factor = factor * 10
Loop Until valor < (pri(1) * 10 * factor) And valor >= (pri(3) * 4 * factor)
End If
While col = 10 And fil = 3
For n = 1 To 3
For m = 1 To 7
gen(n, m) = (11 - m) * pri(n) * factor
encontrado = Abs(gen(n, m) - valor)
If encontrado <= menor Then
menor = encontrado
encon = gen(n, m)
fil = 4 - n
col = 11 - m
End If
Next m
Next n
For n = 1 To 3
For m = 1 To 7
If gen(n, m) = encon Then
filotro(Z) = 4 - n
colotro(Z) = 11 - m
If col > colotro(Z) Then
col = colotro(Z)
fil = filotro(Z)
End If
Z = Z + 1
End If
Next m
Next n
If col = 10 And fil = 3 Then
factor = factor * 10
End If
If col = 10 And fil <> 3 Then
col = 9 And fil = fil + 1
End If
Wend
generador = encon
End Function
Private Sub linea(valor As Double, fil As Double, col As Integer, columna As Double)
Pic.ScaleMode = 6
Pic.FontSize = 6
Z = 3
Select Case fil
Case 1
factor = factor * 1
Case 2
factor = factor * 2
Case 3
factor = factor * 5
End Select
For n = 0 To col + 1
Pic.CurrentX = 1
Pic.CurrentY = (100 / (col + 1)) * n + (Z - 1.75)
Y = Format(((factor * (col + 1)) - factor * n), "##,##0.00")
Pic.Print Y
Pic.Line (7, Z + (100 / (col + 1)) * n)-(110, Z + (100 / (col + 1)) * n)
Next
c = 0
Z = 8
temp1 = 100 / colx
For n = 0 To contador
XPos = Z + temp1 * datos(n, c) / factorx
c = c + 1
YPos = 103 - ((100 / (col + 1)) * datos(n, c)) / factor
Pic.DrawWidth = 7
Pic.PSet (XPos, YPos), QBColor(1)
Pic.DrawWidth = 2
c = 0
Next
End Sub
Private Sub numabs(valor1 As Double, contador As Integer)
Pic.Cls
Pic.ScaleMode = 6
Pic.FontSize = 6
Z = 8
Select Case fil
Case 1
factor = factor * 1
Case 2
factor = factor * 2
Case 3
factor = factor * 5
End Select
factorx = factor
colx = col + 1
Pic.Line (Z, 0)-(Z, 105)
For n = 0 To col + 1
Pic.CurrentX = (n * (100) / (col + 1)) + (Z - 2)
Pic.CurrentY = 105
Y = Format((factor * n), "##,##0.0")
Pic.Print Y
Pic.Line ((n * (100) / (col + 1)) + Z, 0)-((n * (100) / (col + 1)) + Z, 105)
Next
End Sub
