Blurring images using Direct2D & Windows Imaging Component

Jaafar Tribak · Feb 18, 2024

Some time ago, I posted a workaround for blurring userforms using a gdi32 alphablend algorithm.

Lately, I have been exploring other ways and came accross Direct2D and Windows Imaging Component graphics apis for higher quality and better performance rendering (minimum system requirements Win7). These apis are more powerful than GDI and GDIPlus, however, since these are mostly com interface based, their code is wrapped in type libs and therfore they are a bit trickier to use at run time for the avearge vba coder.

In this thread, I would like to post my first baby steps using these apis which allowed me to achieve faster and more flexible blurring (glass) effects on images (bmp,jpg,png ... ). I hope this will be of use to vba users as well.

In the code below, you will find BlurImageFromFile and BlurImageFromImageHandle and as their names suggest, these are two easy to use custom functions that return a vba StdPicture object. One expects an image file and the other expects a StdPic handle. Also, you can optionally set the blur radius (intensity) and/or the image scaling via the functions optional arguments.

File Demo:
BlurDirect2D.xlsm

Code written and tested in x32 and x64 bit. So far, no issues found ... No external libraries are needed. Just plug the code and play.

1- In a Standard Module:

VBA Code:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
    Private Const PTR_LEN = 8&
#Else
    Private Const NULL_PTR = 0&
    Private Const PTR_LEN = 4&
