' a nivel de formulario proveemos la siguiente variables:
public type InfoDatos
Ruta as string
Nombre as string
ImgIndex as long
end type
const Config= "Config.ini"
public ImgSalva as infoDatos
' carga el fichero que tiene la configuración del programa, si no existe se crea
Private Sub Form_Load()
Dim f As Integer
Dim fichero As String
On Local Error GoTo errorAbrirConfig
fichero = App.Path & "" & Config
f = FreeFile
' abrimos el archivo config
Open fichero For Binary As #f
' leemos los datos del config
Get #f, 1, ImgSalva
' aseguramos que tiene valores válidos
Call Verificar_ValoresCorrectos
' por si corregimos valores no válidos los volvemos a guardar
Put #f, 1, ImgSalva
' cerramos el archivo
Close f
' verter los valores de la estructura a unos controles en el formulario, la ruta sería mejor ponerla en dirbox y drive y el nombre en un textbox y el index en un label o textbox....
' TxtIndex.Text = ImgSalva.ImgIndex
' TxtRuta.Text = ImgSalva.Ruta
' TxtNombre.Text = ImgSalva.Nombre
Exit Sub
errorAbrirConfig:
Close f
Call Guardar_Config
MsgBox "Ocurrió un problema al tratar de guardar el archivo config (la ruta es accesible?, de sololectura ?)" & Err.Description, vbCritical, "Error de lectura"
End ' si no tenemos los datos adecuados finalizamos el programa.
End Sub
' guardamos la configuración actual antes de salir
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Guardar_Config
End Sub
' botón guardar imagen/es de la cámara, si se precisa se podría poner un bucle iterativo que recorriera todas las imágenes que tenga el 'buffer' de la cámara...
Private Sub Command1_Click()
Dim k As Long
' es posible que exista una propiedad count quepueda usarse en un bucle, estos detalles son específicos y hay que referirse a la documentación del control
' for k= 0 to SapAcquisition1.Buffer.count
If Salvar_Imagen(ImgSalva.Ruta, ImgSalva.Nombre, ImgSalva.ImgIndex) = False Then
Beep ' ... código adicional cuando falló
Else
'... código adicional cuando todo fue bien
End If
' si hay una propiedad count, es posible que deba apuntarse a la siguiente imagen, tal vez un SapAcquisition1.Buffer.next
' o tal vez SapAcquisition1.Buffer.Select(k)
' o tal vez sea uno de los parçametros de la propia función salvar: SapAcquisition1.Buffer.save(,,,,K), en este caso debería pasarse también el parámetro k a la función.
' next
End Sub
' intenta guardar una imagen, procedente de un buffer en la cámara a un archivo en la ruta especificada en el formato indicado.
Private Function Salvar_Imagen(ByVal Ruta As String, ByVal Nombre As String, ByRef UltimoIndex As Long, Optional Formato As SapAcquisitionFormts = SAP_FORMAT_JPG) As Boolean
Dim FileName As String
On Local Error GoTo ErrorGuardar
FileName = Ruta & "" & Nombre & (UltimoIndex + 1) & CorresponderExtension(Formato)
' para pruebas con y sin dicho control, activar una línea y desactivar la otra
Salvar_Imagen = SapAcquisition1.Buffer.Save(FileName,Formato,0,1)
'Salvar_Imagen = True ' False
If Salvar_Imagen = True Then
UltimoIndex = UltimoIndex + 1 ' el parámetro se pasó por referencia, por tanto se actualiza...
End If
ErrorGuardar:
End Function
' dado un formato se devuelve la extensión que le corresponde...
Private Function CorresponderExtension(ByVal Formato As SapAcquisitionFormts) As String
Dim ext As String
Select Case Formato
Case SAP_FORMAT_JPG
ext = ".JPG"
Case SAP_FORMAT_BMP
ext = ".BMP"
Case SAP_FORMAT_PNG
ext = ".PNG"
Case SAP_FORMAT_GIF
ext = ".GIF"
Case Else
ext = ".Imagen_formato_no_determinado"
End Select
CorresponderExtension = ext
End Function
' guardamos la configuración actual
Private Sub Guardar_Config()
Dim f As Integer
Dim fichero As String
On Local Error GoTo errorAbrirConfig
fichero = App.Path & "" & Config
f = FreeFile
Call Verificar_ValoresCorrectos
' abrimos el archivo config
Open fichero For Binary As #f
' guardamos configuración actual
Put #f, 1, ImgSalva
' cerramos el archivo
Close f
Exit Sub
errorAbrirConfig:
Close f
MsgBox "Ocurrió un problema al tratar de guardar el archivo config (la ruta es accesible?, de sololectura ?)" & vbCrLf & Err.Description
End Sub
' sin embargo esto no restituye estos mismos datos a los controles ya queda como trabajo para ti...
Private Sub Verificar_ValoresCorrectos()
If ImgSalva.Ruta = "" Then ImgSalva.Ruta = App.Path
If ImgSalva.Nombre = "" Then ImgSalva.Nombre = "Prueba"
If ImgSalva.ImgIndex < 1 Then ImgSalva.ImgIndex = 1
End Sub