Construct an Outlined Image with GDI?

Question

I've done some research but drawn a blank. Is there anyway to achieve image outlining with GDI? I.e. transform this:

into this:

With the ability to have different stroke thicknesses and colors. In either vb.net or c# for winforms?

Answer 1

OK. Cracked it. This code is based on this answer HERE . I'm posting the answer here for anyone who's looking to do the same. Full details are HERE. You'll need to compile and use the library Gaussian Blur (aka SuperFastBlur) available HERE. Then you include the code at the end of this post and use it via:

Dim stroke As New Stroke
_image = stroke.Apply(_image, _strokeWidth, _strokeColor, _strokeBlur, _strokeLineJoin)

The parameters should be self explanatory. Some results:

Finally, the code:

Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Imports SuperfastBlur

Public Class Stroke
    Private stride As Integer = 0
    Private visited As Integer() = Nothing
    Private bytes As Byte() = Nothing
    Private borderdata As PointData = Nothing
    Private size As Size = Size.Empty
    Private outside As Boolean = False
    Private zeropoint As Point = New Point(-1, -1)


    Public Function Apply(bmp As Bitmap, strokeWidth As Integer, strokeColor As Color, strokeBlur As Integer, LineJoin As LineJoin) As Bitmap

        Dim borderedBmp As Bitmap = NewBitmapWithBorder(bmp, strokeWidth)

        Dim imgPointsArray As List(Of Point()) = Find(borderedBmp)

        Dim newBmp As Bitmap = New Bitmap(borderedBmp.Width, borderedBmp.Height)

        Using g As Graphics = Graphics.FromImage(newBmp)

            With g
                .PixelOffsetMode = PixelOffsetMode.HighQuality
                .CompositingMode = CompositingMode.SourceOver
                .InterpolationMode = InterpolationMode.HighQualityBilinear
                .SmoothingMode = SmoothingMode.AntiAlias
                .CompositingQuality = CompositingQuality.HighQuality
            End With

            For Each pointsArray As Point() In imgPointsArray

                DrawOutline(g, pointsArray, strokeColor, strokeWidth, LineCap.Round, LineJoin)

            Next

        End Using

        If strokeBlur > 0 Then
            Dim gblur = New GaussianBlur(newBmp)
            newBmp = gblur.Process(strokeBlur)
        End If

        Using g As Graphics = Graphics.FromImage(newBmp)
            g.DrawImage(borderedBmp, 0, 0)
        End Using

        Return newBmp

    End Function


    Private Sub DrawOutline(g As Graphics, points As Point(), penColor As Color, penSize As Single, cap As LineCap, lJoin As LineJoin)

        Using gp As GraphicsPath = New GraphicsPath(FillMode.Winding),
                                    pen As New Pen(penColor, penSize) With {.LineJoin = lJoin, .StartCap = cap, .EndCap = cap},
                                    widenPen As New Pen(penColor, 1.0F)
            gp.AddCurve(points)
            gp.Widen(widenPen)
            g.DrawPath(pen, gp)
        End Using

    End Sub


    Private Function NewBitmapWithBorder(ByVal bmp As Bitmap, ByVal Optional borderSize As Integer = 0) As Bitmap
        Dim newWidth As Integer = bmp.Width + (borderSize * 2)
        Dim newHeight As Integer = bmp.Height + (borderSize * 2)
        Dim newImage As Image = New Bitmap(newWidth, newHeight)

        Using gfx As Graphics = Graphics.FromImage(newImage)

            Using border As Brush = New SolidBrush(Color.Transparent)
                ' gfx.FillRectangle(border, 0, 0, newWidth, newHeight)
            End Using

            gfx.DrawImage(bmp, New Rectangle(borderSize, borderSize, bmp.Width, bmp.Height))
        End Using

        Return CType(newImage, Bitmap)
    End Function

    Public Function Find(ByVal bmp As Bitmap, ByVal Optional outside As Boolean = True) As List(Of Point())
        Me.outside = outside
        Dim border As List(Of Point) = New List(Of Point)()
        Dim bmpdata As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.[ReadOnly], PixelFormat.Format32bppArgb)
        stride = bmpdata.Stride
        bytes = New Byte(bmp.Width * bmp.Height * 4 - 1) {}
        size = bmp.Size
        Marshal.Copy(bmpdata.Scan0, bytes, 0, bytes.Length)
        borderdata = getBorderData(bytes)
        bmp.UnlockBits(bmpdata)
        Dim regions As List(Of List(Of Point)) = New List(Of List(Of Point))()

        While borderdata.PointCount > 0
            Dim region As List(Of Point) = New List(Of Point)()
            Dim valid As Boolean = True
            Dim startpos As Point = getFirstPoint(borderdata)
            visited = New Integer(bmp.Size.Width * bmp.Size.Height - 1) {}
            region.Add(startpos)
            Dim current As Point = getNextPoint(startpos)

            If current <> zeropoint Then
                visited(current.Y * bmp.Width + current.X) += 1
                region.Add(current)
            End If

            If current = zeropoint Then valid = False

            While Not current.Equals(startpos) AndAlso valid
                Dim pos = current

                If visited(current.Y * bmp.Width + current.X) < 2 Then
                    current = getNextPoint(pos)
                    visited(pos.Y * bmp.Width + pos.X) += 1
                    If current = zeropoint Then current = getNextPointBackwards(pos)
                Else
                    current = getNextPointBackwards(pos)
                End If

                If current = zeropoint Then
                    valid = False
                    Exit While
                End If

                visited(current.Y * bmp.Width + current.X) += 1
                region.Add(current)
            End While

            For Each p In region
                borderdata.SetPoint(p.Y * bmp.Width + p.X, False)
            Next

            If valid Then regions.Add(region)
        End While

        For Each region In regions
            Dim duplicatedpos As Integer = -1
            Dim duplicatecheck As Boolean() = New Boolean(size.Width * size.Height - 1) {}
            Dim length As Integer = region.Count

            For i As Integer = 0 To length - 1
                Dim p = region(i)

                If duplicatecheck(p.Y * size.Width + p.X) Then
                    duplicatedpos = i - 1
                    Exit For
                End If

                duplicatecheck(p.Y * size.Width + p.X) = True
            Next

            If duplicatedpos = -1 Then Continue For
            If duplicatedpos <> ((region.Count - 1) / 2) Then Continue For
            Dim reversed As Boolean = True

            For i As Integer = 0 To duplicatedpos - 1

                If region(duplicatedpos - i - 1) <> region(duplicatedpos + i + 1) Then
                    reversed = False
                    Exit For
                End If
            Next

            If Not reversed Then Continue For
            region.RemoveRange(duplicatedpos + 1, region.Count - duplicatedpos - 1)
        Next

        Dim tempregions As List(Of List(Of Point)) = New List(Of List(Of Point))(regions)
        regions.Clear()
        Dim connected As Boolean = True

        While connected
            connected = False

            For Each region In tempregions
                Dim connectionpos As Integer = -1
                Dim connectionregion As Integer = -1
                Dim pointstart As Point = region.First()
                Dim pointend As Point = region.Last()

                For ir As Integer = 0 To regions.Count - 1
                    Dim otherregion = regions(ir)
                    If region Is otherregion Then Continue For

                    For ip As Integer = 0 To otherregion.Count - 1
                        Dim p = otherregion(ip)

                        If (isConnected(pointstart, p) AndAlso isConnected(pointend, p)) OrElse (isConnected(pointstart, p) AndAlso isConnected(pointstart, p)) Then
                            connectionregion = ir
                            connectionpos = ip
                        End If

                        If (isConnected(pointend, p) AndAlso isConnected(pointend, p)) Then
                            region.Reverse()
                            connectionregion = ir
                            connectionpos = ip
                        End If
                    Next
                Next

                If connectionpos = -1 Then
                    regions.Add(region)
                Else
                    regions(connectionregion).InsertRange(connectionpos, region)
                End If
            Next

            tempregions = New List(Of List(Of Point))(regions)
            regions.Clear()
        End While

        Dim returnregions As List(Of Point()) = New List(Of Point())()

        For Each region In tempregions
            returnregions.Add(region.ToArray())
        Next

        Return returnregions
    End Function

    Private Function isConnected(ByVal p0 As Point, ByVal p1 As Point) As Boolean
        If p0.X = p1.X AndAlso p0.Y - 1 = p1.Y Then Return True
        If p0.X + 1 = p1.X AndAlso p0.Y - 1 = p1.Y Then Return True
        If p0.X + 1 = p1.X AndAlso p0.Y = p1.Y Then Return True
        If p0.X + 1 = p1.X AndAlso p0.Y + 1 = p1.Y Then Return True
        If p0.X = p1.X AndAlso p0.Y + 1 = p1.Y Then Return True
        If p0.X - 1 = p1.X AndAlso p0.Y + 1 = p1.Y Then Return True
        If p0.X - 1 = p1.X AndAlso p0.Y = p1.Y Then Return True
        If p0.X - 1 = p1.X AndAlso p0.Y - 1 = p1.Y Then Return True
        Return False
    End Function

    Private Function getNextPoint(ByVal pos As Point) As Point
        If pos.Y > 0 Then
            Dim x As Integer = pos.X
            Dim y As Integer = pos.Y - 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.Y > 0 AndAlso pos.X < size.Width - 1 Then
            Dim x As Integer = pos.X + 1
            Dim y As Integer = pos.Y - 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.X < size.Width - 1 Then
            Dim x As Integer = pos.X + 1
            Dim y As Integer = pos.Y

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.X < size.Width - 1 AndAlso pos.Y < size.Height - 1 Then
            Dim x As Integer = pos.X + 1
            Dim y As Integer = pos.Y + 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.Y < size.Height - 1 Then
            Dim x As Integer = pos.X
            Dim y As Integer = pos.Y + 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.Y < size.Height - 1 AndAlso pos.X > 0 Then
            Dim x As Integer = pos.X - 1
            Dim y As Integer = pos.Y + 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.X > 0 Then
            Dim x As Integer = pos.X - 1
            Dim y As Integer = pos.Y

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        If pos.X > 0 AndAlso pos.Y > 0 Then
            Dim x As Integer = pos.X - 1
            Dim y As Integer = pos.Y - 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If
            End If
        End If

        Return zeropoint
    End Function

    Private Function getNextPointBackwards(ByVal pos As Point) As Point
        Dim backpoint As Point = zeropoint
        Dim trys As Integer = 0

        If pos.X > 0 AndAlso pos.Y > 0 Then
            Dim x As Integer = pos.X - 1
            Dim y As Integer = pos.Y - 1

            If ValidPoint(x, y) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.X > 0 Then
            Dim x As Integer = pos.X - 1
            Dim y As Integer = pos.Y

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.Y < size.Height - 1 AndAlso pos.X > 0 Then
            Dim x As Integer = pos.X - 1
            Dim y As Integer = pos.Y + 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.Y < size.Height - 1 Then
            Dim x As Integer = pos.X
            Dim y As Integer = pos.Y + 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.X < size.Width - 1 AndAlso pos.Y < size.Height - 1 Then
            Dim x As Integer = pos.X + 1
            Dim y As Integer = pos.Y + 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.X < size.Width - 1 Then
            Dim x As Integer = pos.X + 1
            Dim y As Integer = pos.Y

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.Y > 0 AndAlso pos.X < size.Width - 1 Then
            Dim x As Integer = pos.X + 1
            Dim y As Integer = pos.Y - 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        If pos.Y > 0 Then
            Dim x As Integer = pos.X
            Dim y As Integer = pos.Y - 1

            If (ValidPoint(x, y)) AndAlso HasNeighbor(x, y) Then

                If visited(y * size.Width + x) = 0 Then
                    Return New Point(x, y)
                End If

                If backpoint = zeropoint OrElse trys > visited(y * size.Width + x) Then
                    backpoint = New Point(x, y)
                    trys = visited(y * size.Width + x)
                End If
            End If
        End If

        Return backpoint
    End Function

    Private Function ValidPoint(ByVal x As Integer, ByVal y As Integer) As Boolean
        Return (borderdata(y * size.Width + x))
    End Function

    Private Function HasNeighbor(ByVal x As Integer, ByVal y As Integer) As Boolean
        If y > 0 Then

            If Not borderdata((y - 1) * size.Width + x) Then
                Return True
            End If
        ElseIf ValidPoint(x, y) Then
            Return True
        End If

        If x < size.Width - 1 Then

            If Not borderdata(y * size.Width + (x + 1)) Then
                Return True
            End If
        ElseIf ValidPoint(x, y) Then
            Return True
        End If

        If y < size.Height - 1 Then

            If Not borderdata((y + 1) * size.Width + x) Then
                Return True
            End If
        ElseIf ValidPoint(x, y) Then
            Return True
        End If

        If x > 0 Then

            If Not borderdata(y * size.Width + (x - 1)) Then
                Return True
            End If
        ElseIf ValidPoint(x, y) Then
            Return True
        End If

        Return False
    End Function

    Private Function getFirstPoint(ByVal data As PointData) As Point
        Dim startpos As Point = zeropoint

        For y As Integer = 0 To size.Height - 1

            For x As Integer = 0 To size.Width - 1

                If data(y * size.Width + x) Then
                    startpos = New Point(x, y)
                    Return startpos
                End If
            Next
        Next

        Return startpos
    End Function

    Private Function getBorderData(ByVal bytes As Byte()) As PointData
        Dim isborderpoint As PointData = New PointData(size.Height * size.Width)
        Dim prevtrans As Boolean = False
        Dim currenttrans As Boolean = False

        For y As Integer = 0 To size.Height - 1
            prevtrans = False

            For x As Integer = 0 To size.Width

                If x = size.Width Then

                    If Not prevtrans Then
                        isborderpoint.SetPoint(y * size.Width + x - 1, True)
                    End If

                    Continue For
                End If

                currenttrans = bytes(y * stride + x * 4 + 3) = 0
                If x = 0 AndAlso Not currenttrans Then isborderpoint.SetPoint(y * size.Width + x, True)
                If prevtrans AndAlso Not currenttrans Then isborderpoint.SetPoint(y * size.Width + x - 1, True)
                If Not prevtrans AndAlso currenttrans AndAlso x <> 0 Then isborderpoint.SetPoint(y * size.Width + x, True)
                prevtrans = currenttrans
            Next
        Next

        For x As Integer = 0 To size.Width - 1
            prevtrans = False

            For y As Integer = 0 To size.Height

                If y = size.Height Then

                    If Not prevtrans Then
                        isborderpoint.SetPoint((y - 1) * size.Width + x, True)
                    End If

                    Continue For
                End If

                currenttrans = bytes(y * stride + x * 4 + 3) = 0
                If y = 0 AndAlso Not currenttrans Then isborderpoint.SetPoint(y * size.Width + x, True)
                If prevtrans AndAlso Not currenttrans Then isborderpoint.SetPoint((y - 1) * size.Width + x, True)
                If Not prevtrans AndAlso currenttrans AndAlso y <> 0 Then isborderpoint.SetPoint(y * size.Width + x, True)
                prevtrans = currenttrans
            Next
        Next

        Return isborderpoint
    End Function
End Class

Class PointData
    Private points As Boolean() = Nothing
    Private validpoints As Integer = 0

    Public Sub New(ByVal length As Integer)
        points = New Boolean(length - 1) {}
    End Sub

    Public ReadOnly Property PointCount As Integer
        Get
            Return validpoints
        End Get
    End Property

    Public Sub SetPoint(ByVal pos As Integer, ByVal state As Boolean)
        If points(pos) <> state Then

            If state Then
                validpoints += 1
            Else
                validpoints -= 1
            End If
        End If

        points(pos) = state
    End Sub

    Default Public ReadOnly Property Item(ByVal pos As Integer) As Boolean
        Get
            Return points(pos)
        End Get
    End Property
End Class