#End If

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As LongPtr)
    Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, ByVal prgvt As LongPtr, ByVal prgpvarg As LongPtr, ByRef pvargResult As Variant) As LongPtr
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Object) As Long
    Private Declare PtrSafe Function CLSIDFromString Lib "Ole32.dll" (ByVal pstring As LongPtr, ByRef pCLSID As GUID) As Long
    Private Declare PtrSafe Function CreateDIBSection Lib "Gdi32.dll" (ByVal hdc As LongPtr, ByRef pbmi As BITMAPINFO, ByVal usage As Long, ByVal ppvBits As LongPtr, ByVal hSection As LongPtr, ByVal offset As Long) As LongPtr
    Private Declare PtrSafe Function SetDIBits Lib "Gdi32.dll" (ByVal hdc As LongPtr, ByVal hbitmap As LongPtr, ByVal nStartScan As Long, ByVal nNumScans As Long, ByVal lpBits As LongPtr, ByRef lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
    Private Declare PtrSafe Function CreateD2D1Factory Lib "D2d1.dll" Alias "D2D1CreateFactory" (ByVal factoryType As LongPtr, ByRef riid As GUID, ByRef pFactoryOptions As D2D1_FACTORY_OPTIONS, ByRef ppID2D1Factory As LongPtr) As Long
    Private Declare PtrSafe Function CreateWICFactory Lib "Windowscodecs.dll" Alias "WICCreateImagingFactory_Proxy" (ByVal sdkVersion As Long, ByRef ppIWICImagingFactory As LongPtr) As Long
    Private Declare PtrSafe Function CreateWICBitmap Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateBitmap_Proxy" (ByVal pIWICImagingFactory As LongPtr, ByVal uiWidth As Long, ByVal uiHeight As Long, ByRef PixelFormat As GUID, ByVal eOption As Long, ByRef ppIWICBitmap As LongPtr) As Long
    Private Declare PtrSafe Function CreateWICDecoderFromFilename Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateDecoderFromFilename_Proxy" (ByVal pFactory As LongPtr, ByVal wzFilename As LongPtr, ByVal pguidVendor As LongPtr, ByVal dwDesiredAccess As Long, ByVal metadataOptions As Long, ByRef ppIDecoder As LongPtr) As Long
    Private Declare PtrSafe Function GetWICFrameCount Lib "Windowscodecs.dll" Alias "IWICBitmapDecoder_GetFrameCount_Proxy" (ByVal pIWICDecoder As LongPtr, ByRef pCount As Long) As Long
    Private Declare PtrSafe Function GetWICFrame Lib "Windowscodecs.dll" Alias "IWICBitmapDecoder_GetFrame_Proxy" (ByVal pIWICDecoder As LongPtr, ByVal index As Long, ByRef ppIBitmapFrame As LongPtr) As Long
    Private Declare PtrSafe Function ConvertWICBitmap Lib "Windowscodecs.dll" Alias "WICConvertBitmapSource" (ByRef dstFormat As GUID, ByVal pISrc As LongPtr, ByRef ppIDst As LongPtr) As Long
    Private Declare PtrSafe Function CreateWICBitmapFromSource Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateBitmapFromSource_Proxy" (ByVal pFactory As LongPtr, ByVal pIBitmapSource As LongPtr, ByVal eOption As Long, ByRef ppIBitmap As LongPtr) As Long
    Private Declare PtrSafe Function CreateBitmapFromHBITMAP Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateBitmapFromHBITMAP_Proxy" (ByVal pFactory As LongPtr, ByVal hbitmap As LongPtr, ByVal hPalette As LongPtr, ByVal eOption As Long, ByRef ppIBitmap As LongPtr) As Long
    Private Declare PtrSafe Function GetWICBitmapSourceSize Lib "Windowscodecs.dll" Alias "IWICBitmapSource_GetSize_Proxy" (ByVal pIWICBitmapSource As LongPtr, ByRef puiWidth As Long, ByRef puiHeight As Long) As Long
    Private Declare PtrSafe Function LockWICBitmap Lib "Windowscodecs.dll" Alias "IWICBitmap_Lock_Proxy" (ByVal pIBitmap As LongPtr, ByRef prcLock As WICRect, ByVal lockFlags As Long, ByRef ppILock As LongPtr) As Long
    Private Declare PtrSafe Function GetWICLockDataPointer Lib "Windowscodecs.dll" Alias "IWICBitmapLock_GetDataPointer_STA_Proxy" (ByVal pILock As LongPtr, ByRef pcbBufferSize As Long, ByRef ppbData As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As LongPtr)
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, ByVal prgvt As LongPtr, ByVal prgpvarg As LongPtr, ByRef pvargResult As Variant) As LongPtr
    Private Declare Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare Function OleCreatePictureIndirect Lib "oleAut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Object) As Long
    Private Declare Function CLSIDFromString Lib "Ole32.dll" (ByVal pstring As LongPtr, ByRef pCLSID As GUID) As Long
    Private Declare Function CreateDIBSection Lib "Gdi32.dll" (ByVal hdc As LongPtr, ByRef pbmi As BITMAPINFO, ByVal usage As Long, ByVal ppvBits As LongPtr, ByVal hSection As LongPtr, ByVal offset As Long) As LongPtr
    Private Declare Function SetDIBits Lib "Gdi32.dll" (ByVal hdc As LongPtr, ByVal hbitmap As LongPtr, ByVal nStartScan As Long, ByVal nNumScans As Long, ByVal lpBits As LongPtr, ByRef lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
    Private Declare Function CreateD2D1Factory Lib "D2d1.dll" Alias "D2D1CreateFactory" (ByVal factoryType As LongPtr, ByRef riid As GUID, ByRef pFactoryOptions As D2D1_FACTORY_OPTIONS, ByRef ppID2D1Factory As LongPtr) As Long
    Private Declare Function CreateWICFactory Lib "Windowscodecs.dll" Alias "WICCreateImagingFactory_Proxy" (ByVal sdkVersion As Long, ByRef ppIWICImagingFactory As LongPtr) As Long
    Private Declare Function CreateWICBitmap Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateBitmap_Proxy" (ByVal pIWICImagingFactory As LongPtr, ByVal uiWidth As Long, ByVal uiHeight As Long, ByRef PixelFormat As GUID, ByVal eOption As Long, ByRef ppIWICBitmap As LongPtr) As Long
    Private Declare Function CreateWICDecoderFromFilename Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateDecoderFromFilename_Proxy" (ByVal pFactory As LongPtr, ByVal wzFilename As LongPtr, ByVal pguidVendor As LongPtr, ByVal dwDesiredAccess As Long, ByVal metadataOptions As Long, ByRef ppIDecoder As LongPtr) As Long
    Private Declare Function GetWICFrameCount Lib "Windowscodecs.dll" Alias "IWICBitmapDecoder_GetFrameCount_Proxy" (ByVal pIWICDecoder As LongPtr, ByRef pCount As Long) As Long
    Private Declare Function GetWICFrame Lib "Windowscodecs.dll" Alias "IWICBitmapDecoder_GetFrame_Proxy" (ByVal pIWICDecoder As LongPtr, ByVal index As Long, ByRef ppIBitmapFrame As LongPtr) As Long
    Private Declare Function ConvertWICBitmap Lib "Windowscodecs.dll" Alias "WICConvertBitmapSource" (ByRef dstFormat As GUID, ByVal pISrc As LongPtr, ByRef ppIDst As LongPtr) As Long
    Private Declare Function CreateWICBitmapFromSource Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateBitmapFromSource_Proxy" (ByVal pFactory As LongPtr, ByVal pIBitmapSource As LongPtr, ByVal eOption As Long, ByRef ppIBitmap As LongPtr) As Long
    Private Declare Function CreateBitmapFromHBITMAP Lib "Windowscodecs.dll" Alias "IWICImagingFactory_CreateBitmapFromHBITMAP_Proxy" (ByVal pFactory As LongPtr, ByVal hbitmap As LongPtr, ByVal hPalette As LongPtr, ByVal eOption As Long, ByRef ppIBitmap As LongPtr) As Long
    Private Declare Function GetWICBitmapSourceSize Lib "Windowscodecs.dll" Alias "IWICBitmapSource_GetSize_Proxy" (ByVal pIWICBitmapSource As LongPtr, ByRef puiWidth As Long, ByRef puiHeight As Long) As Long
    Private Declare Function LockWICBitmap Lib "Windowscodecs.dll" Alias "IWICBitmap_Lock_Proxy" (ByVal pIBitmap As LongPtr, ByRef prcLock As WICRect, ByVal lockFlags As Long, ByRef ppILock As LongPtr) As Long
    Private Declare Function GetWICLockDataPointer Lib "Windowscodecs.dll" Alias "IWICBitmapLock_GetDataPointer_STA_Proxy" (ByVal pILock As LongPtr, ByRef pcbBufferSize As Long, ByRef ppbData As LongPtr) As Long
#End If

Private Enum D2D1_DEBUG_LEVEL
    D2D1_DEBUG_LEVEL_NONE = 0&
End Enum

Private Enum D2D1_GAUSSIANBLUR_PROP
    D2D1_GAUSSIANBLUR_PROP_STANDARD_DEVIATION = 0&
    D2D1_GAUSSIANBLUR_PROP_OPTIMIZATION = 1&
    D2D1_GAUSSIANBLUR_PROP_BORDER_MODE = 2&
End Enum

Private Enum D2D1_PROPERTY_TYPE
    D2D1_PROPERTY_TYPE_BOOL = 2&
   D2D1_PROPERTY_TYPE_FLOAT = 5&
    D2D1_PROPERTY_TYPE_VECTOR2 = 6&
    D2D1_PROPERTY_TYPE_IUNKNOWN = 10&
    D2D1_PROPERTY_TYPE_ENUM = 11&
End Enum

Private Enum D2D1_BORDER_MODE
    D2D1_BORDER_MODE_SOFT = 0&
    D2D1_BORDER_MODE_HARD = 1&
End Enum

Private Enum D2D1_BITMAPSOURCE_PROP
    D2D1_BITMAPSOURCE_PROP_WIC_BITMAP_SOURCE = 0&
    D2D1_BITMAPSOURCE_PROP_SCALE = 1&
    D2D1_BITMAPSOURCE_PROP_INTERPOLATION_MODE = 2&
    D2D1_BITMAPSOURCE_PROP_ENABLE_DPI_CORRECTION = 3&
    D2D1_BITMAPSOURCE_PROP_ALPHA_MODE = 4&
    D2D1_BITMAPSOURCE_PROP_ORIENTATION = 5&
End Enum

Private Enum vtb_Interfaces
    ' IUnknown
    QueryInterface = 0&
    vtblFucRelease = 2&
    ' ID2D1Factory
    CreateWicBitmapRenderTarget = 13&
    ' ID2D1DeviceContext2
    Clear = 47&
    BeginDraw = 48&
    EndDraw = 49&
    CreateEffect = 63&
    GetImageLocalBounds = 70&
    DrawImage = 83&
    ' ID2D1Effect
    SetValue = 9&
    SetInput = 14&
    GetOutput = 18&
End Enum

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0& To 7&) As Byte
End Type

