Bitmap en niveau de Gris / Dll -> HBitMap

**thonydesbois** · 18/07/2006, 11h23

Bonjour à tous,

J'utilise une DLL qui me renvoie un Hbitmap sur une image BMP en niveau de Gris.

Dans un premier temps voici ce que j'ai réussi à pondre en fouillant sur le forum. Ceci fonctionne très bien pour visualiser mon image et l'enregistrer, cependant, mon image une fois enregistrée fait a peu près le triple de sa taille normale ( car l'image renvoyée par la dll est en niveau de gris codée sur 1 octet par pixel ), je pense que l'image est retransformée en RVB en récupérant l'image via le Clipboard.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 'open the clipboard
    OpenClipboard imgCheque.hwnd
    'Clear the clipboard
    EmptyClipboard
    'Put our bitmap onto the clipboard
    SetClipboardData CF_BITMAP, BmpFront
    'Check if there's a bitmap on the clipboard
    If IsClipboardFormatAvailable(CF_BITMAP) = 0 Then
        MsgBox "There was an error while pasting the bitmap to the clipboard!"
    End If
 
    'Close the clipboard
    CloseClipboard
 
    'Get the picture from the clipboard
    imgCheque.Picture = Clipboard.GetData(vbCFBitmap)
 
   SavePicture  imgCheque.Picture, "F:\Projets Borland Studio\DLL\BIN\images\Ftest.bmp"

alors j'ai fini par faire ce qu'il y a ci-dessous mais impossible delire les données de mon image ... je pense que le problème est liée au codage de l'image (1octet par pixel) et que la fonction GetDIBits ne sait pas l'interpréter. Autrement, lorsque j'utilise la fonction GetObjectApi, je retrouve les bonnes dimensions de mon image dans ma structure PicInfo.

BmpFront est mon hBitmap retourné par la DLL.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
  Dim Buffer() As RGBQUAD
  Dim PicInfo As BITMAPINFOHEADER
  Dim Width As Long
  Dim Height As Long
 
  Dim Src_hDc As Long
  Dim hDCScn As Long
  Dim OldObj As Long
 
  Dim BMPINFO As BITMAPINFO
  Dim BMPINFOH As BITMAPINFOHEADER
 
  GetObjectApi BmpFront, Len(PicInfo), PicInfo
  Width = PicInfo.biWidth
  Height = PicInfo.biHeight
 
  hDCScn = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
  Src_hDc = CreateCompatibleDC(hDCScn)
  OldObj = SelectObject(Src_hDc, BmpFront)
  ReDim Buffer(0 To Width - 1, 0 To Height - 1)
 
  GetDIBits Src_hDc, BmpFront, 0, Height, Buffer(0, 0), BMPINFO, 0

Alors voici mes questions : comment est t'il possible d'enregistrer un HBitMap directement sur le disque dur ? Si ce n'est pas le cas, comment est ce que je peux enregistrer mon fichier bmp sur disque ? ( j'ai aussi essayé de passer par un fichier binaire en pasant mon HBitmap mais ca ne fonctionne pas non plus )

Merci à tous pour vos conseils, il y a encore des concepts VB qui m'échappent j'en fais que depuis une semaine.

**jmfmarques** · 18/07/2006, 13h06

Ton code ne nous permet pas d'y voir clair si tu ne précises pas le type de ton contrôle imgCheque (contrôle image ou picturebox ?)

**thonydesbois** · 18/07/2006, 14h01

Oui en effet, j'ai oublié de préciser, imgCheque est un pictureBox, mais le code utilisant imgcheque fonctionne. Mon problème est de sauver directement mon image sur le disque dur sans passer par le Clipboard. Je pense

merci,

**Asdorve** · 18/07/2006, 14h03

salut

avec SavePicture

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
SavePicture Picture1.image, Chemin de destination

EDIT:

je ne vois pas le rapport avec ton titre...

**thonydesbois** · 18/07/2006, 14h11

bonjour,

le rapport avec le titre est ecrit dans la 1er message, j'ai déjà essayé cette solution à partir de mon Hbitmap retourné par la dll que j'utilise mais ca ne fonctionne pas.

merci.

**Asdorve** · 18/07/2006, 14h16

Mille excuse, j'ai dû bugger sur une ligne...

mais tu as essayé ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Get the picture from the clipboard
    imgCheque.Picture = Clipboard.GetData(vbCFBitmap)
imgCheque.Picture = imgCheque.image
   SavePicture  imgCheque.Picture, "F:\Projets Borland Studio\DLL\BIN\images\Ftest.bmp"

