Thursday 26 April 2018

C# - VBA - COM - For image processing ditch WinAPI/GDI and use .NET instead

So I had cause to load an image file and query the colour of a pixel, so I needed some image processing code. I had encountered some code before but did not capture it for this blog. Investigating today I was depressed by the obscure way the Windows API worked in this regard, then to find that the Windows API declaration would need to change for 64-bit versions of VBA I rebelled. Instead, I reached for the .NET image classes and chose to export them from a C# class library using .NET/COM interop. Life is much simpler now.

Below is some code that calls into the C# class library, the source for which can be found on this counterpart blog post. Together these programs allow a picture to written to Excel cells like this...


Option Explicit

Sub Test()
    
    DumpPictureToCells "N:\stackoverflowicon.png", False
    'DumpPictureToCells "N:\number.png", True
    
End Sub


Sub DumpPictureToCells(ByVal sFileName As String, ByVal bIsAlphaMask As Boolean)
    Dim oBitMap As ImageToByteArray.BitMap
    Set oBitMap = New ImageToByteArray.BitMap
    
    Dim bSU As Boolean
    bSU = Application.ScreenUpdating
    Application.ScreenUpdating = False
    
    
    Sheet1.Cells.Clear
    
 
    oBitMap.LoadImage sFileName

    Dim x As Long, y As Long
    For x = 0 To oBitMap.Width - 1
        For y = 0 To oBitMap.Height - 1
            Dim col As ImageToByteArray.Colour
            Set col = oBitMap.GetPixel(x, y)
            
            Dim rng As Excel.Range
            Set rng = Sheet1.Cells(y + 1, x + 1)
            
            If bIsAlphaMask Then
                rng.Interior.Color = RGB(256 - col.A, 256 - col.A, 256 - col.A)
            Else
                rng.Interior.Color = RGB(col.R, col.G, col.B)
            End If
        Next
    Next

    Application.ScreenUpdating = bSU
End Sub

Private Function ResizeCellsToBeSquare()
    
    Dim sngColWidth
    sngColWidth = 2.14 '* based on experimentation
    
    Dim lColLoop As Long
    For lColLoop = 1 To Sheet1.UsedRange.Columns.Count
        Dim rngCell As Excel.Range
        Set rngCell = Sheet1.Cells(1, lColLoop)
        
        rngCell.EntireColumn.ColumnWidth = sngColWidth
        
    Next

End Function


P.S. During the WinAPi investigation I came across this excellent website mvps.org

No comments:

Post a Comment