Trucos Meter fotos en una base de datos sin DataControl

Extraído del web del Guille (http://guille.costasol.net), no dejes de visitarlo.

Tenemos un recordset llamado MiRecordSet con un campo tipo OLE llamado MiCampo y un picture box llamado Picture1.

Para leer la imagen y mostrarla en el picture :

LeerBinary MiRecordSet!MiCampo, Picture1

Para guardar la imagen del picture en el campo :

GuardarBinary MiRecordSet!MiCampo, Picture1

Las funciones son :

'------------------------------------------------------------------
'Código para grabar y leer imagenes en campos de bases ( 9/Abr/98)'
'Adaptado de un par de ejemplos de la ayuda de VB5'
'©Guillermo 'guille' Som, 1998 <guille@costasol.net>
'------------------------------------------------------------------
Option Explicit
Dim DataFile As Integer
Dim Chunk() As Byte
Const conChunkSize As Integer = 16384

Public Sub LeerBinary(campoBinary As Field, unPicture As PictureBox)
    'Leer la imagen del campo de la base y asignarlo al Picture
    Dim lngCompensación As Long
    Dim lngTamañoTotal As Long
    'Se usa un fichero temporal para guardar la imagen
    DataFile = FreeFile
    Open "pictemp" For Binary Access Write As DataFile
    lngTamañoTotal = campoBinary.FieldSize
    Do While lngCompensación < lngTamañoTotal
        Chunk() = campoBinary.GetChunk(lngCompensación, conChunkSize)
        Put DataFile, , Chunk()
        lngCompensación = lngCompensación + conChunkSize
    Loop
    Close DataFile
    'Ahora se carga esa imagen en el control
    unPicture.Picture = LoadPicture("pictemp")
    'Ya no necesitamos el fichero, así que borrarlo
    On Local Error Resume Next
    If Len(Dir$("pictemp")) Then
        Kill "pictemp"
    End If
    Err = 0
End Sub

Public Sub GuardarBinary(campoBinary As Field, unPicture As PictureBox)
    'Guardar el contenido del Picture en el campo de la base
    Dim i As Integer
    Dim Fragment As Integer, Fl As Long, Chunks As Integer
    'NOTA:
    ' El recordset debe estar preparado para Editar o Añadir
    'Guardar el contenido del picture en un fichero temporal
    SavePicture unPicture.Picture, "pictemp"
    'Leer el fichero y guardarlo en el campo
    DataFile = FreeFile
    Open "pictemp" For Binary Access Read As DataFile
    Fl = LOF(DataFile) ' Longitud de los datos en el archivo
    If Fl = 0 Then Close DataFile: Exit Sub
    Chunks = Fl \ conChunkSize
    Fragment = Fl Mod conChunkSize
    ReDim Chunk(Fragment)
    Get DataFile, , Chunk()
    campoBinary.AppendChunk Chunk()
    ReDim Chunk(conChunkSize)
    For i = 1 To Chunks
        Get DataFile, , Chunk()
        campoBinary.AppendChunk Chunk()
    Next i
    Close DataFile
    'Ya no necesitamos el fichero, así que borrarlo
    On Local Error Resume Next
    If Len(Dir$("pictemp")) Then
        Kill "pictemp"
    End If
    Err = 0
End Sub



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com