leer datos en archivo secuencial
corlo:
Hola soy corlo
estoy haciendo una mini aplicacion de guardar datos de factura y leerlos por pantalla, en archivo secuencial.
guardar datos lo hace bien
el problema esta en leer los datos de la factura en pantalla
el archivo es 1.txt y hay lo siguiente:
==============================
COMPROBANTE DE VENTA
==============================
TICKET Nº: 1 TIPO : CONTADO
FECHA : 20/11/2021 HORA : 20:30:59
-------------------------------------------------------
R.U.C/C.I : a
CLIENTE : a
===============================
CANTIDAD PRODUCTO PRECIO SUBTOTAL
===============================
12 r 8 96
3 k 1.5 4,5
===============================
TOTAL : 100,50
-------------------------------------------
GRACIAS POR SU COMPRA!
me sale todo mezclado
el código que tengo hasta ahora es el siguiente:
Código
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_SETTABSTOPS = &H192
Dim I As Integer
Dim orden As Integer 'numero de ticket
Dim fecha As Date 'para leer la fecha
Dim hora As Date 'para leer la hora
Dim contado As String 'para contado
Dim credito As String 'para credito
Dim cedu1 As String ' para el RUC/C.I
Dim nom1 As String ' para el cliente
'abajo son datos del list1
Dim cantidad As Integer
Dim producto As String * 12
Dim preciox As String * 8
Dim subtot As Double
'varible del total
Dim tot As Double
Private Sub Command4_Click()
End
End Sub
Private Sub Command5_Click()
'Nuevo registro
'//recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Txtnum = orden + 1
List1.Clear
txtCedula1.Text = ""
txtNombre1.Text = ""
total.Text = ""
txtCedula1.SetFocus
End Sub
Private Sub Command6_Click()
'Guardar Factura
Dim cantidadtotal As Double
Dim k As Integer
orden = Txtnum.Text
On Error GoTo salir
Open App.Path & "\Numero1.txt" For Append As #1
Print #1, Txtnum
Close #1
Dim bmx As String
bmx = App.Path + "\" + Txtnum + ".txt"
Open bmx For Append As #1
Txtnum = orden
Print #1,
Print #1,
Print #1,
Print #1, Tab(1); String(44, "=")
Print #1, Tab((44 - Len("COMPROBANTE DE VENTA")) \ 2); "COMPROBANTE DE VENTA"
Print #1, Tab(1); String(44, "=")
If Option1.Value = True Then
Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CONTADO")); "TIPO : CONTADO"
Else
Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CREDITO")); "TIPO : CREDITO"
End If
Print #1, Tab(1); "FECHA : " & Date; Tab(44 - Len("HORA : " & Time)); "HORA : " & Time
Print #1, Tab(1); String(44, "-")
Print #1, Tab(1); "R.U.C/C.I : " & txtCedula1.Text
Print #1, Tab(1); "CLIENTE : " & txtNombre1.Text
Print #1, Tab(1); String(44, "=")
Print #1, Tab(1); "CANTIDAD"; Tab(11); "PRODUCTO"; Tab(24); "PRECIO"; Tab(37); "SUBTOTAL"
Print #1, Tab(1); String(44, "=")
For k = 0 To List1.ListCount - 1
Print #1, List1.List(k)
Next k
Print #1, Tab(1); String(44, "=")
Print #1, Tab(15); "TOTAL : "; Tab(43 - Len(Format(total.Text, "#,##0.00"))); Format(total.Text, "#,##0.00")
Print #1, Tab(16); "-----------------------------"
Print #1,
Print #1, Tab((44 - Len("GRACIAS POR SU COMPRA!")) \ 2); "GRACIAS POR SU COMPRA!"
For I = 1 To 10
Print #1,
Next I
Close #1
Option1.Value = False
Option2.Value = False
txtCedula1.Text = ""
txtNombre1.Text = ""
List1.Clear
cant.Text = ""
prod.Text = ""
precio.Text = ""
subtotal.Text = ""
total.Text = ""
cant.SetFocus
Exit Sub
salir:
Dim msgb
msgb = MsgBox("Error Nº : [ " & Err.Number & " ]" & " " & Err.Description, vbOKCancel + vbInformation)
End Sub
Private Sub Command7_Click()
'Leer Factura
Dim tabs(0 To 3) As Long
tabs(0) = 20
tabs(1) = 60
tabs(2) = 95
tabs(3) = 138
' Set the tabs.
SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
Dim str As String
Dim thj As String
Dim plo As Boolean
Dim j As Integer
Dim h As Integer
On Error GoTo lo
List1.Clear
thj = App.Path + "\" + Txtnum.Text + ".txt"
If Dir(thj) <> "" Then
Open thj For Input As #1
Input #1, orden
Txtnum.Text = orden
Input #1, fecha
Label4.Caption = fecha
Input #1, hora
Label5.Caption = hora
Input #1, contado
Input #1, credito
Input #1, cedu1, nom1
txtCedula1.Text = cedu1
txtNombre1.Text = nom1
While Not EOF(1)
Input #1, cantidad, producto, preciox, subtot
cant.Text = cantidad
prod.Text = producto
precio.Text = preciox
subtotal.Text = subtot
List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
Wend
j = 0
For h = 0 To List1.ListCount - 1
j = j + Val(Split(List1.List(h), vbTab)(3))
Next h
total.Text = j
Close #1
End If
If contado= contado Then
Option1.Value = True
Else
If credito = credito Then
Option2.Value = True
End If
End If
Exit Sub
lo:
If Not plo = True Then
MsgBox "La Factura no existe, gracias", vbCritical
End If
End Sub
Private Sub Command8_Click()
'Agregar
Dim h As Integer
Dim j As Double
cantidad = cant.Text
producto = prod.Text
preciox = precio.Text
subtot = subtotal.Text
List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
j = 0
For h = 0 To List1.ListCount - 1
j = j + Split(List1.List(h), vbTab)(3)
Next h
total.Text = Format(j, "#,##0.00")
cant.Text = ""
prod.Text = ""
precio.Text = ""
subtotal.Text = ""
cant.SetFocus
End Sub
Private Sub Form_Load()
Dim tabs(0 To 3) As Long
tabs(0) = 20
tabs(1) = 123
tabs(2) = 237
tabs(3) = 370
SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
Option1.Value = False
Option2.Value = False
Open App.Path & "\Numero1.txt" For Append As #1
Close #1
Open App.Path & "\Numero1.txt" For Append As #1
Close #1
'//recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Txtnum = orden + 1
End Sub
Private Sub List1_Click()
Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Text2.Text = Mid(List1.Text, InStr(1, List1.Text, " ") + 1)
I = List1.ListIndex
End Sub
Private Sub Option1_Click()
Option2.Value = False
End Sub
Private Sub Option2_Click()
Option1.Value = False
End Sub
Private Sub precio_KeyUp(KeyCode As Integer, Shift As Integer)
subtotal.Text = cant.Text * Val(precio.Text)
End Sub
Private Sub Timer1_Timer()
Label4.Caption = Date
Label5.Caption = Format(Time, "hh:mm:ss")
End Sub
Gracias
Serapis:
Citar
Código
' Nuevo registro:
Private Sub Command5_Click() ' recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Esto no tiene sentido... Si intento buscarle uno, diría que intentas llegar a la última entrada, pero... el código en el botón guardar, no lo confirma, porque el guardado de datos tiene formato, luego ahí en ese bucle, lo único que haces es recorrer a saltos de 2 bytes (los bytes de un integer de vb6) con cada lectura... hasta llegar al final del fichero, pero ni siquiera hay garantías de eso, si el fichero tiene bytes impares.
Citar
Código
Open thj For Input As #1
Input #1, orden
Txtnum.Text = orden
Input #1, fecha
Label4.Caption = fecha
Input #1, hora
Label5.Caption = hora
Input #1, contado
Input #1, credito
Input #1, cedu1, nom1
txtCedula1.Text = cedu1
txtNombre1.Text = nom1
While Not EOF(1)
Input #1, cantidad, producto, preciox, subtot
cant.Text = cantidad
prod.Text = producto
Precio.Text = preciox
subtotal.Text = subtot
List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
Wend
Close #1
Aquí, aunque está mejor tampoco es óptimo.... Si el fichero contiene pongamos 1000 registros, parece que todos están obligados a rescribir contínuamente ciertos textbox...
Además, operando con registros, lo adecuado es usar una estructura, para escribir y leer de una sola vez cada registro...
Código
private type RegCompra
NumTicket as integer
FechaCompra as date
Contado as string * ???
Credito as string * ???
Producto As String * 12
PrecioX As String * 8 ' por qué un string?. _Sería adecuado un single
Cantidad as integer
SubTotal As Double ' no requiere un dobule, basta con un single, no vas a realizar cantidades astronómicas que escapen a un single.
end type
- Por qué llamarlo 'orden' si es el ´numero del ticket?.
- Por que guardar a fichero la fecha y luego la hora, cuando la fecha guarda todo?.
- Qué es credito y qué contado?. el método de pago?.
Si es así crea una enumeracion:
Código
Private Enum MetodosDePago
PAGO_AL_CONTRADO = 0
PAGO_CON_TCREDITO = 1
End Enum
Si 'credito es por ejemplo el número de la tarjeta de crédito, entonces si puede ser un string, en ese caso reserva una cantidad fija de caracteres.
En ficheros con VB6, al guardar strings, hay 3 opciones, la más cómoda es definir una cadena de tamaño fijo, la otra es escribir tu mismo a fichero al momento de escribir el string, un integer indicando la cantidad de caracteres de esa cadena (que más adelante se usará para saber cuanto leer), la 3 opción es abrir el fichero 'for input', en cuyo caso vb6 se encarga previo a cada parámetro (incluido arrays), anteponer el tipo de dato guardado, es decir una cabecera donde se incluye el tipo e info adicional (si se precisa), para saber cuantos bytes leer con cada campo, esto lo hace más complejo, no tienes control de ello y acaba resultando lento...
No es preciso guardar a fchero los textos esos de 'gracias por su visita' ni otros textos, tan solo los datos... tu luego tendrías en todo caso una función llamada 'ImprimirFactura(registro)' que crea ese reporte textual formateando los datos de un registro, por ejemplo para imprimirlo con la impresora (para practica, basta imprimirlo en una ventana aparte).
Mi consejo es abrirlo 'for binary', en este modo tú tienes el control de cada byte, no se añade nada extra que tu desconozcas, lo que te da un control pleno sobre el contenido del fichero... además es más rápido al no tener que verificar cada cosa que se lee o escribe.
Y tratándose de registros es conveniente que todos tengan el mismo tamaño, por lo que conviene que cada string en el resgistro tenga un tamaño fijo.
Cuando se usa variable string de tipo fijo, utiliza exactamente esos caracteres y ninguno más...
Entonces manejar tu fichero podría ser así:
Código
Private Enum MetodosDePago
PAGO_AL_CONTRADO = 0
PAGO_CON_TCREDITO = 1
End Enum
Private Type RegCompra
NumTicket As Integer ' 1
FechaCompra As Date ' 3
MetodoDePago As Byte ' 11
Alineacion as byte ' 12 nada solo hace que el registro sea una cantidad par, para ser más efectivo en lecturas
Producto As String * 12 ' 13
PrecioUnidad As Single ' 25
Cantidad As Integer ' 29
SubTotal As Single ' 31
End Type ' total: 34 bytes por registro
Private Canal As Integer ' Número de canal de comunicación con el fichero.
Private NumRegistros As Long
Private reg1 As RegCompra ' para leer registros
Private reg2 As RegCompra ' para escribir registro, así diferenciados, será más difícil equivocarnos
' Leer Factura
Private Sub Command7_Click()
If LeerFacturacion("poner aqui tu ruta") = True Then
' Activar en la interfaz lo que proceda
Else
' desactivar de la interfaz lo que proceda
End If
' para activar o desactivar es preferible tener una función que reciba un buleano y en base a ello activa o desactiva cada cosa que proceda... ya que también se llamaría desde 'cerrar'
End Sub
Private Function LeerFacturacion(ByRef Ruta As String) As Boolean
Dim k As Integer
If (Abrir(Ruta) = True) Then
Get #Canal, 1, NumRegistros
For k = 1 To NumRegistros
Get #Canal, , reg1
Call List1.AddItem(SerializarRegistro(reg1))
Next
' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox...
list1.listindex = 0 ' para ello delegamos en el código que pondremos al listbox...
End If
End Function
Private Sub TrasferirRegToTextbox(ByRef R As RegCompra)
With R
txtNumTicket.Text = .NumTicket
txtFechaComprar.Text = CStr(.fecha)
optMetodoPago(.MetodoDePago).Value = True ' 2 controles option con indices 0 y 1
'cheMetodoPago.value = .MetodoDePago ' también vale un checkbox, que cambie su 'caption' según su valor, alternando entre 'Pago al contado' o 'Pago con Tarjeta de crédito'.
txtProducto.Text = .Producto
txtPrecioUnidad.Text = CStr(.PrecioUnidad)
txtCantidad.Text = CStr(.Cantidad)
txtSubtotal.Text = CStr(.SubTotal)
End With
End Sub
Private Sub PosicionarRegistro(ByVal Numregistro As Long)
If (Abierto = True) Then
Seek (Canal), (1 + ((Numregistro-1) * LenB(reg1)))
End If
End Sub
Private Function SerializarRegistro(ByRef Registro As RegCompra, ByVal Separador As String) As String
With Registro
SerializarRegistro = CStr(.NumTicket) & Separador & CStr(.FechaCompra) & _
Separador & GetMetodoPago(.MetodoDePago) & Separador & .Producto & _
Separador & CStr(.Cantidad) & Separador & CStr(.PrecioUnidad) & Separador & CStr(.SubTotal)
End With
End Function
Private Function GetMetodoPago(ByVal Metodo As MetodosDePago) As String
If (Metodo = PAGO_AL_CONTRADO) Then
GetMetodoPago = "Contado"
Else
GetMetodoPago = "T. Credito"
End If
End Function
Private Function ExisteFichero(ByRef Ruta As String) As Boolean
Dim j As Integer, file As String
j = InStrRev(Ruta, "\")
If (j > 0) Then
file = LCase$(Right$(Ruta, Len(Ruta) - j))
ExisteFichero = (LCase$(Dir(Ruta, vbNormal)) = file)
End If
End Function
Private Function Abrir(ByRef Ruta As String) As Boolean
If (Abierto = True) Then Call Cerrar
If (ExisteFichero(Ruta) = True) Then
Canal = FreeFile
On Error GoTo FalloApertura
Open Ruta For Binary As #Canal
FalloApertura:
If (Err.Number > 0) Then
Call MsgBox("Error al intentar abrir el fichero en la ruta:" & vbCrLf & Ruta & vbCrLf & Err.Description, vbInformation, "Error de apertura:")
Err.Clear
Else
Abrir = True
End If
On Error GoTo 0 ' hay que desactivar el controlador de errores, si no, cualquier error posterior cae en este interceptador (si es el último activo)...
End If
End Function
Public Property Get Abierto() As Boolean
Abierto = (Canal > 0)
End Property
Private Function Cerrar()
Close #Canal
canal = 0
NumRegistros = 0
' desactivar de la interfaz lo que proceda...
End Function
Private Sub List1_Click()
If (Abierto = True) Then
Call PosicionarRegistro(List1.ListIndex + 1)
Get #Canal, , reg1
Call TrasferirRegToTextbox(reg1, vbtab)
End If
End Sub
Nota que cuando la apertura Falla, deben desactivarse x botones para no incurrir en errores, como el de 'nuevo registro-añadir', etc...
Con esto abrimos y leemos cada registro, se transfiere al listbox (que ahora tiene más columnas, una por cada campo de la estructura-registro), y el primero se transfiere a los textbox.
Nota como el botón para leer el fichero separa la operatoria de leer el fichero (que delega en una función) del resto de lo que tiene que hacerse en la interfaz, que se opera ahí, aunque también puede delegarse a otra función, porque al cerrar el fichero igualmente deben desactivarse ciertos controles de la interfaz.
Tu código tiene mucho para comentar... pero no me apetece ahora señalarte cada cosita...
Se me hace tarde, mañana si te place te pongo lo que correspondería para añadir un nuevo registro y guardarlo a fichero... incluso para buscar un determinado registro. Mientras échale un ojo al código...
corlo:
Hola Serapis gracias por responder me ha ayudado bastante pero tengo dos dudas sobre el codigo que has puesto de lectura.
en donde dices leerfacturacion en el commandbutton7_click()
Código
Private Sub Command7_Click()
If LeerFacturacion("poner aqui tu ruta") = True Then
' Activar en la interfaz lo que proceda
Else
' desactivar de la interfaz lo que proceda
End If
' para activar o desactivar es preferible tener una función que reciba un buleano y en base a ello activa o desactiva cada cosa que proceda... ya que también se llamaría desde 'cerrar'
End Sub
en donde dices, activar en la interfaz lo que proceda
supongo que es
[code=vb]
abierto=true
en donde dices , desactivar de la interfaz lo que proceda
Código
abierto=false
y lo segundo cuando haces el private sub posicionarregistro la variable lenb(reg1) que significa
Código
Private Sub PosicionarRegistro(ByVal Numregistro As Long)
If (Abierto = True) Then
Seek (Canal), (1 + ((Numregistro-1) * LenB(reg1)))
End If
End Sub
gracias
seria bueno me pudiese hacer el codigo de añadir un nuevo registro y guardarlo a fichero... incluso para buscar un determinado registro, para entender mejor el codigo, gracias
[/code]
Serapis:
La instrucción LenB(variable), devuelve la cantidad de bytes que contiene esa variable, así como Len(string) devuelve la cantidad de caracteres (no necesariamente se corresponde con la cantidad de bytes).
en cualquier caso, cuando tengas dudas, posicionar el cursor encima de la instrucción (o cualquier parte de la sintaxis de vb6), pulsa la tecla F1 y te lleva a la ayuda, donde tes explica su cometido y puede incluso contener algún ejemplo.
Por cierto... esa función tiene un pequeño error del que me acabo de dar cuenta, te comento por encima:
Lo habitual es que al comienzo de ficheros con un determinado formato, exista una cabecera (de tamaño fijo generlamente o al menos conocido antes de escribir lo que venga detrás), en este caso la cabecera está compuesta por un único dato: 'NumRegistros', que al ocupar 4 bytes (del long de vb6), debe añadirse para calcular la posición absoluta de lectura/escritura de comienzo de u registor dado, es decir el primer registor debe comenzar en la posición 5 (vb6 considera que un fichero comienza siempre en la posición 1).
Citar
Private Sub PosicionarRegistro(ByVal Numregistro As Long)
If (Abierto = True) Then
Seek (Canal), (5 + ((Numregistro-1) * LenB(reg1)))
End If
End Sub
--------------------------------------------------------------------------
Tu segunda duda:
Citar
para activar o desactivar ... lo que proceda
Lo razonable es que hayas elementos en la interfaz que estén 'sincronizados' con determinados estados... por ejemplo el botón 'guardar' registro debería estar desactivado mientras no se haya abierto el fichero.
Si ni siquiera existe un fichero, es adecuado que esté habilitado un botón 'Crear nueva Factuación' (imagina por ejemplo un fichero por cada mes), que cierre el previo, vacíe el listado y los textbox, crea y abre un nuevo fichero y entonces activa los botones de añadir registro y buscar y cerrar, etc...
Siempre se puede añadir una comprobación dle tipo:
Código:
si Abierto=true luego
...
fin si
En el código (por ejemplo) del botón guardar registro, peor lo ideal es que si no se puede guardar, ese btón no estuviere activo.
---------------------------------------
...me edito, para ponerte el código... estará sin terminar al completo y sin provar ya que va siendo tarde, mira a ver si completas lo que falta (el código de los botones) y alguna pequeña función...
Nota que te pongo todo de nuevo, porque he cambiado alguna cosa... la función abrir, ahora debe abrir bajo dos condiciones, cuando se lee un fichero existente y cuando se pretende crear un nuevo fichero (que no debe existir)...
Las funciones añadidas, están al final... falta el código de los botones y alguna función más para completarlo.
Abajo pongo una capturas de como se vería la interfaz y vale por hoy.
Código
Private Enum MetodosDePago
PAGO_AL_CONTRADO = 0
PAGO_CON_TCREDITO = 1
End Enum
Private Type RegCompra
NumTicket As Integer ' 1
FechaCompra As Date ' 3
MetodoDePago As Byte ' 11
Alineacion As Byte ' 12 nada solo hace que el registro sea una cantidad par, para ser más efectivo en lecturas
Producto As String * 12 ' 13
PrecioUnidad As Single ' 25
Cantidad As Integer ' 29
SubTotal As Single ' 31
End Type ' total: 34 bytes por registro
Private Const DIR_COMIENZO_REGS As Long = 9 ' 1+4+4
Private NumRegistros As Long
Private AutonIncRegs As Long
'
Private Canal As Integer ' Número de canal de comunicación con el fichero.
Private reg1 As RegCompra ' para leer registros
Private reg2 As RegCompra ' para escribir registro, así diferenciados, será más difícil equivocarnos
Private Sub ComNuevaFacturacion_Click()
If (Len(TxtFile.Text) > 0) Then
Call CrearNuevaFacturacion(TxtFile.Text)
End If
End Sub
Private Sub ComAbrirFacturacion_Click()
Form2.Show 1
If (Len(Form2.File) > 0) Then
If (LeerFacturacion(App.Path & "\" & Form2.File) = True) Then
Call Activar(True)
Else
Call Activar(False)
End If
End If
End Sub
Private Sub ComBuscar_Click()
'
End Sub
Private Sub ComEditarRegistro_Click()
'
End Sub
Private Sub ComGuardarRegistro_Click()
'
End Sub
Private Sub ComRetirarRegistro_Click()
'
End Sub
Private Sub ComSalir_Click()
'
End Sub
Private Sub List1_Click()
If (Abierto = True) Then
Call PosicionarRegistro(List1.ListIndex + 1)
Get #Canal, , reg1
Call TrasferirRegToTextbox(reg1, vbTab)
End If
End Sub
' ------------ Fin interfaz ------------------
Private Function LeerFacturacion(ByRef Ruta As String) As Boolean
Dim k As Integer
If (Abrir(Ruta) = True) Then
Get #Canal, 1, NumRegistros
For k = 1 To NumRegistros
Get #Canal, , reg1
Call List1.AddItem(SerializarRegistro(reg1))
Next
' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox...
List1.ListIndex = 0 ' para ello delegamos en el código que pondremos al listbox...
End If
End Function
Private Sub TrasferirRegToTextbox(ByRef R As RegCompra)
With R
txtNumTicket.Text = .NumTicket
txtFechaComprar.Text = CStr(.fecha)
optMetodoPago(.MetodoDePago).Value = True ' 2 controles option con indices 0 y 1
'cheMetodoPago.value = .MetodoDePago ' también vale un checkbox, que cambie su 'caption' según su valor, alternando entre 'Pago al contado' o 'Pago con Tarjeta de crédito'.
txtProducto.Text = .Producto
txtPrecioUnidad.Text = CStr(.PrecioUnidad)
txtCantidad.Text = CStr(.Cantidad)
txtSubtotal.Text = CStr(.SubTotal)
End With
End Sub
Private Sub PosicionarRegistro(ByVal Numregistro As Long)
If (Abierto = True) Then
Seek (Canal), (DIR_COMIENZO_REGS + ((Numregistro - 1) * LenB(reg1)))
End If
End Sub
Private Function SerializarRegistro(ByRef Registro As RegCompra, ByVal Separador As String) As String
With Registro
SerializarRegistro = CStr(.NumTicket) & Separador & CStr(.FechaCompra) & _
Separador & GetMetodoPago(.MetodoDePago) & Separador & .Producto & _
Separador & CStr(.Cantidad) & Separador & CStr(.PrecioUnidad) & Separador & CStr(.SubTotal)
End With
End Function
Private Function GetMetodoPago(ByVal Metodo As MetodosDePago) As String
If (Metodo = PAGO_AL_CONTRADO) Then
GetMetodoPago = "Contado"
Else
GetMetodoPago = "T. Credito"
End If
End Function
Private Function ExisteFichero(ByRef Ruta As String) As Boolean
Dim j As Integer, File As String
j = InStrRev(Ruta, "\")
If (j > 0) Then
File = LCase$(Right$(Ruta, Len(Ruta) - j))
ExisteFichero = (LCase$(Dir(Ruta, vbNormal)) = File)
End If
End Function
' Abre un fichero que YA EXISTE: Cuando se solicita leer la facturación de uno.
' Abre un fichero que NO EXISTE: Cuando se trata de crear una nueva facturación.
Private Function Abrir(ByRef Ruta As String, Optional ByVal NoDebeExistir As Boolean = False) As Boolean
If (Abierto = True) Then Call Cerrar
If (ExisteFichero(Ruta) = False) Then
If (NoDebeExistir = False) Then Exit Function
End If
Canal = FreeFile
On Error GoTo FalloApertura
Open Ruta For Binary As #Canal
FalloApertura:
If (Err.Number > 0) Then
Call MsgBox("Error al intentar abrir el fichero en la ruta:" & vbCrLf & Ruta & vbCrLf & Err.Description, vbInformation, "Error de apertura:")
Err.Clear
Else
Abrir = True
End If
On Error GoTo 0 ' hay que desactivar el controlador de errores, si no, cualquier error posterior cae en este interceptador (si es el último activo)...
End Function
Public Property Get Abierto() As Boolean
Abierto = (Canal > 0)
End Property
Private Function Cerrar()
Close #Canal
Canal = 0
NumRegistros = 0
' desactivar de la interfaz lo que proceda...
End Function
' -------------------------------------------------
' -------- NUEVO DESDe AQUI ---------------
'--------------------------------------------------
' Index refiere al enésimo registor en el fichero.
' Si es -1 refiere al último, lo adecuaod cuando se añade.
' Si es entre 1 y NumRegistros, señala que es un registro que se ha editado...
Private Sub GuardarRegistro(ByRef R As RegCompra, Optional ByVal Index As Long = -1)
If (R.NumTicket = 0) Then
AutonIncRegs = (AutonIncRegs + 1)
R.NumTicket = AutonIncRegs
End If
'
If (Index = -1) Then
NumRegistros = (NumRegistros + 1)
Index = NumRegistros
End If
Call PosicionarRegistro(Index)
Put #Canal, , R ' Guarda el registro
Put #Canal, 1, NumRegistros ' Guarda la cantidad de registros
Put #Canal, , AutonIncRegs ' Guarda el valor de autoincrmeento (es un valor único).
End Sub
Private Function CrearNuevaFacturacion(ByRef NombreFile As String) As Boolean
Dim Ruta As String
Ruta = App.Path & "\" & NombreFile
If (Abrir(Ruta, True) = True) Then
NumRegistros = 0: AutonIncRegs = 0
Put #Canal, 1, NumRegistros ' Guarda la cantidad de registros
Put #Canal, , AutonIncRegs ' Guarda el valor de autoincrmeento (es un valor único).
CrearNuevaFacturacion = True
Else
MsgBox "Parece que el fichero que intenta abrir ya existe, elija otro nombre (o bien ocurrió un error)..."
End If
End Function
' Numreg: Permite seguir buscando más artículos a partir del previo que se encontró...
Private Function BuscarArticulo(ByRef Producto As String, Optional ByRef NumReg As Long = 0) As Boolean
Dim k As Long, ptr As Long, inc As Long, Articulo As String * 12
If (NumReg < NumRegistros) Then
NumReg = (NumReg + 1)
If (NumReg > 1) Then
Call PosicionarRegistro(NumReg)
ptr = Seek(Canal) + 12
Else
ptr = (DIR_COMIENZO_REGS + 12) ' Dir de comienzo de registros + desplazamiento al campo soliicitado.
End If
Producto = LCase(Producto)
inc = LenB(reg1)
For k = NumReg To NumRegistros
Get #Canal, ptr, Articulo
If (LCase$(Articulo) = Producto) Then
Get #Canal, ptr - 12, reg1
BuscarArticulo = True
Exit For
End If
ptr = (ptr + inc)
Next
NumReg = k
End If
End Function
' En cada fichero cada compra tiene un numero de ticket único (no hay dos repetidos, como si puede pasar con el nombre del artículo).
Private Function BuscarTicket(ByVal Ticket As Long) As Boolean
Dim k As Long, ptr As Long, inc As Long, nTicket As Long
ptr = DIR_COMIENZO_REGS ' Dir de comienzo de registros + desplazamiento al campo soliicitado=0.
inc = LenB(reg1)
For k = 1 To NumRegistros
Get #Canal, ptr, nTicket
If (LCase$(nTicket) = Ticket) Then
Get #Canal, ptr, reg1
BuscarTicket= True
Exit For
End If
ptr = (ptr + inc)
Next
End Function
Yo elegiría un control flexgrid en vez de un listbox, que ya tiene sus columnas y tal, pero es más complejo de manejar para empezar...
Nota que la interfaz de momento la dejo así, solo para que puedas captar todos los detalles que contiene. En realidad cosas como los textbox deben ir a una ventana aparte donde se editen o creen... pero así no te hago esperar si ves todo lo que contiene e intentas por tí mismo completarlo.
corlo:
Hola Serapis
gracias por el codigo
tengo unas dudas sobre el codigo
combuscar para buscar funcion buscararticulo como seria
comeditarregistro no encuentro la funcion
comretirarregistro no encuentro la funcion
tengo un error en el optionbuton1 optionbuton2 me da un error en la funcion:
El miembro ya existe en un módulo de objeto con los controladores de este módulo de objeto
en los dos optionbuton le pongo en el nombre getmetodopago y me pone el error
gracias
Navegación
[#] Página Siguiente