how to use OleCreatePictureIndirect for ResizePicture (...)

Public Type PictGuid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public Type PictDescGeneric
pdgSize As Long
pdcPicType As Long
pdcHandle As Long
pdcExtraA As Long
pdcExtraB As Long
End Type

Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDescGeneric, riid As PictGuid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Public Function ResizePicture(Pic As StdPicture, lWidth As Long, lHeight As Long) As StdPicture
Dim PicDC As Long
Dim PicBM As Long
Dim PicOBJ As Long
Dim Pic2DC As Long
Dim PicGUID As PictGuid
Dim PicDesc As PictDescGeneric
PicDC = CreateCompatibleDC(0)
PicBM = CreateCompatibleBitmap(0, lWidth, lHeight)
PicOBJ = SelectObject(PicDC, PicBM)
Pic2DC = CreateCompatibleDC(0)
SelectObject Pic2DC, Pic.Handle
StretchBlt PicDC, 0, 0, lWidth, lHeight, Pic2DC, 0, 0, Pic.Width, Pic.Height, vbSrcCopy
DeleteDC Pic2DC
SelectObject PicDC, PicOBJ
With PicGUID
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(3) = &HAA
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With PicDesc
.pdgSize = Len(PicDesc)
.pdcPicType = 1
.pdcHandle = PicBM
End With
OleCreatePictureIndirect PicDesc, PicGUID, 1, ResizePicture
DeleteDC PicDC
DeleteObject PicBM
End Function