sans grande conviction vu que ton pb a l'air plus compliqué..

**thonydesbois** · 18/07/2006, 14h30

y a pas de mal

j'ai testé ce que tu a mis, le problème est le même mon image fait toujours trois fois sa taille...

merci,

**jmfmarques** · 18/07/2006, 14h51

Je commence maintenant à deviner ce qui t'échappe, mais ne peux le vérifier sans l'intégralité de ton code de traitement de l'image : je dis bien l'intégralité, en précisant tout, y compris bien entendu les scalemodes de la form, de la ou des pictureboxe(s) etc...
Une question quand même avant que tu ne postes cette intégralité : t'es-tu intéressé à ce à quoi correspond un scalemode ?

**thonydesbois** · 18/07/2006, 15h19

j'ai essayé en changant le ScaleMode, je l'ai mis en pixel mais rien ne change,
Mon image fait toujours trois fois sa taille.

Voici mon code original :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
 
Private Sub OCX3002_OnScanMemory(ByVal Msecs As Long, ByVal NumSeq As Long, ByVal Track As String, ByVal BmpFront As Long, ByVal sizeBmpFront As Long, ByVal BmpRear As Long, ByVal sizeBmpRear As Long, ByVal JpegFront As Long, ByVal sizeJpegFront As Long, ByVal JpegRear As Long, ByVal sizeJpegRear As Long, ByVal TiffFront As Long, ByVal sizeTiffFront As Long, ByVal TiffRear As Long, ByVal sizeTiffRear As Long)
    'open the clipboard
    OpenClipboard imgCheque.hwnd
    'Clear the clipboard
    EmptyClipboard
    'Put our bitmap onto the clipboard
    SetClipboardData CF_BITMAP, BmpFront
    'Check if there's a bitmap on the clipboard
    If IsClipboardFormatAvailable(CF_BITMAP) = 0 Then
        MsgBox "There was an error while pasting the bitmap to the clipboard!"
    End If
 
    'Close the clipboard
    CloseClipboard
 
    'Get the picture from the clipboard
    imgCheque.ScaleMode = 3 'Pixel
    imgCheque.Picture = Clipboard.GetData(vbCFBitmap)
    imgCheque.Picture = imgCheque.Image
 
    SavePicture imgCheque.Picture, "F:\Projets Borland Studio\DLL\BIN\images\Ftest.bmp"
End Sub

merci,

**jmfmarques** · 18/07/2006, 17h43

Il est malheureusement bien évident que ceci ne saurait être la totalité du code mis en oeuvre.

On n'y voit entre autres et surtout pas du tout ce qui se passe en ce qui concerne le traitement donné à l'image. J'ai l'impression que tout se fait ailleurs (dans un ocx dont tu n'aurais pas le code ?)

Edit : peux-tu nous dire ce que, par exemple, vient faire ici cette précision dans ton titre "niveaux de gris" et à quel endroit serait traitée cette partie-là (niveaux de gris) ?

Pour le reste, ta procédure reçoit de nombreux paramètres, mais tu ne dis pas ce qu'ils représentent ni où et comment ils ont été déterminés !
On ne voit d'ailleurs pas non plus où et comment tu les utilises !
tu voudras bien comprendre qu'il n'est pas possible de jouer aux devinettes pour t'aider...
Bien qu'il soit évident qu'il s'agit là d'un bout de code copié-collé ailleurs et qui devait donc (ailleurs) servir à quelque chose, vraisemblablement à mettre une image en mémoire puis à la récupérer.

Enfin et surtout, tu ne nous précises pas ce que tu entends par la taille de ton image (s'agit-il de la taille en octets du fichier sauvegardé ou s'agit-il du nombre de pixels de ton image ?) Le fichier image originel, enfin, est-il en bitmaps ou d'un autre format ?
etc... etc...

**thonydesbois** · 20/07/2006, 15h34

Après de multiples essais et recherches voici la solution que j'ai trouvé :

je récupère les octects DIB du fichier bitmap à partir du HBitmap, puis je les réinjecte quand je recrée mon fichier BMP.

il y a certainement moyen de le faire en rèinjectant les octects DIB dans le picturebox et puis en enregistrant avec savePicture, je m'y pencherai peut être plus tard ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 
 
Const LR_LOADFROMFILE = &H10
Const IMAGE_BITMAP = 0
Const IMAGE_ICON = 1
Const IMAGE_CURSOR = 2
Const IMAGE_ENHMETAFILE = 3
Const CF_BITMAP = 2
Const CF_DIB = 8
 
Const clRed = &HFF&
Const clGreen = &H8000&
Const clBlue = &HFF0000
Const clPurple = &H800080
Const clMaroon = &H4080&
 
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpvDest As Long, ByVal lpvSource As Long, ByVal cbCopy As Long)
 
