PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
[VB6] Blur effect on GDI+ bitmaps-VBForums
Results 1 to 4 of 4

Thread: [VB6] Blur effect on GDI+ bitmaps

  1. #1

    Thread Starter
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,477

    [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
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    437

    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

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width