Private Type D2D1_FACTORY_OPTIONS
    eDebugLevel As D2D1_DEBUG_LEVEL
End Type

Private Type WICRect
    x As Long
    Y As Long
    Width As Long
    Height As Long
End Type

Private Type D2D1_RECT_F
    left As Single
    top As Single
    right As Single
    bottom As Single
End Type

Private Type D2D1_POINT_2F
    x As Single
    Y As Single
End Type

Private Type D2D1_PIXEL_FORMAT
    eDxgiFormat As Long
    eAlphaMode As Long
End Type

Private Type D2D1_RENDER_TARGET_PROPERTIES
    eTargetType As Long
    tPixelFormat As D2D1_PIXEL_FORMAT
    sngDpiX As Single
    sngDpiY As Single
    eTargetUsage As Long
    eMinFeatureLevel As Long
End Type

Private Type D2D1_VECTOR_2F
    x As Single
    Y As Single
End Type

Private Type D2D1_COLOR_F
    r As Single
    g As Single
    b As Single
    a As Single
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 BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
End Type

Private Type PICTDESC
    cbSizeOfStruct As Long
    PicType As Long
    hgdiObj As LongPtr
    hPalOrXYExt As LongPtr
End Type

Private Const D2D1_BITMAPSOURCE_ORIENTATION_DEFAULT = 1&
Private Const D2D1_INTERPOLATION_MODE_LINEAR = 1&
Private Const WICBitmapLockRead = 1&
Private Const D2D1_GAUSSIANBLUR_OPTIMIZATION_BALANCED = 1&
Private Const D2D1_BITMAPSOURCE_ALPHA_MODE_PREMULTIPLIED = 1&
Private Const D2D1_BITMAPSOURCE_INTERPOLATION_MODE_FANT = 6&
Private Const D2D1_ALPHA_MODE_PREMULTIPLIED = 1&

Private m_pIWICImagingFactory As LongPtr
Private m_pID2D1Factory As LongPtr
Private m_pIWICBitmap As LongPtr
Private m_pID2D1RenderTarget As LongPtr
Private m_pID2D1DeviceContext2 As LongPtr
Private pID2D1Image As LongPtr
Private pID2D1ImageEffect As LongPtr
              
              
' _____________________________________________ Public Routines _______________________________________________________

Public Function BlurImageFromFile( _
    ByVal FileName As String, _
    Optional ByVal ScaleX As Single = 1&, _
    Optional ByVal ScaleY As Single = 1&, _
    Optional ByVal BlurRadius As Single = 3& _
) As StdPicture

    Dim oStdPic As StdPicture

    If Len(Dir(FileName)) = 0& Then
        MsgBox "Invalid File.":   GoTo Xit
    End If

    If Initialize = False Then
        MsgBox "Unable to create a WIC factory.":  GoTo Xit
    End If
 
    pID2D1Image = ImageFileToD2D1Image(FileName, NewVector_2F(ScaleX, ScaleY))
    If pID2D1Image = 0 Then
        MsgBox "Unable to create WICBitmap.":   GoTo Xit
    End If
 
    pID2D1ImageEffect = CreateD2D1GaussianBlurEffect(pID2D1Image, BlurRadius, D2D1_GAUSSIANBLUR_OPTIMIZATION_BALANCED, D2D1_BORDER_MODE_HARD)
    If pID2D1Image = 0 Then
        MsgBox "Unable to create Blur Effect.":   GoTo Xit
    End If

    Set oStdPic = D2D1ImageToPicture(pID2D1ImageEffect, NewColor_F)
    If oStdPic Is Nothing Then
        MsgBox "Unable to create vb StandardPicture.":   GoTo Xit
    End If

    Set BlurImageFromFile = oStdPic
  
Xit:
    Call ReleaseInterface(pID2D1Image)
    Call Terminate
  
End Function

Public Function BlurImageFromImageHandle( _
    ByVal ImageHandle As LongPtr, _
    Optional ByVal ScaleX As Single = 1&, _
    Optional ByVal ScaleY As Single = 1&, _
    Optional ByVal BlurRadius As Single = 3& _
) As StdPicture

    Dim oStdPic As StdPicture

    If ImageHandle = 0 Then
        MsgBox "Invalid image handle.":  GoTo Xit
    End If

    If Initialize = False Then
        MsgBox "Unable to create a WIC factory.":  GoTo Xit
    End If
 
    pID2D1Image = ImageHandleToD2D1Image(ImageHandle, NewVector_2F(ScaleX, ScaleY))
    If pID2D1Image = 0 Then
        MsgBox "Unable to create WICBitmap.":   GoTo Xit
    End If
 
    pID2D1ImageEffect = CreateD2D1GaussianBlurEffect(pID2D1Image, BlurRadius, D2D1_GAUSSIANBLUR_OPTIMIZATION_BALANCED, D2D1_BORDER_MODE_HARD)
    If pID2D1Image = 0 Then
        MsgBox "Unable to create Blur Effect.":   GoTo Xit
    End If

    Set oStdPic = D2D1ImageToPicture(pID2D1ImageEffect, NewColor_F)
    If oStdPic Is Nothing Then
        MsgBox "Unable to create vb StandardPicture.":   GoTo Xit
    End If

    Set BlurImageFromImageHandle = oStdPic

Xit:
    Call ReleaseInterface(pID2D1Image)
    Call Terminate
  
End Function




' _____________________________________________ Private Routines _______________________________________________________

