Téléchargement: |
Chargement
d'images depuis une base de données |
Le problème de
l'archivage d'images dans des bases de données est connu.
Avec VB, il existe 2 façons de placer des images dans une BD et 3 façons de
les récupérer pour les afficher dans un PictureBox.
Dans le sens Fichier image (bmp, jpg, gif, wmf, emf, ...) --> Base de données :
Dans le sens Base de données --> PictureBox :
Préliminaire : |
Le projet
présenté comporte une base de données Access 97 avec une table "IMAGES"
qui contient à son tour le champ "BLOB" de type
ObjetOLE, c'est-à-dire binaire. Les 4 enregistrements contiennent des images de
type WMF (métafile), BMP, JPG et GIF.
Ce projet ne gère pas l'écriture des images dans la base de données, se
référer au besoin aux divers exemples d'utilisation de AppendChunk
abondants sur le web.
Le chargement de l'image dans le PictureBox se fait en 3 opérations :
La 3ème
opération nécessite l'implémentation de l'interface IStream
qui n'est pas disponible par défaut sous VB. C'est pourquoi il est nécessaire
de charger la librairie ISTRM.TLB (ou
bibliothèque de type). Cette librairie a été écrite par Eduardo Morcillo
(http://www.domaindlx.com/e_morcillo)
pour son projet CJPGRes dont je me suis
inspiré (Le projet d'Eduardo permet de charger des images JPG et GIF
depuis les ressources sans passer par l'intermédiaire d'un fichier temporaire).
Le chargement de cette librairie se fait en cliquant sur Projet
--> Références et en ajoutant le fichier ISTRM.TLB
à la liste. Ce fichier n'est nécessaire que lors de la compilation, il ne doit
pas être distribué avec l'exécutable.
Cette implémentation se fait grâce à l'instruction Implements dans le module
de classe ResPicture
Mentionnons qu'il n'est pas nécessaire de comprendre le code de ce module de
classe et l'interface IStream pour l'utiliser (remarquer la simplicité du code
de la feuille seule).
Le projet s'appelle DBImage. Il est composéRappel : (extrait de l'aide de VB5) :
Implements : Spécifie une interface ou une classe qui sera implémentée dans le module de classe dans lequel il apparaît.
Syntaxe : Implements [InterfaceName]
L'argument InterfaceName requis est le nom d'une interface dans une bibliothèque de types dont les méthodes seront implémentées par les méthodes correspondantes dans la classe Visual Basic.
Remarques
Une interface est une collection de prototypes représentant les membres (méthodes et propriétés) que l'interface encapsule, c'est-à-dire qu'elle ne contient que la déclarations des procédures membres.
Lorsque vous implémentez une interface ou une classe, vous devez inclure toutes les procédures Public impliquées.
L'instruction Implements ne peut apparaître dans un module standard.
Code de la feuille |
Option Explicit
Dim dbs As Database, RST As Recordset
Private Sub Form_Load()
' Ouverture de
la base de données et création du Recordset
Set dbs = DBEngine.OpenDatabase(App.Path & "\IMAGES.MDB", False, False, "")
strSQL = "SELECT * FROM Images ;"
Set RST = dbs.OpenRecordset(strSQL,
dbOpenSnapshot)
End Sub
Private Sub cmdLoadImage_Click()
' Chargement de
l'image
If Not (RST.EOF Or RST.BOF) Then ctlImage.Picture =
LoadPictureFromDB(RST, "BLOB")
End Sub
Private Function LoadPictureFromDB(RST As Recordset, strField As String) As StdPicture
' Cette fonction permet le chargement d'une image
' - depuis une base de données
' - vers un contrôle PictureBox ou Image
' RST : Recordset contenant l'enregistrement qui nous intéresse
' strField : Nom du champ contenant l'image
Dim ResPict As New ResPicture
'(création d'une instance du module de classe)
With ResPict
' On récupère les données binaires
.WriteBLOB RST, strField
' On ajoute les 8 octets en en-tête
.PrefixPic
' On charge l'image dans LoadPicture
Set LoadPictureFromDB = .LoadPic
End With
Set ResPict = Nothing
End Function
Private Sub cmdMoveRecord_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 0 '(On avance d'un enregistrement)
If Not RST.BOF Then
RST.MovePrevious
If Not RST.BOF Then cmdLoadImage_Click
End If
Case 1 '(On recule d'un enregistrement)
If Not RST.EOF Then
RST.MoveNext
If Not RST.EOF Then cmdLoadImage_Click
End If
End Select
On Error GoTo 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
' On doit fermer les objets
RST.Close
dbs.Close
End Sub
Le module de classe ResPicture |
Option Explicit
Implements IStream
Const BlockSize = 32768
Dim m_Pict() As Byte
' Données du Stream
Dim m_StreamPos As Long ' Position courante du
Stream
Public Function LoadPic() As StdPicture
' Cette procédure convertit la variable binaire m_Pict
' en StdPicture, c'est-à-dire en image pouvant être chargée dans un PictureBox
Dim hRsrc As Long, hGbl As Long
Dim IPS As IPersistStream
Set LoadPic = New StdPicture ' On crée
un nouvel objet StdPicture
Set IPS = LoadPic
' ... et on obtient son interface IPersistStream
' On appelle la méthode Load de IPersistStream
en passant Me comme argument pour IStream.
On Error Resume Next
'(Erreur si les
données binaires ne correspondent pas à une image valide)
IPS.Load Me
'(Ce qui va déclencher plusieurs fois les événements Read et Seek)
If Err Then MsgBox Err.Description
On Error GoTo 0
Erase m_Pict '(libération de la
mémoire)
End Function
Public Function PrefixPic()
' Cette procédure ajoute un préfixe de 8 octets aux données binaires de l'image
' Nécessaire si on a chargé l'image dans la BD avec AppendChunk
' Non nécessaire si on a chargé l'image par un copier-coller
' dans un PictureBox lié avec un Control Data.
' Mais même dans ce cas, ça ne fait rien si le préfixe est écrit 2 fois.
Dim ResLen As Long
' On doit redimensionner la variable
pour lui ajouter 8 octets supplémentaires
ResLen = UBound(m_Pict)
ReDim Preserve m_Pict(0 To ResLen + 8) As Byte
' On déplace les données 8 octets
plus loin
MoveMemory m_Pict(8), m_Pict(0), ResLen
' On copie la taille de la variable
m_Pict dans le 5ème octet
MoveMemory m_Pict(4), ResLen, 4
' On écrit les 4 premiers octets du
préfixe
m_Pict(0) = &H6C
m_Pict(1) = &H74
m_Pict(2) = 0
m_Pict(3) = 0
End Function
Public Function WriteBLOB(RST As Recordset, sField As String) As Long
' Cette procédure récupère les données binaires depuis la base de données
' et remplit la variable binaire m_Pict
' Comme ces données peuvent être volumineuses,
' on effectue ce remplissage par petits paquets de 32 Ko (FileDataB)
' - RST : c'est le Recordset d'intérêt
' - sField : c'est le nom du champ contenant les données de l'image
' Retourne le nombre d'octets
écrits
Dim NumBlocks As Integer, I As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileDataB() As Byte
On Error GoTo Err_WriteBLOB
' On obtient la taille du champ
FileLength = RST(sField).FieldSize()
If FileLength = 0 Then
WriteBLOB = 0
Exit Function
End If
' On
calcule le nombre de blocs à écrire (NumBlocks), et aussi le reste de la
division (LeftOver)
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
ReDim m_Pict(0 To FileLength)
' On commence par écrire LeftOver dans
la variable binaire FileDataB
ReDim FileDataB(LeftOver)
FileDataB = RST(sField).GetChunk(0, LeftOver)
' Et on transfère dans m_Pict
MoveMemory m_Pict(0), FileDataB(0), LeftOver
' On copie morceau par morceau dans la
variable binaire FileDataB
ReDim FileDataB(BlockSize)
For I = 1 To NumBlocks
FileDataB = RST(sField).GetChunk((I - 1) * BlockSize + LeftOver,
BlockSize)
'
Et on transfère dans m_Pict
MoveMemory m_Pict((I - 1) * BlockSize + LeftOver), FileDataB(0), BlockSize
Next I
WriteBLOB = FileLength
Erase FileDataB
Exit Function
Err_WriteBLOB:
WriteBLOB = -Err
MsgBox Err.Description
End Function
' Les événements implémentés sont : Read
et Seek et se produisent de multiples fois au fur et à mesure du
chargement de l'objet StdPicture.
Private Sub IStream_Read(ByVal pv As Long, ByVal cb As Long, ByVal pcbRead As Long)
' Dim m_StreamPos As Long ' Current stream position
' cb : taille de la lecture (en bytes)
' pcbRead : taille de la lecture réellement effectuée
' On vérifie si on ne dépasse pas la taille de m_Pict
If (m_StreamPos + cb) > UBound(m_Pict) Then cb = UBound(m_Pict) - m_StreamPos
' On copie la donnée dans la mémoire
de pointeur py
MoveMemory ByVal pv, m_Pict(m_StreamPos), cb
' On déplace la position du stream
m_StreamPos = m_StreamPos + cb
' On vérifie si pcbRead n'est pas NULL
et on copie le nombre d'octets lus
If pcbRead Then MoveMemory ByVal pcbRead, cb, 4
End Sub
Private Sub IStream_Seek(ByVal dlibMove As Currency, ByVal dwOrigin As STREAM_SEEK, ByVal plibNewPosition As Long)
' On vérifie dwOrgin et on définit la
position selon les cas
Select Case dwOrigin
Case STREAM_SEEK_SET
m_StreamPos = dlibMove
Case STREAM_SEEK_CUR
m_StreamPos = m_StreamPos + dlibMove
Case STREAM_SEEK_END
m_StreamPos = UBound(m_Pict) - dlibMove
End Select
' On copie la nouvelle position si plibNewPosition
n'est pas NULL
If plibNewPosition Then MoveMemory ByVal plibNewPosition,
CCur(m_StreamPos), 8
End Sub