A pesar de que me suelo quejar de las consultas, algunas veces me sirven para "indagar" en cosillas que no he probado y al final resulta que hasta se agradecen, (que no sirva este comentario para que me lleneis el buzón con consultas... ¿vale?)
Este es el caso del colega y colaborador Jose Montaner 'Satelite', que me mandó una consulta sobre cómo mostrar una imagen que está en una base de datos, pero sin usar el data control, ya que con ese control y un Picture enlazado al campo de la imagen, no tiene ningún misterio, ya que el propio DataControl se encarga del trabajo sucio.
Pues investigando y buscando... encontré la solución... ¿dónde? En el sitio que casi nadie busca: la propia ayuda del Visual Basic; aunque estaba algo "dispersa" esa información, tomando un cachillo de aquí y otro de allá... salió esto.
Los procedimientos que se encargan de mostrar el contenido de un campo de la base de datos en un control Picture y la operación inversa, es decir guardar en la base de datos lo que se muestre en el control Picture, los he puesto en un módulo bas, 'Satelite' me envió después esas funciones en un módulo de clase, pero para no complicarnos el tema, vamos a verlo en un módulo bas.
Los listados aquí mostrados son sólo los de dicho módulo, pero en el ejemplo que se acompaña, hay una pequeña aplicación que te permite moverte en una base de datos, añadir nuevos registros y modificar los existentes... y todo ello sin usar el data control, para los que quieran ver el mismo código usando el DataControl, también se acompaña un ejemplo.
Este es el código a usar para leer de la base de datos y mostrar la imagen en el PictureBox:
'rContactos es el Recordset del que se tomarán los datos 'El campo FOTOS será del tipo "Objeto OLE" LeerBinary rContactos!FOTO, Picture1
Y este otro es el que habría que usar para guardar en la base de datos el contenido del Picture:
' GuardarBinary rContactos!FOTO, Picture1Simple, ¿verdad?
Pues aquí están las rutinas "culpables" de esa simplicidad:'------------------------------------------------------------------ '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 <[email protected]> '------------------------------------------------------------------ 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 SubUna foto del form de prueba:
Los listados de los ejemplos:
Este es el código usado para añadir nuevos registros, actualizar (modificar el actual) y cargar la imagen (cualquier tipo soportado por el VB, en este caso el VB5)
'Los tres botones forman parte de un array Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 'Addnew rContactos.AddNew Text1(0) = "" Text1(1) = "" Picture1.Picture = LoadPicture() Case 1 'Carga Bmp CommonDialog1.ShowOpen If CommonDialog1.filename <> "" Then Picture1.Picture = LoadPicture(CommonDialog1.filename) End If Case 2 'Update '$Guille 'Esto es para el caso de que se pulse en Update, 'sin que se haya dado a AddNew If rContactos.EditMode = dbEditNone Then rContactos.Edit End If rContactos!ID = Text1(0) rContactos!NOMBRE = Text1(1) '* * * * * * * * * * * * * * * * '* AQUI TENGO UN PROBLEMA * '* * * * * * * * * * * * * * * * ' ' ¿Como transfiero la imagen desde el ' control Picture1 al campo FOTO del ' recordset rContactos? ' 'rContactos!FOTO = Picture1.Picture ' '$Guille GuardarBinary rContactos!FOTO, Picture1 rContactos.Update End Select End SubY este trozo de código es para "navegar" entre los distintos registros:
'Estos 4 botones también forman parte de un array Private Sub cmdMover_Click(Index As Integer) Select Case Index Case 0 'Primero rContactos.MoveFirst Case 1 'Siguiente '$Guille 'Si no estamos al final... If Not rContactos.EOF Then '...pasar al siguiente registro rContactos.MoveNext End If Case 2 'Anterior '$Guille 'Si no estamos al principio... If Not rContactos.BOF Then '...pasar al registro anterior rContactos.MovePrevious End If Case 3 'Último rContactos.MoveLast End Select If (Not rContactos.EOF) And (Not rContactos.BOF) Then Text1(0) = rContactos!ID Text1(1) = rContactos!NOMBRE '* * * * * * * * * * * * * * * * '* AQUI TENGO UN PROBLEMA * '* * * * * * * * * * * * * * * * ' ' ¿Como transfiero la imagen desde el ' campo FOTO del recordset rContactos ' al control Picture1? 'Picture1.Picture=rContactos!FOTO 'Picture1.Cls 'Picture1.Print "<Falta cargar la imágne>" ' '$Guille LeerBinary rContactos!FOTO, Picture1 End If End SubLos listados en formato ZIP:
El código SIN usar el DataControl, en este ZIP está la base de ejemplo (sinDataCtrl.zip 18.7 KB)
El código usando el DataControl, (conDataCtrl.zip 1.96 KB)Nota:
El código original, es un ejemplo de Jose Montaner 'Satelite', que me envió para "mostrar" dónde estaba el problemilla que tenía, yo sólo lo he "maquillado" un poco...