Private Function Initialize() As Boolean

    Const IID_ID2D1DeviceContext2 As String = "{394ea6a3-0c34-4321-950b-6ca20f0be6c7}"
    Const GUID_WICPixelFormat32bppPBGRA As String = "{6fddc324-4e03-4bfe-b185-3d77768dc910}"
    Const IID_ID2D1Factory As String = "{06152247-6f50-465a-9245-118bfd3b6007}"
    Const S_OK = 0&, WICBitmapCacheOnDemand = 1&, WINCODEC_SDK_VERSION2 = &H237&, DXGI_FORMAT_B8G8R8A8_UNORM = 87&
    Const D2D1_FACTORY_TYPE_SINGLE_THREADED = 0&
    Dim bolRet As Boolean
    Dim tD2D1_FACTORY_OPTIONS As D2D1_FACTORY_OPTIONS
    Dim tD2D1_RENDER_TARGET_PROPERTIES As D2D1_RENDER_TARGET_PROPERTIES
  
    bolRet = False
    '   create a WIC factory
    If CreateWICFactory(WINCODEC_SDK_VERSION2, m_pIWICImagingFactory) = S_OK Then
        tD2D1_FACTORY_OPTIONS.eDebugLevel = D2D1_DEBUG_LEVEL_NONE
        'create a D2D1 factory
'        Creates a factory object that can be used to create Direct2D resources
        If CreateD2D1Factory(D2D1_FACTORY_TYPE_SINGLE_THREADED, _
            Str2Guid(IID_ID2D1Factory), tD2D1_FACTORY_OPTIONS, _
            m_pID2D1Factory) = S_OK Then
            ' create a WIC bitmap
'            Fonction proxy pour la méthode CreateBitmap .
            If CreateWICBitmap(m_pIWICImagingFactory, 1&, 1&, _
                Str2Guid(GUID_WICPixelFormat32bppPBGRA), _
                WICBitmapCacheOnDemand, m_pIWICBitmap) = S_OK Then
                With tD2D1_RENDER_TARGET_PROPERTIES
                    .tPixelFormat.eDxgiFormat = DXGI_FORMAT_B8G8R8A8_UNORM
                    .tPixelFormat.eAlphaMode = D2D1_ALPHA_MODE_PREMULTIPLIED
                End With
                If vtblCall(m_pID2D1Factory, CreateWicBitmapRenderTarget, m_pIWICBitmap, _
                            VarPtr(tD2D1_RENDER_TARGET_PROPERTIES), VarPtr(m_pID2D1RenderTarget)) = S_OK Then
                    ' Create a D2D1 DeviceContext from the D2D1 RenderTarget
                    If vtblCall(m_pID2D1RenderTarget, QueryInterface, _
                        VarPtr(Str2Guid(IID_ID2D1DeviceContext2)), _
                        VarPtr(m_pID2D1DeviceContext2)) = S_OK Then
                        bolRet = True
                    End If
                End If
            End If
        End If
    End If
    Initialize = bolRet
  
End Function

Private Sub Terminate()
    If m_pID2D1DeviceContext2 <> 0& Then Call ReleaseInterface(m_pID2D1DeviceContext2)
    If m_pID2D1RenderTarget <> 0& Then Call ReleaseInterface(m_pID2D1RenderTarget)
    If m_pIWICBitmap <> 0& Then Call ReleaseInterface(m_pIWICBitmap)
    If m_pID2D1Factory <> 0& Then Call ReleaseInterface(m_pID2D1Factory)
    If m_pIWICImagingFactory <> 0& Then Call ReleaseInterface(m_pIWICImagingFactory)
End Sub

Private Function ImageHandleToD2D1Image( _
    ByVal hbitmap As LongPtr, _
    ByRef ScaleBitmap As D2D1_VECTOR_2F, _
    Optional ByVal orientation As Long = D2D1_BITMAPSOURCE_ORIENTATION_DEFAULT, _
    Optional ByVal interpolationMode As Long = D2D1_BITMAPSOURCE_INTERPOLATION_MODE_FANT, _
    Optional ByVal alphaMode As Long = D2D1_BITMAPSOURCE_ALPHA_MODE_PREMULTIPLIED, _
    Optional ByVal enableDpiCorrection As Boolean = False _
) As LongPtr

    Dim pIWICBitmap As LongPtr
    ' there is a picture
    If hbitmap Then
        ' Limitation
        If ScaleBitmap.x < 0.01 Then ScaleBitmap.x = 0.01
        If ScaleBitmap.Y < 0.01 Then ScaleBitmap.Y = 0.01
        pIWICBitmap = ImageHandleToWICBitmap(hbitmap)
        If pIWICBitmap <> 0& Then
            ' converts a WIC bitmap to a D2D1 image
            ImageHandleToD2D1Image = CreateD2D1BitmapSourceEffect(pIWICBitmap, _
            ScaleBitmap, orientation, interpolationMode, alphaMode, enableDpiCorrection)
            Call ReleaseInterface(pIWICBitmap)
        End If
    End If
  
End Function

Private Function ImageHandleToWICBitmap(ByVal hbitmap As LongPtr) As LongPtr

    Const IMAGE_BITMAP = 0&:  Const LR_COPYRETURNORG = &H4
    Dim hPtr As LongPtr
  
    'a bmp handle exists
    If hbitmap Then
        hPtr = CopyImage(hbitmap, IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG)
        Call CreateBitmapFromHBITMAP(m_pIWICImagingFactory, hPtr, NULL_PTR, _
        D2D1_BITMAPSOURCE_ALPHA_MODE_PREMULTIPLIED, ImageHandleToWICBitmap)
        Call DeleteObject(hPtr)
    End If

End Function