Private Declare Function GetObjectApi Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
 
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth _
    As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As _
    Long) As Long
 
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
 
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, ByVal lpBits As Long, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
 
 
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
 
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
 
Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type
 
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(0 To 255) As RGBQUAD
End Type
 
Private Sub OCX3002_OnScanMemory(ByVal Msecs As Long, ByVal NumSeq As Long, ByVal Track As String, ByVal BmpFront As Long, ByVal sizeBmpFront As Long, ByVal BmpRear As Long, ByVal sizeBmpRear As Long, ByVal JpegFront As Long, ByVal sizeJpegFront As Long, ByVal JpegRear As Long, ByVal sizeJpegRear As Long, ByVal TiffFront As Long, ByVal sizeTiffFront As Long, ByVal TiffRear As Long, ByVal sizeTiffRear As Long)
 
    Dim Src_hDc As Long
    Dim hDCScn As Long
    Dim OldObj As Long
 
    Dim Width As Long
    Dim Height As Long
 
    Dim Buffer() As Byte
 
    Dim BMPINFO As BITMAPINFO
    Dim BMPINFOH As BITMAPINFOHEADER
    Dim bmfBitmapFileHeader As BITMAPFILEHEADER
 
    Dim PicInfo As BITMAP
    Dim ff As Long
 
    'open the clipboard
    OpenClipboard imgCheque.hwnd
    'Clear the clipboard
    EmptyClipboard
    'Put our bitmap onto the clipboard
    SetClipboardData CF_BITMAP, BmpFront
    'Check if there's a bitmap on the clipboard
    If IsClipboardFormatAvailable(CF_BITMAP) = 0 Then
        MsgBox "There was an error while pasting the bitmap to the clipboard!"
    End If
 
    'Close the clipboard
    CloseClipboard
 
    'Get the picture from the clipboard
    imgCheque.ScaleMode = 3 'Pixel
    imgCheque.Picture = Clipboard.GetData(vbCFBitmap)
    imgCheque.Picture = imgCheque.Image
 
    'SavePicture imgCheque.Picture, "F:\Projets Borland Studio\DLL\BIN\images\FBig" + Str(NumSeq) + ".bmp"
 
  GetObjectApi BmpFront, Len(PicInfo), PicInfo
  Width = PicInfo.bmWidthBytes
 
  Height = PicInfo.bmHeight
 
  hDCScn = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
  Src_hDc = CreateCompatibleDC(hDCScn)
  OldObj = SelectObject(Src_hDc, BmpFront)
  ReDim Buffer(0 To Height - 1, 0 To Width - 1)
 
  sizeData2 = sizeBmpFront - Len(BMPINFO) - Len(bmfBitmapFileHeader)
 
  With BMPINFOH
    .biBitCount = PicInfo.bmBitsPixel
    .biHeight = Height
    .biWidth = Width
    .biPlanes = PicInfo.bmPlanes
    .biClrUsed = 256
    .biSize = Len(BMPINFOH)
    .biSizeImage = Height * Width * PicInfo.bmBitsPixel / 8
  End With
 
  BMPINFO.bmiHeader = BMPINFOH
  GetDIBits Src_hDc, BmpFront, 0, Height, Buffer(0, 0), BMPINFO, 0
 
  'Crée l 'entête du fichier bmp
  With bmfBitmapFileHeader
    .bfType = &H4D42&
   .bfOffBits = Len(bmfBitmapFileHeader) + Len(BMPINFO)
   .bfSize = sizeBmpFront
  End With
 
  BMPINFO.bmiHeader.biClrUsed = 256
  BMPINFO.bmiHeader.biXPelsPerMeter = 200
  BMPINFO.bmiHeader.biYPelsPerMeter = 200
 
ff = FreeFile
FileName = "F:\Projets Borland Studio\DLL\BIN\images\F" + Str(NumSeq) + ".bmp"
Open FileName For Binary As #ff
Put #ff, , bmfBitmapFileHeader
'Ecrit les informations du bitmap
Put #ff, , BMPINFO
Put #ff, , Buffer
Close #ff
 
End Sub

à la prochaine, j'espère que ca fera gagner quelques jours à d'autres personnes

Bitmap en niveau de Gris / Dll -> HBitMap

VB 6 et antérieur

Discussions similaires

Partager

Partager