Option Explicit On
Option Strict On

Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Net
Imports System.IO

Public Class Form1

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim Radius As Integer = 50
        Dim FileName As String = Path.Combine(Application.StartupPath, "sample.jpg")
        Dim URL As New Uri("http://yas-s.sakura.ne.jp/htdocs/?action=common_download_main&upload_id=23")
        If Not File.Exists(FileName) Then
            Using WC As New WebClient()
                WC.DownloadFile(URL, FileName)
            End Using
        End If
        Dim SampleImage As New Bitmap(FileName)
        Dim PictureBox1 As New PictureBox
        PictureBox1.Dock = DockStyle.Fill
        PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
        Me.Controls.Add(PictureBox1)
        Dim GPath As New GraphicsPath
        GPath.AddEllipse(90, 140, 280, 290)
        PictureBox1.Image = Blur(SampleImage, GPath, Radius, 0.9F)
        PictureBox1.Image.Save("./BlurImage.jpg", ImageFormat.Jpeg)
    End Sub

    Private Function Blur(SrcImage As Bitmap, GPath As GraphicsPath, Radius As Integer) As Bitmap
        Return Blur(SrcImage, GPath, Radius, 1.0)
    End Function

    Private Function Blur(SrcImage As Bitmap, GPath As GraphicsPath, Radius As Integer, Edge As Single) As Bitmap
        Dim RetImage As New Bitmap(SrcImage)
        Dim SrcImageRect As Rectangle = Rectangle.Round(GPath.GetBounds)
        Dim BlurImage As New Bitmap(SrcImageRect.Width, SrcImageRect.Height, PixelFormat.Format32bppArgb)
        Dim BlurImageRect As Rectangle = New Rectangle(0, 0, BlurImage.Width, BlurImage.Height)
        Using g As Graphics = Graphics.FromImage(BlurImage)
            g.DrawImage(SrcImage, BlurImageRect, SrcImageRect, GraphicsUnit.Pixel)
            Dim matrix As New Matrix
            matrix.Translate(-GPath.GetBounds.X, -GPath.GetBounds.Y)
            GPath.Transform(matrix)
            g.SetClip(GPath)
            GraphicsEx.DrawImageFx(g, BlurImage, BlurImageRect, Nothing, Nothing, Radius, False)
        End Using
        If Edge < 1.0 Then
            BlurImage = BlurEdge(BlurImage, GPath, Edge)
        End If
        Using g As Graphics = Graphics.FromImage(RetImage)
            g.DrawImage(BlurImage, SrcImageRect, BlurImageRect, GraphicsUnit.Pixel)
        End Using
        Return RetImage
    End Function

    Private Function BlurEdge(BlurImage As Bitmap, GPath As GraphicsPath, Edge As Single) As Bitmap
        Dim PixelFormat As PixelFormat = BlurImage.PixelFormat
        Dim PixelSize As Integer = Image.GetPixelFormatSize(PixelFormat) 8
        Dim ImageRect As Rectangle = Rectangle.Round(GPath.GetBounds)
        Using AlfaMap As New Bitmap(BlurImage.Width, BlurImage.Height, PixelFormat)
            Using g As Graphics = Graphics.FromImage(AlfaMap)
                Using GrBrush As New PathGradientBrush(GPath)
                    GrBrush.CenterColor = Color.White
                    GrBrush.SurroundColors = Color.Black
                    GrBrush.FocusScales = New PointF(Edge, Edge)
                    g.FillPath(GrBrush, GPath)
                End Using
            End Using
            Dim BlurData As BitmapData = BlurImage.LockBits(ImageRect, ImageLockMode.ReadWrite, PixelFormat)
            Dim BlurDataPtr As IntPtr = BlurData.Scan0
            Dim BlurDataPixels As Byte() = New Byte(BlurData.Stride * BlurImage.Height - 1) 
            Marshal.Copy(BlurDataPtr, BlurDataPixels, 0, BlurDataPixels.Length)
            Dim AlfaMapData As BitmapData = AlfaMap.LockBits(ImageRect, ImageLockMode.ReadWrite, PixelFormat)
            Dim AlfaMapDataPtr As IntPtr = AlfaMapData.Scan0
            Dim AlfaMapPixels As Byte() = New Byte(AlfaMapData.Stride * AlfaMap.Height - 1) 
            Marshal.Copy(AlfaMapDataPtr, AlfaMapPixels, 0, AlfaMapPixels.Length)
            For y As Integer = 0 To BlurData.Height - 1
                For x As Integer = 0 To BlurData.Width - 1
                    Dim Position As Integer = y * BlurData.Stride + x * Image.GetPixelFormatSize(BlurImage.PixelFormat) 8
                    BlurDataPixels(Position + 3) = AlfaMapPixels(Position)
                Next
            Next
            Marshal.Copy(BlurDataPixels, 0, BlurDataPtr, BlurDataPixels.Length)
            BlurImage.UnlockBits(BlurData)
            AlfaMap.UnlockBits(AlfaMapData)
        End Using
        Return BlurImage
    End Function

End Class