Private Function ImageFileToWICBitmap(ByVal FileName As String) As LongPtr

    Const GUID_WICPixelFormat32bppPBGRA As String = "{6fddc324-4e03-4bfe-b185-3d77768dc910}"
    Const S_OK = 0&, WICBitmapCacheOnDemand = 1&, GENERIC_READ = &H80000000, WICDecodeMetadataCacheOnDemand = 0&
    Dim lngFrameCount As Long
    Dim pIWICBitmap As LongPtr
    Dim pIWICBitmapDecoder As LongPtr
    Dim pIWICBitmapFrameDecode As LongPtr
  
    ' a file exists
    If Len(FileName) <> 0& Then
        ' create a WIC BitmapDecoder from the file
        If CreateWICDecoderFromFilename(m_pIWICImagingFactory, StrPtr(FileName), NULL_PTR, _
            GENERIC_READ, WICDecodeMetadataCacheOnDemand, pIWICBitmapDecoder) = S_OK Then
            ' Determine the number of frames
            If GetWICFrameCount(pIWICBitmapDecoder, lngFrameCount) = S_OK Then
                ' at least one frame exists
                If lngFrameCount > 0 Then
                    ' load first frame
                    If GetWICFrame(pIWICBitmapDecoder, 0&, pIWICBitmapFrameDecode) = S_OK Then
                        ' Convert frame to 32bppPBGRA format -> WIC bitmap
                        If ConvertWICBitmap(Str2Guid(GUID_WICPixelFormat32bppPBGRA), _
                            pIWICBitmapFrameDecode, pIWICBitmap) = S_OK Then
                            Call CreateWICBitmapFromSource(m_pIWICImagingFactory, _
                                pIWICBitmap, WICBitmapCacheOnDemand, ImageFileToWICBitmap)
                            Call ReleaseInterface(pIWICBitmap)
                        End If
                        ' Delete WIC BitmapFrameDecode
                        Call ReleaseInterface(pIWICBitmapFrameDecode)
                    End If
                End If
            End If
            ' Delete WIC BitmapDecoder
            Call ReleaseInterface(pIWICBitmapDecoder)
        End If
    End If

End Function

Private Function ImageFileToD2D1Image( _
    ByVal FileName As String, _
    ByRef ScaleBitmap As D2D1_VECTOR_2F, _
    Optional ByVal orientation As Long = D2D1_BITMAPSOURCE_ORIENTATION_DEFAULT, _
    Optional ByVal interpolationMode As Long = D2D1_BITMAPSOURCE_INTERPOLATION_MODE_FANT, _
    Optional ByVal alphaMode As Long = D2D1_BITMAPSOURCE_ALPHA_MODE_PREMULTIPLIED, _
    Optional ByVal enableDpiCorrection As Boolean = False _
) As LongPtr
  
    Dim bytData() As Byte
    Dim pIWICBitmap As LongPtr
    Dim pID2D1Effect As LongPtr
  
    ' there is a picture
    If Len(FileName) <> 0& Then
        ' Limitation
        If ScaleBitmap.x < 0.01 Then ScaleBitmap.x = 0.01
        If ScaleBitmap.Y < 0.01 Then ScaleBitmap.Y = 0.01
        pIWICBitmap = ImageFileToWICBitmap(FileName)
        If pIWICBitmap <> NULL_PTR Then
            ' converts a WIC bitmap to a D2D1 image
            ImageFileToD2D1Image = CreateD2D1BitmapSourceEffect(pIWICBitmap, _
            ScaleBitmap, orientation, interpolationMode, alphaMode, enableDpiCorrection)
            Call ReleaseInterface(pIWICBitmap)
        End If
    End If
  
End Function

Private Function CreateD2D1GaussianBlurEffect( _
    ByVal pID2D1Image As LongPtr, _
    Optional ByVal StandardDeviation As Single = 3, _
    Optional ByVal optimation As Long = D2D1_GAUSSIANBLUR_OPTIMIZATION_BALANCED, _
    Optional ByVal borderMode As D2D1_BORDER_MODE = D2D1_BORDER_MODE_SOFT _
) As LongPtr
  
    Const CLSID_D2D1GaussianBlur As String = "{1feb6d69-2fe6-4ac9-8c58-1d7f93e7a6a5}"
    Const S_OK = 0&
    Dim bytData() As Byte
    Dim pID2D1Effect As LongPtr
  
    If pID2D1Image <> NULL_PTR Then
        If StandardDeviation < 0 Then StandardDeviation = 0
        If vtblCall(m_pID2D1DeviceContext2, CreateEffect, _
            VarPtr(Str2Guid(CLSID_D2D1GaussianBlur)), _
            VarPtr(pID2D1Effect)) = S_OK Then
            Call vtblCall(pID2D1Effect, SetInput, 0&, pID2D1Image, 1&)
            bytData = SingleToByteArray(StandardDeviation)
            'ID2D1Properties::SetValue
            If vtblCall(pID2D1Effect, SetValue, _
                D2D1_GAUSSIANBLUR_PROP_STANDARD_DEVIATION, _
                D2D1_PROPERTY_TYPE_FLOAT, _
                VarPtr(bytData(0)), UBound(bytData) + 1) = S_OK Then
                bytData = LongToByteArray(optimation)
                If vtblCall(pID2D1Effect, SetValue, _
                    D2D1_GAUSSIANBLUR_PROP_OPTIMIZATION, _
                    D2D1_PROPERTY_TYPE_ENUM, _
                    VarPtr(bytData(0)), UBound(bytData) + 1) = S_OK Then
                    bytData = LongToByteArray(borderMode)
                    If vtblCall(pID2D1Effect, SetValue, _
                        D2D1_GAUSSIANBLUR_PROP_BORDER_MODE, _
                        D2D1_PROPERTY_TYPE.D2D1_PROPERTY_TYPE_ENUM, _
                        VarPtr(bytData(0)), UBound(bytData) + 1) = S_OK Then
                        Call vtblCall(pID2D1Effect, GetOutput, VarPtr(CreateD2D1GaussianBlurEffect))
                    End If
                End If
            End If
            Call ReleaseInterface(pID2D1Effect)
        End If
    End If
  
End Function

