Je cherche le moyen d'afficher un fichier *.tif dans une page de VB
Avec les contrôles Image et PictureBox, on affiche très bien les fichiers
*.bmp, *.jpg et *.gif
mais avec les images *.tif l'ordinateur me renvoie le message "Image
incorrecte dans la procédure suivante:
=====================================================================
Public Sub AFFICHERADIO(TextCheminImage As String)
Une précision concernant XnView, vous pouvez soit utiliser l'activeX soit utiliser directement les fonctions de la SDK. Si vous la téléchargez des exemples VB sont fournis avec, pour la petite histoire il y a deux fonctions de mon cru dans les modules publiques des exemples.
Peux tu donner plus de détails ? Driss Hanib a évoqué cette piste au début du fil
-- Cordialement,
Jacques.
Bonjour touriste,
touriste a écrit :
Bonjour,
Une précision concernant XnView, vous pouvez soit utiliser l'activeX
soit utiliser directement les fonctions de la SDK. Si vous la
téléchargez des exemples VB sont fournis avec, pour la petite histoire
il y a deux fonctions de mon cru dans les modules publiques des exemples.
Peux tu donner plus de détails ?
Driss Hanib a évoqué cette piste au début du fil
Une précision concernant XnView, vous pouvez soit utiliser l'activeX soit utiliser directement les fonctions de la SDK. Si vous la téléchargez des exemples VB sont fournis avec, pour la petite histoire il y a deux fonctions de mon cru dans les modules publiques des exemples.
Peux tu donner plus de détails ? Driss Hanib a évoqué cette piste au début du fil
Indique que l'on peut utiliser GFLax : l'activeX là je n'ai rien à dire je ne l'utilise jamais.
Soit la SDK, elle permet de récupérer un DIB formaté Windows (aligné sur 32 bits), donc implique l'utilisation de qqs API. Si vous installez la GFL SDK, vous trouverez dans le répertoire où elle s'installe un fichier d'aide et des exemples VB6.
Dans un projet VB6 il faut intégrer en tant que modules publiques 6 modules comprenant la déclaration des structures et fonctions de la Dll exemple:
'Structure BITMAP Public Type GFL_BITMAP Type As Integer Origin As Integer Width As Long Height As Long BytesPerLine As Long LinePadding As Integer BitsPerComponent As Integer ComponentsPerPixel As Integer BytesPerPixel As Integer Xdpi As Integer Ydpi As Integer TransparentIndex As Integer ColorUsed As Long ColorMap As Long Data As Long Comment As Long MetaData As Long End Type
Public Declare Function gflLoadBitmap Lib "libgfl220.dll" (ByVal filename As String, ByRef BITMAP As Long, ByRef params As GFL_LOAD_PARAMS, ByRef info As GFL_FILE_INFORMATION) As Integer
On peut ensuite utiliser ces fonctions, un exemple pour charger un fichier tif. Fonction située au niveau du module de classe MyDIB
Public Function ChargeImage() Dim GflParams As GFL_LOAD_PARAMS Dim PtrBitmap As Long Dim GflInfo As GFL_FILE_INFORMATION Dim File As String Dim Error As Integer
gflLibraryInit gflGetDefaultLoadParams GflParams
With GflParams .Flags = GFL_LOAD_SKIP_ALPHA Or GFL_LOAD_BY_EXTENSION_ONLY .Origin = GFL_BOTTOM_LEFT .ColorModel = GFL_BGR 'Component order like DIB .LinePadding = 4 'Line padding on 4 bytes (32bits) End With
extGetGflBitmapFromPtr PtrBitmap, mGflBitmap mDIBinfo = extGetDIBFromBitmap(mGflBitmap) Else ErreurLecture = True End If
gflLibraryExit
SetEspaceBitmap
End Function
Qui utilise deux fonctions déclarées au niveau des modules publiques: Une écrite par l'auteur de l'interface VB.
Public Sub extGetGflBitmapFromPtr(ByVal src As Long, ByRef dest As GFL_BITMAP) gflFreeBitmapData dest 'On supprime les data de notre image CopyMemory VarPtr(dest), src, Len(dest) 'On copie les datas du bitmap temporaire dans notre bitmap gflMemoryFree src 'On supprime le bitmap temporaire de la mémoire End Sub
Une autre modifiée par mes soins:
Public Function extGetDIBFromBitmap(ByRef BITMAP As GFL_BITMAP) As BITMAPINFO Dim DIBInfo As BITMAPINFO Dim ColorMap As GFL_COLORMAP Dim Ind As Integer
With DIBInfo.bmiHeader .biSize = Len(DIBInfo.bmiHeader) 'La taille de la structure .biWidth = BITMAP.Width 'Largeur du bitmap .biHeight = BITMAP.Height 'Hauteur du bitmap .biPlanes = 1 'Nombre de plans .biCompression = BI_RGB 'Toujours BI_RGB .biClrImportant = 0 'Toujours 0
If BITMAP.Xdpi = BITMAP.Ydpi Then If BITMAP.Xdpi <> 0 Then
Select Case BITMAP.Type 'Suivant le type de bitmap Case GFL_COLORS 'Si GFL_COLORS (une palette de couleurs indexé de 0 à 255) extGetGflColorMapFromPtr BITMAP.ColorMap, ColorMap 'On récupère les index du bitmap dans une structure GflColorMap For Ind = 0 To 255 'Pour chaque index on indique à la structure Dib_Info .bmiColors(Ind).rgbBlue = ColorMap.Blue(Ind) 'La valeur du bleu .bmiColors(Ind).rgbGreen = ColorMap.Green(Ind) 'La valeur du vert .bmiColors(Ind).rgbRed = ColorMap.Red(Ind) 'La valeur du rouge Next Ind Case GFL_BINARY 'Si GFL_BINARY (seulement noir et blanc donc 2 couleurs indexés) on indique à Dib_Info qu'il y a deux index .bmiColors(0).rgbBlue = 0: .bmiColors(0).rgbGreen = 0: .bmiColors(0).rgbRed = 0 'Le premier vaut Red=0,Green=0,Blue=0 donc du noir (#000000) .bmiColors(1).rgbBlue = 255: .bmiColors(1).rgbGreen = 255: .bmiColors(1).rgbRed = 255 'Le second vaut Red%5,Green%5,Blue%5 donc blanc (#FFFFFF) Case GFL_GREY 'Si GFL_GREY (On travaille sur 256 nuances) For Ind = 0 To 255 'Pour chaque index de Dib_Info on indique une nuance de gris .bmiColors(Ind).rgbBlue = Ind ' Il y a 256 index et 256 gris on donne à chaque index .bmiColors(Ind).rgbGreen = Ind ' et pour chaque canaux la valeur de la nuance .bmiColors(Ind).rgbRed = Ind Next Ind End Select End With extGetDIBFromBitmap = DIBInfo End Function
Pour afficher le tif, metricDC étant une classe gérant un pictureBox et son DC en mode High_Metric:
Public Function afficheimage(mdc As metricDC) Dim dummy& Dim OldMode& Dim PS As Double Dim OriginalColor As RGBQUAD Dim h As RealRegion
If ErreurLecture Then With mEspacebitmap mdc.CadreReal .Left, .Bottom, .Right, .Top, RGB(255, 0, 0) mdc.writetext "Erreur de lecture Image", (.Right - .Left) / 2 + .Left, (.Top - .Bottom) / 2 + .Bottom, mEchelle / 25, 2, 0, True End With Exit Function End If
'corrige la zone bitmap (modif de xpix) dummy& = GetzoneDIB(mdc) 'couleur d'origine mDIBinfo.bmiColors(0).rgbBlue = OriginalColor.rgbBlue mDIBinfo.bmiColors(0).rgbGreen = OriginalColor.rgbGreen mDIBinfo.bmiColors(0).rgbRed = OriginalColor.rgbRed
If dummy& <> -1 Then
Select Case mDIBinfo.bmiHeader.biBitCount
Case 1 OldMode& = SetStretchBltMode(mdc.hdc, STRETCH_ANDSCANS) Case Else OldMode& = SetStretchBltMode(mdc.hdc, STRETCH_DELETESCANS) End Select
OldMode& = SetStretchBltMode(mdc.hdc, OldMode&) End If
End Function
Voili voilà en tout cas cette lib est très puissante et efficace avec de nombreuses fonctions. Elle demande comme tout, un peu de temps et d'aspirine, mais ça vaut le coup!
Indique que l'on peut utiliser GFLax : l'activeX là je n'ai rien à dire
je ne l'utilise jamais.
Soit la SDK, elle permet de récupérer un DIB formaté Windows (aligné sur
32 bits), donc implique l'utilisation de qqs API. Si vous installez la
GFL SDK, vous trouverez dans le répertoire où elle s'installe un fichier
d'aide et des exemples VB6.
Dans un projet VB6 il faut intégrer en tant que modules publiques 6
modules comprenant la déclaration des structures et fonctions de la Dll
exemple:
'Structure BITMAP
Public Type GFL_BITMAP
Type As Integer
Origin As Integer
Width As Long
Height As Long
BytesPerLine As Long
LinePadding As Integer
BitsPerComponent As Integer
ComponentsPerPixel As Integer
BytesPerPixel As Integer
Xdpi As Integer
Ydpi As Integer
TransparentIndex As Integer
ColorUsed As Long
ColorMap As Long
Data As Long
Comment As Long
MetaData As Long
End Type
Public Declare Function gflLoadBitmap Lib "libgfl220.dll" (ByVal
filename As String, ByRef BITMAP As Long, ByRef params As
GFL_LOAD_PARAMS, ByRef info As GFL_FILE_INFORMATION) As Integer
On peut ensuite utiliser ces fonctions, un exemple pour charger un
fichier tif. Fonction située au niveau du module de classe MyDIB
Public Function ChargeImage()
Dim GflParams As GFL_LOAD_PARAMS
Dim PtrBitmap As Long
Dim GflInfo As GFL_FILE_INFORMATION
Dim File As String
Dim Error As Integer
gflLibraryInit
gflGetDefaultLoadParams GflParams
With GflParams
.Flags = GFL_LOAD_SKIP_ALPHA Or GFL_LOAD_BY_EXTENSION_ONLY
.Origin = GFL_BOTTOM_LEFT
.ColorModel = GFL_BGR 'Component order like DIB
.LinePadding = 4 'Line padding on 4 bytes (32bits)
End With
extGetGflBitmapFromPtr PtrBitmap, mGflBitmap
mDIBinfo = extGetDIBFromBitmap(mGflBitmap)
Else
ErreurLecture = True
End If
gflLibraryExit
SetEspaceBitmap
End Function
Qui utilise deux fonctions déclarées au niveau des modules publiques:
Une écrite par l'auteur de l'interface VB.
Public Sub extGetGflBitmapFromPtr(ByVal src As Long, ByRef dest As
GFL_BITMAP)
gflFreeBitmapData dest 'On supprime les data de notre image
CopyMemory VarPtr(dest), src, Len(dest) 'On copie les datas du
bitmap temporaire dans notre bitmap
gflMemoryFree src 'On supprime le bitmap temporaire de la mémoire
End Sub
Une autre modifiée par mes soins:
Public Function extGetDIBFromBitmap(ByRef BITMAP As GFL_BITMAP) As
BITMAPINFO
Dim DIBInfo As BITMAPINFO
Dim ColorMap As GFL_COLORMAP
Dim Ind As Integer
With DIBInfo.bmiHeader
.biSize = Len(DIBInfo.bmiHeader) 'La taille de la structure
.biWidth = BITMAP.Width 'Largeur du bitmap
.biHeight = BITMAP.Height 'Hauteur du bitmap
.biPlanes = 1 'Nombre de plans
.biCompression = BI_RGB 'Toujours BI_RGB
.biClrImportant = 0 'Toujours 0
If BITMAP.Xdpi = BITMAP.Ydpi Then
If BITMAP.Xdpi <> 0 Then
Select Case BITMAP.Type 'Suivant le type de bitmap
Case GFL_COLORS 'Si GFL_COLORS (une palette de couleurs indexé
de 0 à 255)
extGetGflColorMapFromPtr BITMAP.ColorMap, ColorMap 'On
récupère les index du bitmap dans une structure GflColorMap
For Ind = 0 To 255 'Pour chaque index on indique à la
structure Dib_Info
.bmiColors(Ind).rgbBlue = ColorMap.Blue(Ind) 'La valeur
du bleu
.bmiColors(Ind).rgbGreen = ColorMap.Green(Ind) 'La
valeur du vert
.bmiColors(Ind).rgbRed = ColorMap.Red(Ind) 'La valeur
du rouge
Next Ind
Case GFL_BINARY 'Si GFL_BINARY (seulement noir et blanc donc 2
couleurs indexés) on indique à Dib_Info qu'il y a deux index
.bmiColors(0).rgbBlue = 0: .bmiColors(0).rgbGreen = 0:
.bmiColors(0).rgbRed = 0 'Le premier vaut Red=0,Green=0,Blue=0 donc du
noir (#000000)
.bmiColors(1).rgbBlue = 255: .bmiColors(1).rgbGreen = 255:
.bmiColors(1).rgbRed = 255 'Le second vaut Red%5,Green%5,Blue%5
donc blanc (#FFFFFF)
Case GFL_GREY 'Si GFL_GREY (On travaille sur 256 nuances)
For Ind = 0 To 255 'Pour chaque index de Dib_Info on
indique une nuance de gris
.bmiColors(Ind).rgbBlue = Ind ' Il y a 256 index et
256 gris on donne à chaque index
.bmiColors(Ind).rgbGreen = Ind ' et pour chaque canaux
la valeur de la nuance
.bmiColors(Ind).rgbRed = Ind
Next Ind
End Select
End With
extGetDIBFromBitmap = DIBInfo
End Function
Pour afficher le tif, metricDC étant une classe gérant un pictureBox et
son DC en mode High_Metric:
Public Function afficheimage(mdc As metricDC)
Dim dummy&
Dim OldMode&
Dim PS As Double
Dim OriginalColor As RGBQUAD
Dim h As RealRegion
If ErreurLecture Then
With mEspacebitmap
mdc.CadreReal .Left, .Bottom, .Right, .Top, RGB(255, 0, 0)
mdc.writetext "Erreur de lecture Image", (.Right - .Left) / 2 + .Left,
(.Top - .Bottom) / 2 + .Bottom, mEchelle / 25, 2, 0, True
End With
Exit Function
End If
'corrige la zone bitmap (modif de xpix)
dummy& = GetzoneDIB(mdc)
'couleur d'origine
mDIBinfo.bmiColors(0).rgbBlue = OriginalColor.rgbBlue
mDIBinfo.bmiColors(0).rgbGreen = OriginalColor.rgbGreen
mDIBinfo.bmiColors(0).rgbRed = OriginalColor.rgbRed
If dummy& <> -1 Then
Select Case mDIBinfo.bmiHeader.biBitCount
Case 1
OldMode& = SetStretchBltMode(mdc.hdc, STRETCH_ANDSCANS)
Case Else
OldMode& = SetStretchBltMode(mdc.hdc, STRETCH_DELETESCANS)
End Select
OldMode& = SetStretchBltMode(mdc.hdc, OldMode&)
End If
End Function
Voili voilà en tout cas cette lib est très puissante et efficace avec de
nombreuses fonctions. Elle demande comme tout, un peu de temps et
d'aspirine, mais ça vaut le coup!
Indique que l'on peut utiliser GFLax : l'activeX là je n'ai rien à dire je ne l'utilise jamais.
Soit la SDK, elle permet de récupérer un DIB formaté Windows (aligné sur 32 bits), donc implique l'utilisation de qqs API. Si vous installez la GFL SDK, vous trouverez dans le répertoire où elle s'installe un fichier d'aide et des exemples VB6.
Dans un projet VB6 il faut intégrer en tant que modules publiques 6 modules comprenant la déclaration des structures et fonctions de la Dll exemple:
'Structure BITMAP Public Type GFL_BITMAP Type As Integer Origin As Integer Width As Long Height As Long BytesPerLine As Long LinePadding As Integer BitsPerComponent As Integer ComponentsPerPixel As Integer BytesPerPixel As Integer Xdpi As Integer Ydpi As Integer TransparentIndex As Integer ColorUsed As Long ColorMap As Long Data As Long Comment As Long MetaData As Long End Type
Public Declare Function gflLoadBitmap Lib "libgfl220.dll" (ByVal filename As String, ByRef BITMAP As Long, ByRef params As GFL_LOAD_PARAMS, ByRef info As GFL_FILE_INFORMATION) As Integer
On peut ensuite utiliser ces fonctions, un exemple pour charger un fichier tif. Fonction située au niveau du module de classe MyDIB
Public Function ChargeImage() Dim GflParams As GFL_LOAD_PARAMS Dim PtrBitmap As Long Dim GflInfo As GFL_FILE_INFORMATION Dim File As String Dim Error As Integer
gflLibraryInit gflGetDefaultLoadParams GflParams
With GflParams .Flags = GFL_LOAD_SKIP_ALPHA Or GFL_LOAD_BY_EXTENSION_ONLY .Origin = GFL_BOTTOM_LEFT .ColorModel = GFL_BGR 'Component order like DIB .LinePadding = 4 'Line padding on 4 bytes (32bits) End With
extGetGflBitmapFromPtr PtrBitmap, mGflBitmap mDIBinfo = extGetDIBFromBitmap(mGflBitmap) Else ErreurLecture = True End If
gflLibraryExit
SetEspaceBitmap
End Function
Qui utilise deux fonctions déclarées au niveau des modules publiques: Une écrite par l'auteur de l'interface VB.
Public Sub extGetGflBitmapFromPtr(ByVal src As Long, ByRef dest As GFL_BITMAP) gflFreeBitmapData dest 'On supprime les data de notre image CopyMemory VarPtr(dest), src, Len(dest) 'On copie les datas du bitmap temporaire dans notre bitmap gflMemoryFree src 'On supprime le bitmap temporaire de la mémoire End Sub
Une autre modifiée par mes soins:
Public Function extGetDIBFromBitmap(ByRef BITMAP As GFL_BITMAP) As BITMAPINFO Dim DIBInfo As BITMAPINFO Dim ColorMap As GFL_COLORMAP Dim Ind As Integer
With DIBInfo.bmiHeader .biSize = Len(DIBInfo.bmiHeader) 'La taille de la structure .biWidth = BITMAP.Width 'Largeur du bitmap .biHeight = BITMAP.Height 'Hauteur du bitmap .biPlanes = 1 'Nombre de plans .biCompression = BI_RGB 'Toujours BI_RGB .biClrImportant = 0 'Toujours 0
If BITMAP.Xdpi = BITMAP.Ydpi Then If BITMAP.Xdpi <> 0 Then
Select Case BITMAP.Type 'Suivant le type de bitmap Case GFL_COLORS 'Si GFL_COLORS (une palette de couleurs indexé de 0 à 255) extGetGflColorMapFromPtr BITMAP.ColorMap, ColorMap 'On récupère les index du bitmap dans une structure GflColorMap For Ind = 0 To 255 'Pour chaque index on indique à la structure Dib_Info .bmiColors(Ind).rgbBlue = ColorMap.Blue(Ind) 'La valeur du bleu .bmiColors(Ind).rgbGreen = ColorMap.Green(Ind) 'La valeur du vert .bmiColors(Ind).rgbRed = ColorMap.Red(Ind) 'La valeur du rouge Next Ind Case GFL_BINARY 'Si GFL_BINARY (seulement noir et blanc donc 2 couleurs indexés) on indique à Dib_Info qu'il y a deux index .bmiColors(0).rgbBlue = 0: .bmiColors(0).rgbGreen = 0: .bmiColors(0).rgbRed = 0 'Le premier vaut Red=0,Green=0,Blue=0 donc du noir (#000000) .bmiColors(1).rgbBlue = 255: .bmiColors(1).rgbGreen = 255: .bmiColors(1).rgbRed = 255 'Le second vaut Red%5,Green%5,Blue%5 donc blanc (#FFFFFF) Case GFL_GREY 'Si GFL_GREY (On travaille sur 256 nuances) For Ind = 0 To 255 'Pour chaque index de Dib_Info on indique une nuance de gris .bmiColors(Ind).rgbBlue = Ind ' Il y a 256 index et 256 gris on donne à chaque index .bmiColors(Ind).rgbGreen = Ind ' et pour chaque canaux la valeur de la nuance .bmiColors(Ind).rgbRed = Ind Next Ind End Select End With extGetDIBFromBitmap = DIBInfo End Function
Pour afficher le tif, metricDC étant une classe gérant un pictureBox et son DC en mode High_Metric:
Public Function afficheimage(mdc As metricDC) Dim dummy& Dim OldMode& Dim PS As Double Dim OriginalColor As RGBQUAD Dim h As RealRegion
If ErreurLecture Then With mEspacebitmap mdc.CadreReal .Left, .Bottom, .Right, .Top, RGB(255, 0, 0) mdc.writetext "Erreur de lecture Image", (.Right - .Left) / 2 + .Left, (.Top - .Bottom) / 2 + .Bottom, mEchelle / 25, 2, 0, True End With Exit Function End If
'corrige la zone bitmap (modif de xpix) dummy& = GetzoneDIB(mdc) 'couleur d'origine mDIBinfo.bmiColors(0).rgbBlue = OriginalColor.rgbBlue mDIBinfo.bmiColors(0).rgbGreen = OriginalColor.rgbGreen mDIBinfo.bmiColors(0).rgbRed = OriginalColor.rgbRed
If dummy& <> -1 Then
Select Case mDIBinfo.bmiHeader.biBitCount
Case 1 OldMode& = SetStretchBltMode(mdc.hdc, STRETCH_ANDSCANS) Case Else OldMode& = SetStretchBltMode(mdc.hdc, STRETCH_DELETESCANS) End Select
OldMode& = SetStretchBltMode(mdc.hdc, OldMode&) End If
End Function
Voili voilà en tout cas cette lib est très puissante et efficace avec de nombreuses fonctions. Elle demande comme tout, un peu de temps et d'aspirine, mais ça vaut le coup!
