Gdi+ via le shell

[Montor]

Bonjour
La LoadPictureEx dans module suivant montre comment charger des images au tiff png via les interfaces IShellImageDataFactory
et IShellImageData

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
 
Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
                                                  (pPictDesc As PICTDESC, riid As GUID, ByVal fOwn As Long, ppvObj As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal DC As Long) As Long
Private Declare Function CoCreateInstance Lib "ole32" (clsid As GUID, ByVal unkOuter As Long, _
               ByVal dwClsContext As Long, iid As GUID, pv As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" _
            (ByVal str As Long, id As GUID) As Long
 
Private Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hbitmap As Long
    hpal As Long
End Type
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type APISIZE
    cx As Long
    cy As Long
End Type
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Private CLASS_ShellImageDataFactory As GUID
Private IID_IUnknown As GUID
Private IID_IPicture As GUID
 
Private Function NewGdiPlusObj() As IShellImageDataFactory
 If IID_IUnknown.Data4(7) = 0 Then
      CLSIDFromString StrPtr("{66e4e4fb-f385-4dd0-8d74-a2efd1bc6178}"), CLASS_ShellImageDataFactory
      CLSIDFromString StrPtr("{00000000-0000-0000-C000-000000000046}"), IID_IUnknown
      CLSIDFromString StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture
 End If
 Call CoCreateInstance(CLASS_ShellImageDataFactory, 0, 5, IID_IUnknown, NewGdiPlusObj)
End Function
 
Public Function LoadPictureEx(Filename As String) As IPicture
    Dim DC As Long, CDc As Long
    Dim hbitmap As Long
    Dim Disp As PICTDESC
    Dim Sz As APISIZE
    Dim Sh As IShellImageDataFactory
    Dim ShImg As IShellImageData
    Dim OldBmp As Long
    Dim R As RECT
    On Error GoTo ErrHandler
    Set Sh = NewGdiPlusObj
    Set ShImg = Sh.CreateImageFromFile(Filename)
    Call ShImg.Decode(0, 0, 0)
    ShImg.GetSize Sz
    DC = GetDC(0)
    hbitmap = CreateCompatibleBitmap(DC, Sz.cx, Sz.cy)
    If hbitmap = 0 Then Exit Function
    R.Right = Sz.cx
    R.Bottom = Sz.cy
    CDc = CreateCompatibleDC(DC)
    OldBmp = SelectObject(CDc, hbitmap)
    Call ShImg.Draw(CDc, R, R)
    Disp.cbSizeOfStruct = Len(Disp)
    Disp.picType = 1
    Disp.hbitmap = hbitmap
    Call SelectObject(CDc, OldBmp)
    Call DeleteObject(CDc)
    Call ReleaseDC(0, DC)
    Call OleCreatePictureIndirect(Disp, IID_IPicture, 1, LoadPictureEx)
ErrHandler:
End Function

Pour pouvoir utimler vous devez activer une réferenrc vers la bibilotheque dans la pièce jointe

Code :

Set Image1.Picture = LoadPictureEx("C:\im.png")