Extraction image d'un metafile

Version imprimable

Bonjour

Je cale sur un problème d'extraction d'image embarquées dans un fichier metafile.
Pour cela j'utilise l'enumeration et j'arrive bien à produire des fichiers images.
Le probléme survient avec le record de type EMR_STRETCHDIBITS. L'image obtenue n'a pas les bonnes couleurs pour certaines images.
Voici un extrait du code que j'utilise.

Code:

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
Public Function CallBack_ENumMetafile(ByVal hdc As Long, _
                                      ByVal lpHtable As Long, _
                                      ByVal lpMFR As Long, _
                                      ByVal nObj As Long, _
                                      ByVal lpClientData As Long) As Long
  Dim PEnhEMR As EMR
  Dim PEnhStrecthDiBits As EMRSTRETCHDIBITS
  Dim tmpDc As Long
  Dim hBitmap  As Long
  Dim lRet As Long
  Dim BITMAPINFO As BITMAPINFO
  Dim pBitsMem As Long
  Dim pBitmapInfo As Long
  Static RecordCount As Long
 
  lRet = PlayEnhMetaFileRecord(hdc, ByVal lpHtable, ByVal lpMFR, ByVal nObj)
 
 
  RecordCount = RecordCount + 1
  CopyMemory PEnhEMR, ByVal lpMFR, Len(PEnhEMR)
  Select Case PEnhEMR.iType
  Case 1  'header
    RecordCount = 1
  Case EMR_STRETCHDIBITS
    CopyMemory PEnhStrecthDiBits, ByVal lpMFR, Len(PEnhStrecthDiBits)
    pBitmapInfo = lpMFR + PEnhStrecthDiBits.offBmiSrc
    CopyMemory BITMAPINFO, ByVal pBitmapInfo, Len(BITMAPINFO)
    pBitsMem = lpMFR + PEnhStrecthDiBits.offBitsSrc
 
    tmpDc = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    hBitmap = CreateDIBitmap(tmpDc, _
                            BITMAPINFO.bmiHeader, _
                            CBM_INIT, _
                            ByVal pBitsMem, _
                            BITMAPINFO, _
                            DIB_RGB_COLORS)
    lRet = DeleteDC(tmpDc)
    If hBitmap Then
      'init du pcturebox qui va recevoir le bitmap
      frmExtractImgFromEmf.pctExport.Cls
      frmExtractImgFromEmf.pctExport.Picture = LoadPicture("")
      frmExtractImgFromEmf.pctExport.Width = BITMAPINFO.bmiHeader.biWidth
      frmExtractImgFromEmf.pctExport.Height = BITMAPINFO.bmiHeader.biHeight
      tmpDc = CreateCompatibleDC(frmExtractImgFromEmf.hdc)
      lRet = SelectObject(tmpDc, hBitmap)
      lRet = BitBlt(frmExtractImgFromEmf.pctExport.hdc, _
                    0, 0, _
                    frmExtractImgFromEmf.pctExport.Width, _
                    frmExtractImgFromEmf.pctExport.Height, _
                    tmpDc, _
                    0, 0, _
                    vbSrcCopy)
      DeleteDC tmpDc
      Set frmExtractImgFromEmf.pctExport.Picture = frmExtractImgFromEmf.pctExport.Image
      SavePicture frmExtractImgFromEmf.pctExport.Picture, App.Path & "\temp" & CStr(RecordCount) & ".bmp"
      MsgBox "la creation du bitmap a réussi"
      DeleteObject hBitmap
    Else
      MsgBox "la création du bitmap a échoué"
    End If
  End Select
  CallBack_ENumMetafile = True
 
End Function

je vous mets un lien vers le source complet , ce qui vous permetra de faire un test avec le fichier exemple joint.

Je ne sais pas pas du tout ou est le problème, ma boule de cristal cassée me sussure un problème de palette. Je cale.

07/08/2009, 10h39
DarkVader

Bonjour,
Tu as essayé de remplacer DIB_RGB_COLORS par DIB_PAL_COLORS dans CreateDIBitmap de la fct de callback ?
07/08/2009, 10h54
Delbeke

Vi, mais çà ne fait qu'afficher le même avec d'autre couleurs :(
D'ailleurs, je suis pas sûr, mais il me semble que les couleurs affichées changent quelque fois entre différentes exécutions du programme.

Mais j'ai fait tellement d'essais que je n'en suis pas sûr. (ca fait plusieurs jours que je tourne autour)
07/08/2009, 11h09
DarkVader

Désolé, les fonctions graphiques ne sont assez étrangères.

A première vue, la fonction de callback doit te retourner un pointeur vers une table de couleurs dans lpHTable ;
tu devrais fouiller de ce coté.
07/08/2009, 11h25
Delbeke

Arf, voilou une info très interessante, j'ignorais totalement à qoui servait ce parametre. Je vais fouiller par là. Mais avant je pars en villégiature pour deux petites semaines
Alors merci beaucoup pour l'info, je l'enmènne avec moi dans mes bagages.
10/08/2009, 18h21
Delbeke
Un petit coucou depuis la bretagne
La piste de Dark n'a conduit nulle part, merci quand même Dark, l'idée était séduisante.
J'ai continué mes recherches et j'ai trouvé une solution. Il s'agissait bien d'un problème de palette. En fait la palette se trouve derriere la structure de bitmapinfo. J'ai doncmodifié la déclaration de la structure de bitmapinfo comme suit.
Code:

1 2 3 4 Public Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(255) As RGBQUAD End Type
Pas très ortodoxe, mais çà fonctionne

Encore un grand merci à ceux qui ont lu ce post.