Results 1 to 8 of 8

Thread: [VB6] Blur effect on GDI+ bitmaps

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    [VB6] Blur effect on GDI+ bitmaps

    Description

    This module might come handy for implementing drop shadows or similar effects. Based on the original Gaussian blur implementation by an IIR (Infininte Impulse Response) in Tanner Helland's PhotoDemon but uses ASM/SSE thunks for the array handling which speeds the processing ~20x times (in VBIDE).

    Performance

    On my i7-4770 @ 3.50GHz a 1920x1200 JPEG (24-bit, only RGB channels, ~10x larger than 500x500 image) is blurred with radius 25 px for 269 ms (~0.3 sec) when compiled w/ no optimizations and about the same in VBIDE. For comparison you can check out some measurements of IIR filters and other Gaussian blur implementations in this post by Tanner.

    With IIR implementation blur radius does not affect performance as the number of steps performed is invariant to the radius value. IIR also allows for floating-point values to be used for the blur radii. The constant NUM_ITERS in pvBlurChannel greatly affects performance vs quality ratio of the filter though, so it's possible that GIMP and other popular graphics applications use 5 or more iterations, which can explain this module's better performance.

    Sample usage

    Just call the only public function BlurBitmap passing the GDI+ bitmap, blur radius (floating-point in pixels) and optionally a bitmask with ARGB channels to be processed like this:

    If Not BlurBitmap(hBitmap, 4.5) Then GoTo QH

    Source code

    thinBasic Code:
    1. ' mdBlurBitmap.bas
    2. Option Explicit
    3. DefObj A-Z
    4.  
    5. '--- for VirtualProtect
    6. Private Const PAGE_EXECUTE_READWRITE        As Long = &H40
    7. Private Const MEM_COMMIT                    As Long = &H1000
    8. '--- for CryptStringToBinary
    9. Private Const CRYPT_STRING_BASE64           As Long = 1
    10. '--- for gdi+
    11. Private Const ImageLockModeRead         As Long = &H1
    12. Private Const ImageLockModeWrite        As Long = &H2
    13. Private Const PixelFormat32bppARGB      As Long = &H26200A
    14.  
    15. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    16. Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, ByRef lpflOldProtect As Long) As Long
    17. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
    18. Private Declare Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
    19. '--- gdi+
    20. Private Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal hBitmap As Long, lpRect As Any, ByVal lFlags As Long, ByVal lPixelFormat As Long, uLockedBitmapData As BitmapData) As Long
    21. Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal hBitmap As Long, uLockedBitmapData As BitmapData) As Long
    22.  
    23. Private Type BitmapData
    24.     Width               As Long
    25.     Height              As Long
    26.     Stride              As Long
    27.     PixelFormat         As Long
    28.     Scan0               As Long
    29.     Reserved            As Long
    30. End Type
    31.  
    32. Public Function BlurBitmap( _
    33.             ByVal hBitmap As Long, _
    34.             ByVal sngRadius As Single, _
    35.             Optional ByVal AffectChannels As Long = 15) As Boolean
    36.     Dim uData           As BitmapData
    37.     Dim dblBuffer()     As Double
    38.  
    39.     If GdipBitmapLockBits(hBitmap, ByVal 0, ImageLockModeRead Or ImageLockModeWrite, PixelFormat32bppARGB, uData) <> 0 Then
    40.         GoTo QH
    41.     End If
    42.     ReDim dblBuffer(0 To uData.Width - 1, 0 To uData.Height - 1) As Double
    43.     If (AffectChannels And 1) <> 0 Then
    44.         If Not pvBlurChannel(uData.Scan0, uData.Stride \ 4, 0, 0, uData.Width, uData.Height, sngRadius, 0, dblBuffer) Then
    45.             GoTo QH
    46.         End If
    47.     End If
    48.     If (AffectChannels And 2) <> 0 Then
    49.         If Not pvBlurChannel(uData.Scan0, uData.Stride \ 4, 0, 0, uData.Width, uData.Height, sngRadius, 1, dblBuffer) Then
    50.             GoTo QH
    51.         End If
    52.     End If
    53.     If (AffectChannels And 4) <> 0 Then
    54.         If Not pvBlurChannel(uData.Scan0, uData.Stride \ 4, 0, 0, uData.Width, uData.Height, sngRadius, 2, dblBuffer) Then
    55.             GoTo QH
    56.         End If
    57.     End If
    58.     If (AffectChannels And 8) <> 0 Then
    59.         If Not pvBlurChannel(uData.Scan0, uData.Stride \ 4, 0, 0, uData.Width, uData.Height, sngRadius, 3, dblBuffer) Then
    60.             GoTo QH
    61.         End If
    62.     End If
    63.     '--- success
    64.     BlurBitmap = True
    65. QH:
    66.     If uData.Scan0 <> 0 Then
    67.         Call GdipBitmapUnlockBits(hBitmap, uData)
    68.     End If
    69. End Function
    70.  
    71. Private Function pvBlurChannel( _
    72.             ByVal lpBits As Long, _
    73.             ByVal lStride As Long, _
    74.             ByVal lLeft As Long, _
    75.             ByVal lTop As Long, _
    76.             ByVal lWidth As Long, _
    77.             ByVal lHeight As Long, _
    78.             ByVal dblRadius As Double, _
    79.             ByVal lChannel As Long, _
    80.             dblBuffer() As Double) As Boolean
    81. '--- Gaussian blur filter, using an IIR (Infininte Impulse Response) approach
    82. '--- based on [url]https://github.com/tannerhelland/PhotoDemon/blob/master/Modules/Filters_ByteArray.bas#L40[/url]
    83.     Const NUM_ITERS     As Long = 3
    84.     Dim lIdx            As Long
    85.     Dim lIter           As Long
    86.     Dim dblTemp         As Double
    87.     Dim dblNu           As Double
    88.     Dim dblBndryScale   As Double
    89.     Dim dblPostScale    As Double
    90.  
    91.     ' Prep some IIR-specific values
    92.     dblTemp = Sqr(-(dblRadius * dblRadius) / (2 * Log(1# / 255#)))
    93.     If dblTemp <= 0 Then
    94.         dblTemp = 0.01
    95.     End If
    96.     dblTemp = dblTemp * (1# + (0.3165 * NUM_ITERS + 0.5695) / ((NUM_ITERS + 0.7818) * (NUM_ITERS + 0.7818)))
    97.     dblTemp = (dblTemp * dblTemp) / (2# * NUM_ITERS)
    98.     dblNu = (1# + 2# * dblTemp - Sqr(1# + 4# * dblTemp)) / (2# * dblTemp)
    99.     dblBndryScale = (1# / (1# - dblNu))
    100.     dblPostScale = ((dblNu / dblTemp) ^ (2# * NUM_ITERS)) * 255#
    101.     ' Copy the contents of the incoming byte array into the double array buffer
    102.     LoadSave dblBuffer(0, 0), 1# / 255#, lpBits + (lTop * lStride + lLeft) * 4 + lChannel, lStride, lWidth, lHeight, 0
    103.     ' Filter horizontally along each row
    104.     For lIdx = 0 To lHeight - 1
    105.         For lIter = 1 To NUM_ITERS
    106.             ProcessRow dblBuffer(0, lIdx), dblBndryScale, dblNu, 1, lWidth
    107.             ProcessRow dblBuffer(lWidth - 1, lIdx), dblBndryScale, dblNu, -1, lWidth
    108.         Next
    109.     Next
    110.     ' Now repeat all the above steps, but filtering vertically along each column, instead
    111.     For lIdx = 0 To lWidth - 1
    112.         For lIter = 1 To NUM_ITERS
    113.             ProcessRow dblBuffer(lIdx, 0), dblBndryScale, dblNu, lWidth, lHeight
    114.             ProcessRow dblBuffer(lIdx, lHeight - 1), dblBndryScale, dblNu, -lWidth, lHeight
    115.         Next
    116.     Next
    117.     ' Apply final post-scaling and copy back to byte array
    118.     LoadSave dblBuffer(0, 0), dblPostScale, lpBits + (lTop * lStride + lLeft) * 4 + lChannel, lStride, lWidth, lHeight, 1
    119.     '--- success
    120.     pvBlurChannel = True
    121. End Function
    122.  
    123. Private Sub LoadSave(dblPtr As Double, ByVal dblScale As Double, ByVal srcPtr As Long, ByVal lStride As Long, ByVal lWidth As Long, ByVal lHeight As Long, ByVal fSave As Long)
    124.     'void __stdcall LoadSave(double *ptr, double scale, unsigned char *src, int stride, int w, int h, int fsave) {
    125.     '    for(int j = 0; j < h; j++, src += 4*(stride - w)) {
    126.     '        for(int i = 0; i < w; i++, src += 4, ptr++) {
    127.     '            if (!fsave)
    128.     '                *ptr = *src * scale;
    129.     '            else {
    130.     '                int v = *ptr * scale;
    131.     '                *src = v > 0xFF ? 0xFF : v < 0 ? 0 : v;
    132.     '            }
    133.     '        }
    134.     '    }
    135.     '}
    136.     Const STR_THUNK     As String = "VYvsU4tdIIXbD46DAAAAi00Yi0UcK8jyDxBNDItVCMHhAlaJTRiLTRSLdRhXi30khcB+VYvwhf91FQ" & _
    137.                                     "+2AWYPbsDzD+bA8g9ZwfIPEQLrKfIPEALyD1nB8g8swD3/AAAAfge4/wAAAOsNhcDHRSAAAAAAD0hF" & _
    138.                                     "IIgBg8EEg8IIg+4BdbOLRRyLdRgDzoPrAXWgX15bXcIgAA=="
    139.     pvPatchThunk AddressOf mdBlurBitmap.LoadSave, STR_THUNK
    140.     LoadSave dblPtr, dblScale, srcPtr, lStride, lWidth, lHeight, fSave
    141. End Sub
    142.  
    143. Private Sub ProcessRow(dblPtr As Double, ByVal dblBndryScale As Double, ByVal dblNu As Double, ByVal lStep As Long, ByVal lSize As Long)
    144.     'void __stdcall ProcessRow(double *ptr, double bndry, double nu, int step, int size) {
    145.     '    double temp = (*ptr *= bndry);
    146.     '    ptr += step;
    147.     '    for(int i = 1; i < size; i++) {
    148.     '        temp = (*ptr += nu * temp);
    149.     '        ptr += step;
    150.     '    }
    151.     '}
    152.     Const STR_THUNK     As String = "VYvsi00Ii0UcVlfyDxABvwEAAADyD1lFDI0UxQAAAACLRSDyDxEBA8o7x3558g8QTRSD+AR+Vo1w+" & _
    153.                                     "8HuAkaNPLUBAAAAZmZmDx+EAAAAAADyD1nB8g9YAfIPEQEDyvIPWcHyD1gB8g8RAQPK8g9ZwfIPWA" & _
    154.                                     "HyDxEBA8ryD1nB8g9YAfIPEQEDyoPuAXXDO/h9FSvH8g9ZwfIPWAHyDxEBA8qD6AF17V9eXcIcAA=="
    155.     pvPatchThunk AddressOf mdBlurBitmap.ProcessRow, STR_THUNK
    156.     ProcessRow dblPtr, dblBndryScale, dblNu, lStep, lSize
    157. End Sub
    158.  
    159. Private Sub pvPatchThunk(ByVal pfn As Long, sThunkStr As String)
    160.     Dim lThunkSize      As Long
    161.     Dim lThunkPtr       As Long
    162.     Dim bInIDE          As Boolean
    163.  
    164.     '--- decode thunk
    165.     Call CryptStringToBinary(StrPtr(sThunkStr), Len(sThunkStr), CRYPT_STRING_BASE64, 0, lThunkSize, 0, 0)
    166.     lThunkPtr = VirtualAlloc(0, lThunkSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    167.     Call CryptStringToBinary(StrPtr(sThunkStr), Len(sThunkStr), CRYPT_STRING_BASE64, lThunkPtr, lThunkSize, 0, 0)
    168.     '--- patch func
    169.     Debug.Assert pvSetTrue(bInIDE)
    170.     If bInIDE Then
    171.         Call CopyMemory(pfn, ByVal pfn + &H16, 4)
    172.     Else
    173.         Call VirtualProtect(pfn, 8, PAGE_EXECUTE_READWRITE, 0)
    174.     End If
    175.     ' B8 00 00 00 00       mov         eax,00000000h
    176.     ' FF E0                jmp         eax
    177.     Call CopyMemory(ByVal pfn, 6333077358968.8504@, 8)
    178.     Call CopyMemory(ByVal (pfn Xor &H80000000) + 1 Xor &H80000000, lThunkPtr, 4)
    179. End Sub
    180.  
    181. Private Function pvSetTrue(bValue As Boolean) As Boolean
    182.     bValue = True
    183.     pvSetTrue = True
    184. End Function
    Final thoughts

    Note that BlurBitmap assumes GDI+ library is successfully initilized w/ GdiplusStartup at some point before calling it, so to be able to get a handle to a GDI+ bitmap.

    The function can be further enhanced with additional params to limit the area on the bitmap that blur effect is applied to. Just have to pass this rectangle to pvBlurChannel instead of 0, 0, uData.Width, uData.Height as it currently does.

    cheers,
    </wqw>

  2. #2
    Fanatic Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    678

    Re: [VB6] Blur effect on GDI+ bitmaps

    Quote Originally Posted by wqweto View Post
    For comparison you can check out some measurements of IIR filters and other Gaussian blur implementations in this post by Tanner.
    As in the post of Tanner of Mar 30th, 2015. PhotoModularFX is quoted, I want to clarify that now the performance of PhotoModularFX is much faster than what was said by that post.
    Now also PhotoModularFX implements the BLUR filter using IIR https://github.com/miorsoft/Site/iss...ment-402312096
    (Parameter "Mode" = Fast (IIR))

    BTW
    I have also implemented a fairly fast Edge Preserve Smoothing filter:
    https://github.com/miorsoft/Site/iss...ment-446013494
    https://github.com/miorsoft/Site/iss...ment-436457527
    http://www.vbforums.com/showthread.p...=1#post5342861

  3. #3

  4. #4

  5. #5
    New Member
    Join Date
    Jul 2020
    Posts
    3

    Re: [VB6] Blur effect on GDI+ bitmaps

    Hello!

    Thank you for the blur effect. Really cool!

    I need to blur a portion of the bitmap so I have changed the call to pvBlurChannel as you suggested to include the bounding rectangle, but it doesn't work.
    I get a black rectangle instead.
    Can you check this for me?

    Also, is there any reason to blur the alpha channel? It makes no sense, and really makes no difference...

  6. #6
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [VB6] Blur effect on GDI+ bitmaps

    Quote Originally Posted by DryBone View Post
    I need to blur a portion of the bitmap so I have changed the call to pvBlurChannel as you suggested to include the bounding rectangle, but it doesn't work.
    I get a black rectangle instead.
    Can you check this for me?
    Welcome to the forums

    I think you need to provide the rectangle, not change the parameters. Though, you didn't show what you did; so I'm just assuming.

    For example, to blur rectangle: 50,50 and 100 pixels each in width,height
    Code:
    ...
       Dim imgRect(0 To 3) As Long ' faux RECTI
       imgRect(0) = 50: imgRect(1) = 50  ' top/left
       imgRect(2) = 100: imgRect(3) = 100 ' width/height (not Right,Bottom like GDI rects)
    
       ' provide rect as 2nd parameter to:
       If GdipBitmapLockBits(hBitmap, imgRect(0), ImageLockModeRead Or ImageLockModeWrite, PixelFormat32bppARGB, uData) <> 0 Then
    
      ...
    One option to tweak the code:
    Code:
     ' add to declarations
    Public Type RECTI
        Left As Long
        Top As Long
        Width As Long
        Height As Long
    End Type
    
    Public Function BlurBitmap( _
                ByVal hBitmap As Long, _
                ByVal sngRadius As Single, _
                Optional ByVal AffectChannels As Long = 15, _
                Optional ptrRECTI As Long = 0) As Boolean
        Dim uData           As BitmapData
        Dim dblBuffer()     As Double 
     
        If GdipBitmapLockBits(hBitmap, ByVal ptrRECTI, ImageLockModeRead Or ImageLockModeWrite, PixelFormat32bppARGB, uData) <> 0 Then
            GoTo QH
        End If
    ...
    And a sample call:
    Code:
        Dim r As RECTI
        r.Left = 75: r.Top = 75: r.Width = 150: r.Height = 150
        ...
        BlurBitmap hImage, 5, , VarPtr(r)
    Last edited by LaVolpe; Jul 16th, 2020 at 03:34 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  7. #7
    New Member
    Join Date
    Jul 2020
    Posts
    3

    Re: [VB6] Blur effect on GDI+ bitmaps

    Great! Thanks a lot!

  8. #8

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6] Blur effect on GDI+ bitmaps

    Quote Originally Posted by DryBone View Post
    I need to blur a portion of the bitmap so I have changed the call to pvBlurChannel as you suggested to include the bounding rectangle, but it doesn't work.
    I get a black rectangle instead.
    Can you check this for me?
    Yes, there is a non-obvious precondition for partial blur to work -- the dimensions of the dblBuffer array has to match the dimensions of the rectangle you are passing for processing to pvBlurChannel. The original description to "just" pass the rectangle to pvBlurChannel is misleading.

    For instance if the rectangle is from (50, 50) to (399, 399) then the dimensions of dblBuffer has to be 350 by 350 too, i.e. use something like this

    ReDim dblBuffer(0 To lWidth - 1, 0 To lHeight - 1) As Double


    for this

    pvBlurChannel(uData.Scan0, uData.Stride \ 4, lLeft, lTop, lWidth, lHeight, sngRadius, 0, dblBuffer)


    to work on (lLeft, lTop) - (lLeft+lWidth-1, lTop+lHeight-1) rectangle.

    LaVolpe's approach is viable too but I didn't think about it when designing pvBlurChannel helper function.

    cheers,
    </wqw>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width