Private Function CreateD2D1BitmapSourceEffect( _
    ByVal pIWICBitmap As LongPtr, _
    ByRef ScaleBitmap As D2D1_VECTOR_2F, _
    Optional ByVal orientation As Long = D2D1_BITMAPSOURCE_ORIENTATION_DEFAULT, _
    Optional ByVal interpolationMode As Long = D2D1_BITMAPSOURCE_INTERPOLATION_MODE_FANT, _
    Optional ByVal alphaMode As Long = D2D1_BITMAPSOURCE_ALPHA_MODE_PREMULTIPLIED, _
    Optional ByVal enableDpiCorrection As Boolean = False _
) As LongPtr
  
    Const CLSID_D2D1BitmapSource As String = "{5fb6c24d-c6dd-4231-9404-50f4d5c3252d}"
    Const S_OK = 0&
    Dim bytData() As Byte
    Dim pID2D1Effect As LongPtr
  
    If pIWICBitmap <> 0& Then
        If ScaleBitmap.x < 0.01 Then ScaleBitmap.x = 0.01
        If ScaleBitmap.Y < 0.01 Then ScaleBitmap.Y = 0.01
        If vtblCall(m_pID2D1DeviceContext2, CreateEffect, _
            VarPtr(Str2Guid(CLSID_D2D1BitmapSource)), _
            VarPtr(pID2D1Effect)) = S_OK Then
            bytData = LongToByteArray64(pIWICBitmap)
            If vtblCall(pID2D1Effect, SetValue, _
                D2D1_BITMAPSOURCE_PROP.D2D1_BITMAPSOURCE_PROP_WIC_BITMAP_SOURCE, _
                D2D1_PROPERTY_TYPE_IUNKNOWN, VarPtr( _
                bytData(0)), UBound(bytData) + 1) = S_OK Then
                bytData = Vector2ToByteArray(ScaleBitmap)
                If vtblCall(pID2D1Effect, SetValue, _
                    D2D1_BITMAPSOURCE_PROP.D2D1_BITMAPSOURCE_PROP_SCALE, _
                    D2D1_PROPERTY_TYPE.D2D1_PROPERTY_TYPE_VECTOR2, VarPtr( _
                    bytData(0)), UBound(bytData) + 1) = S_OK Then
                    bytData = LongToByteArray(interpolationMode)
                    If vtblCall(pID2D1Effect, SetValue, _
                        D2D1_BITMAPSOURCE_PROP.D2D1_BITMAPSOURCE_PROP_INTERPOLATION_MODE, _
                        D2D1_PROPERTY_TYPE.D2D1_PROPERTY_TYPE_ENUM, VarPtr( _
                        bytData(0)), UBound(bytData) + 1) = S_OK Then
                        bytData = BooleanToByteArray(enableDpiCorrection)
                        If vtblCall(pID2D1Effect, SetValue, _
                            D2D1_BITMAPSOURCE_PROP.D2D1_BITMAPSOURCE_PROP_ENABLE_DPI_CORRECTION, _
                            D2D1_PROPERTY_TYPE.D2D1_PROPERTY_TYPE_BOOL, _
                            VarPtr(bytData(0)), UBound(bytData) + 1) = S_OK Then
                            bytData = LongToByteArray(alphaMode)
                            If vtblCall(pID2D1Effect, SetValue, _
                                D2D1_BITMAPSOURCE_PROP.D2D1_BITMAPSOURCE_PROP_ALPHA_MODE, _
                                D2D1_PROPERTY_TYPE.D2D1_PROPERTY_TYPE_ENUM, _
                                VarPtr(bytData(0)), UBound(bytData) + 1) = S_OK Then
                                bytData = LongToByteArray(orientation)
                                If vtblCall(pID2D1Effect, SetValue, _
                                    D2D1_BITMAPSOURCE_PROP.D2D1_BITMAPSOURCE_PROP_ORIENTATION, _
                                    D2D1_PROPERTY_TYPE.D2D1_PROPERTY_TYPE_ENUM, _
                                    VarPtr(bytData(0)), UBound(bytData) + 1) = S_OK Then
                                    Call vtblCall(pID2D1Effect, GetOutput, VarPtr(CreateD2D1BitmapSourceEffect))
                                End If
                            End If
                        End If
                    End If
                End If
            End If
            Call ReleaseInterface(pID2D1Effect)
        End If
    End If

End Function

Private Function D2D1ImageToPicture(ByVal pID2D1Image As LongPtr, ByRef backColor As D2D1_COLOR_F) As StdPicture

    Const IID_ID2D1DeviceContext2 As String = "{394ea6a3-0c34-4321-950b-6ca20f0be6c7}"
    Const GUID_WICPixelFormat32bppPBGRA As String = "{6fddc324-4e03-4bfe-b185-3d77768dc910}"
    Const S_OK = 0&, WICBitmapCacheOnDemand = 1&, D2D1_COMPOSITE_MODE_SOURCE_OVER = 0&, DXGI_FORMAT_B8G8R8A8_UNORM = 87&
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim pIWICBitmap As LongPtr
    Dim pID2D1RenderTarget As LongPtr
    Dim pID2D1DeviceContext As LongPtr
    Dim tD2D1_RECT_F As D2D1_RECT_F
    Dim tD2D1_POINT_2F As D2D1_POINT_2F
    Dim tD2D1_RENDER_TARGET_PROPERTIES As D2D1_RENDER_TARGET_PROPERTIES

    ' a D2D1 image is present
    If pID2D1Image <> NULL_PTR Then
        ' Determine dimensions of the D2D1 image
        If vtblCall(m_pID2D1DeviceContext2, GetImageLocalBounds, _
            pID2D1Image, VarPtr(tD2D1_RECT_F)) = S_OK Then
            ' We limit the maximum size here
            If tD2D1_RECT_F.left < -2.147483E+09! Then tD2D1_RECT_F.left = -4096
            If tD2D1_RECT_F.top < -2.147483E+09! Then tD2D1_RECT_F.top = -4096
            If tD2D1_RECT_F.right > 2.147483E+09! Then tD2D1_RECT_F.right = 4096
            If tD2D1_RECT_F.bottom > 2.147483E+09! Then tD2D1_RECT_F.bottom = 4096
            ' Save height and width
            lngWidth = CLng(tD2D1_RECT_F.right)
            lngHeight = CLng(tD2D1_RECT_F.bottom)
            ' Create a WIC bitmap in appropriate dimensions
            If CreateWICBitmap(m_pIWICImagingFactory, lngWidth, lngHeight, _
                Str2Guid(GUID_WICPixelFormat32bppPBGRA), _
                WICBitmapCacheOnDemand, pIWICBitmap) = S_OK Then
                With tD2D1_RENDER_TARGET_PROPERTIES
                    .tPixelFormat.eDxgiFormat = DXGI_FORMAT_B8G8R8A8_UNORM
                    .tPixelFormat.eAlphaMode = D2D1_ALPHA_MODE_PREMULTIPLIED
                End With
                ' Create a D2D1 RenderTarget from the WIC bitmap
                If vtblCall(m_pID2D1Factory, CreateWicBitmapRenderTarget, _
                    pIWICBitmap, VarPtr(tD2D1_RENDER_TARGET_PROPERTIES), _
                    VarPtr(pID2D1RenderTarget)) = S_OK Then
                    ' Create a D2D1 DeviceContext from the D2D1 RenderTarget
                    If vtblCall(pID2D1RenderTarget, QueryInterface, _
                        VarPtr(Str2Guid(IID_ID2D1DeviceContext2)), _
                        VarPtr(pID2D1DeviceContext)) = S_OK Then
                        ' start drawing into the D2D1 DeviceContext
                        Call vtblCall(pID2D1DeviceContext, BeginDraw)
                        ' Erase background with one color
                        Call vtblCall(pID2D1DeviceContext, Clear, VarPtr(backColor))
                        With tD2D1_POINT_2F
                            .x = tD2D1_RECT_F.left
                            .Y = tD2D1_RECT_F.top
                        End With
                        ' draws the D2D1 image into the D2D1 DeviceContext
                        Call vtblCall(pID2D1DeviceContext, DrawImage, pID2D1Image, _
                            VarPtr(tD2D1_POINT_2F), VarPtr(tD2D1_RECT_F), _
                            D2D1_INTERPOLATION_MODE_LINEAR, _
                            D2D1_COMPOSITE_MODE_SOURCE_OVER)
                        ' finish drawing into the D2D1 DeviceContext
                        Call vtblCall(pID2D1DeviceContext, EndDraw, 0, 0)
                        ' Delete D2D1 DeviceContext
                        Call ReleaseInterface(pID2D1DeviceContext)
                    End If
                    ' Delete D2D1 RenderTarget
                    Call ReleaseInterface(pID2D1RenderTarget)
                End If
                Set D2D1ImageToPicture = WICBitmapToPicture(pIWICBitmap)
                ' Delete WIC bitmap
                Call ReleaseInterface(pIWICBitmap)
            End If
        End If
    End If