<StructLayout(LayoutKind.Sequential)>
Public Structure RECTF

    Property Left As Single
    Property Top As Single
    Property Right As Single
    Property Bottom As Single

    Public Sub New(ByVal Left As Single, ByVal Top As Single, ByVal Right As Single, ByVal Bottom As Single)
        Me._Left = Left
        Me._Top = Top
        Me._Right = Right
        Me._Bottom = Bottom
    End Sub

End Structure

<StructLayout(LayoutKind.Sequential, Pack:=1)>
Structure BlurParams

    Property Radius As Single
    Property ExpandEdges As Boolean

    Public Sub New(Radius As Single, ExpandEdges As Boolean)
        Me._Radius = Radius
        Me._ExpandEdges = ExpandEdges
    End Sub

End Structure

Public Enum Unit
    UnitWorld
    UnitDisplay
    UnitPixel
    UnitPoint
    UnitInch
    UnitDocument
    UnitMillimeter
End Enum

Public Class GraphicsEx

    <DllImport("gdiplus.dll", ExactSpelling:=True, CharSet:=CharSet.Unicode)>
    Public Shared Function GdipDrawImageFX(
        ByVal NativeGraphics As IntPtr,
        ByVal Image As IntPtr,
        ByRef SourceRect As RECTF,
        ByVal XForm As IntPtr,
        ByVal Effect As IntPtr,
        ByVal ImageAttributes As IntPtr,
        ByVal SrcUnit As Unit) As Integer
    End Function

    <DllImport("gdiplus.dll", ExactSpelling:=True, CharSet:=CharSet.Unicode)>
    Public Shared Function GdipSetEffectParameters(
        ByVal Effect As IntPtr,
        ByVal Params As IntPtr,
        ByVal Size As UInteger
        ) As Integer
    End Function

    <DllImport("gdiplus.dll", ExactSpelling:=True, CharSet:=CharSet.Unicode)>
    Public Shared Function GdipCreateEffect(
        ByVal Guid As Guid,
        ByRef Effect As IntPtr
        ) As Integer
    End Function

    <DllImport("gdiplus.dll", ExactSpelling:=True, CharSet:=CharSet.Unicode)>
    Public Shared Function GdipDeleteEffect(
        ByVal Effect As IntPtr
        ) As Integer
    End Function

    Private Shared ReadOnly BlurEffectGuid As Guid = New Guid("633C80A4-1843-482B-9EF2-BE2834C5FDD4")

    Private Const BINDING_FLAGS As BindingFlags = BindingFlags.GetField Or BindingFlags.Instance Or BindingFlags.NonPublic
    Private Shared NativeImage As FieldInfo = GetType(Bitmap).GetField("nativeImage", BINDING_FLAGS)
    Private Shared NativeGraphics As FieldInfo = GetType(Graphics).GetField("nativeGraphics", BINDING_FLAGS)
    Private Shared NativeMatrix As FieldInfo = GetType(Matrix).GetField("nativeMatrix", BINDING_FLAGS)
    Private Shared NativeImageAttributes As FieldInfo = GetType(ImageAttributes).GetField("nativeImageAttributes", BINDING_FLAGS)

    Public Shared Sub DrawImageFx(ByVal Graphics As Graphics, ByVal Image As Bitmap, ByVal SourceRect As Rectangle, ByVal XForm As Matrix, ByVal ImageAttributes As ImageAttributes, ByVal Radius As Integer, ByVal ExpandEdges As Boolean)
        Dim BlurParams As BlurParams = New BlurParams(Radius, ExpandEdges)
        Dim hBlurParams As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(BlurParams))
        Marshal.StructureToPtr(BlurParams, hBlurParams, True)
        Dim hEffect As IntPtr = IntPtr.Zero
        Dim Status As Integer = GdipCreateEffect(BlurEffectGuid, hEffect)
        GdipSetEffectParameters(hEffect, hBlurParams, CType(Marshal.SizeOf(BlurParams), UInteger))
        Dim hBitmap As IntPtr = If(Image Is Nothing, IntPtr.Zero, DirectCast(NativeImage.GetValue(Image), IntPtr))
        Dim hGraphics As IntPtr = If(Graphics Is Nothing, IntPtr.Zero, DirectCast(NativeGraphics.GetValue(Graphics), IntPtr))
        Dim hXForm As IntPtr = If(XForm Is Nothing, IntPtr.Zero, DirectCast(NativeMatrix.GetValue(XForm), IntPtr))
        Dim hImageAttributes As IntPtr = If(ImageAttributes Is Nothing, IntPtr.Zero, DirectCast(NativeImageAttributes.GetValue(ImageAttributes), IntPtr))
        Dim SourceRectF As RECTF = New RECTF(SourceRect.Top, SourceRect.Left, SourceRect.Right, SourceRect.Bottom)
        GdipDrawImageFX(hGraphics, hBitmap, SourceRectF, hXForm, hEffect, hImageAttributes, Unit.UnitPixel)
        GdipDeleteEffect(hEffect)
        Marshal.FreeHGlobal(hBlurParams)
    End Sub

End Class