End Function

Private Function WICBitmapToPicture(ByVal pIWICBitmap As LongPtr) As StdPicture

    Const IID_IPicture As String = "{7bf80980-bf32-101a-8bbb-00aa00300cab}"
    Const S_OK = 0&
    Dim hbitmap As LongPtr
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim lngBuffSize As Long
    Dim pData As LongPtr
    Dim pIWICBitmapLock As LongPtr
    Dim tWICRect As WICRect
    Dim tPICTDESC As PICTDESC
    Dim tBITMAPINFO As BITMAPINFO

    If pIWICBitmap <> 0& Then
        If GetWICBitmapSourceSize(pIWICBitmap, lngWidth, lngHeight) = S_OK Then
            With tWICRect
                .x = 0&
                .Y = 0&
                .Width = lngWidth
                .Height = lngHeight
            End With
            ' LockBits
            If LockWICBitmap(pIWICBitmap, tWICRect, _
                 WICBitmapLockRead, pIWICBitmapLock) = S_OK Then
                ' Get pointer to the image data
                If GetWICLockDataPointer(pIWICBitmapLock, _
                    lngBuffSize, pData) = S_OK Then
                    With tBITMAPINFO
                        .bmiHeader.biSize = Len(tBITMAPINFO.bmiHeader)
                        .bmiHeader.biWidth = lngWidth
                        .bmiHeader.biHeight = -lngHeight
                        .bmiHeader.biPlanes = 1
                        .bmiHeader.biBitCount = 32
                    End With
                    ' create a DIB
                    hbitmap = CreateDIBSection(NULL_PTR, tBITMAPINFO, 0&, NULL_PTR, NULL_PTR, 0&)
                    ' a DIB is available
                    If hbitmap <> 0& Then
                        ' Copy image data to the DIB
                        If SetDIBits(0&, hbitmap, 0&, lngHeight, pData, _
                            tBITMAPINFO, 0&) = lngHeight Then
                            With tPICTDESC
                                .cbSizeOfStruct = Len(tPICTDESC)
                                .PicType = 1
                                .hgdiObj = hbitmap
                            End With
                            ' create a StdPicture from the DIB
                            Call OleCreatePictureIndirect(tPICTDESC, _
                                Str2Guid(IID_IPicture), 1&, WICBitmapToPicture)
                        End If
                    End If
                End If
                Call ReleaseInterface(pIWICBitmapLock)
            End If
        End If
    End If

End Function


' __________________________________________________helper routines ___________________________________________________________

Private Function Vector2ToByteArray(ByRef value As D2D1_VECTOR_2F) As Byte()
    Dim bytData() As Byte
    Dim lngDataSize As Long
    lngDataSize = LenB(value)
    ReDim bytData(lngDataSize - 1)
    Call CopyMemory(bytData(0), value, lngDataSize)
    Vector2ToByteArray = bytData
End Function

Private Function BooleanToByteArray(ByVal value As Boolean) As Byte()
    Dim bytData() As Byte
    Dim lngBool As Long
    Dim lngDataSize As Long
    lngBool = Abs(value)
    lngDataSize = LenB(lngBool)
    ReDim bytData(lngDataSize - 1)
    Call CopyMemory(bytData(0), lngBool, lngDataSize)
    BooleanToByteArray = bytData
End Function

Private Function SingleToByteArray(ByVal value As Single) As Byte()
    Dim bytData() As Byte
    Dim lngDataSize As Long
    lngDataSize = LenB(value)
    ReDim bytData(lngDataSize - 1)
    Call CopyMemory(bytData(0), value, lngDataSize)
    SingleToByteArray = bytData
End Function

Private Function LongToByteArray(ByVal value As Long) As Byte()
    Dim bytData() As Byte
    Dim lngDataSize As Long
    lngDataSize = LenB(value)
    ReDim bytData(lngDataSize - 1&)
    Call CopyMemory(bytData(0), value, lngDataSize)
    LongToByteArray = bytData
End Function
'
Private Function LongToByteArray64(ByVal value As LongPtr) As Byte()
    Dim bytData() As Byte
    Dim lngDataSize As Long
    lngDataSize = LenB(value)
    ReDim bytData(lngDataSize - 1&)
    Call CopyMemory(bytData(0), value, lngDataSize)
    LongToByteArray64 = bytData
End Function

Private Function NewVector_2F(Optional ByVal x As Single = 0, Optional ByVal Y As Single = 0) As D2D1_VECTOR_2F
    With NewVector_2F
        .x = x
        .Y = Y
    End With
End Function

Private Function NewColor_F( _
    Optional ByVal a As Single = 0, _
    Optional ByVal r As Single = 0, _
    Optional ByVal g As Single = 0, _
    Optional ByVal b As Single = 0 _
) As D2D1_COLOR_F
    With NewColor_F
        .a = a
        .r = r
        .g = g
        .b = b
    End With
End Function

Private Function Str2Guid(ByVal str As String) As GUID
    Call CLSIDFromString(StrPtr(str), Str2Guid)
End Function

Private Sub ReleaseInterface(ByRef pInterface As LongPtr)
    Const CC_STDCALL = 4&, S_OK = 0&
    Dim varRet As Variant
    ' there is a pointer to an interface
    If pInterface <> NULL_PTR Then
        ' Call the Release function of the interface
        If DispCallFunc(pInterface, vtblFucRelease * PTR_LEN, CC_STDCALL, _
            vbEmpty, 0&, NULL_PTR, NULL_PTR, varRet) = S_OK Then
            pInterface = NULL_PTR
        End If
    End If
End Sub

Private Function vtblCall( _
    ByVal pInterface As LongPtr, _
    ByVal eInterfaceFunction As vtb_Interfaces, _
    ParamArray arrParam() _
) As Variant
    ' there is a pointer to an interface
    If pInterface <> 0& Then
        ' Call OleInvoke
        vtblCall = OleInvoke(pInterface, eInterfaceFunction, arrParam)
    End If
End Function

Private Function OleInvoke( _
    ByVal pInterface As LongPtr, _
    ByVal lIndex As Long, _
    ParamArray arrParam() _
) As Variant
  
    Const CC_STDCALL = 4&, S_OK = 0&
    Dim lngItem As Long
    Dim lngCount As Long
    Dim varRet As Variant
    Dim varParam As Variant
    Dim olePtr(10&) As LongPtr
    Dim oleTyp(10&) As Integer

    ' there is a pointer to an interface
    If pInterface <> 0& Then
        'only when calling the interface function
        ' Parameters are also available.
        If UBound(arrParam) >= 0 Then
            ' ParamArray to Variant
            varParam = arrParam
            ' the variant is an array
            If IsArray(varParam) Then varParam = varParam(0)
            ' Number of parameters
            lngCount = UBound(varParam)
            ' go through all parameters
            For lngItem = 0 To lngCount
                ' Type of parameter
                oleTyp(lngItem) = VarType(varParam(lngItem))
                ' Pointer to the parameter
                olePtr(lngItem) = VarPtr(varParam(lngItem))
            Next
        End If
        ' Execute function of the interface
        If DispCallFunc(pInterface, lIndex * PTR_LEN, CC_STDCALL, vbLong, _
            lngItem, VarPtr(oleTyp(0)), VarPtr(olePtr(0)), varRet) <> S_OK Then
            Debug.Print "Error calling interface function!"""
        End If
    End If
    OleInvoke = varRet

End Function

2- Code usage example:

VBA Code:

Option Explicit

Private Sub CommandButton1_Click()
     Image1.Picture = bas_Blur.BlurImageFromImageHandle(Image2.Picture.Handle)
End Sub

Private Sub CommandButton2_Click()
    Image3.Picture = bas_Blur.BlurImageFromImageHandle(Image4.Picture.Handle, , , 6)
End Sub

audeser · Feb 18, 2024

U craked my attention now...
have never considered this Direct2D thing, was looking for the GDI+, but after you have mentioned this, I started a search and reached to Direct2D Typelib+ for VB6-VBForums
Worth take a look.

Jaafar Tribak · Feb 19, 2024

audeser said:
U craked my attention now...
have never considered this Direct2D thing, was looking for the GDI+, but after you have mentioned this, I started a search and reached to Direct2D Typelib+ for VB6-VBForums
Worth take a look.

Thanks @audeser for your interest and suggestion.

I didn't see that specific thread but, VBForums is actually where I was first advised to consider using Direct2D and WIC instead of GDI & GDI+ for fatser graphic rendering.

The subject discussed on the thread you linked above is close to the subject here but seems to focus more on available graphics type libraries and VB6 (including Direct2D)

As you know, VB6 can compile into exe so using a type library only when developping in the IDE is an advantage. However, in vba, in order to use similar libraries, we need to explicitly set a vba project reference to them when developping at design time and the reference must stay there even when using the code. This is something I always try to avoid. I don't like having vba projects rely on having a reference set to non-standard libraries, obviously mainly for portability reasons.

The solution for being able to use type libraries at runtime w/o setting any references in our vba project is to perform direct low level vtable calls which is exactly what I did here for producing the blurring effects. Obviously, developping code without a reference to the required type libraries is more challenging and needs propper investigation of the tlb classes, interfaces, virtual functions, etc, but in return, we are rewarded with a plug&play, ready to go hassle free code.

Regards.

we must set The most challenging part

Dan_W · Feb 19, 2024

Wow! I've been trying to do this forever! This is amazing. Thank you so much.

Blurring images using Direct2D & Windows Imaging Component

Jaafar Tribak

Well-known Member

Excel Facts

audeser

New Member

Jaafar Tribak

Well-known Member

Dan_W

Well-known Member

Similar threads

Forum statistics

Share this page

Blurring images using Direct2D & Windows Imaging Component

Jaafar Tribak

Well-known Member

Excel Facts

audeser

New Member

Jaafar Tribak

Well-known Member

Dan_W

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock