Building a Stroke Class to outline your images via GDI+

I won’t prattle on. The aim was to find a way to transform this image:

Into this image (done in GIMP):

All this within the restraints of a winforms app for .NET framework 3.5 (don’t ask..).

I found this excellent answer on StackOverflow. I amalgamated this with a few other techniques (the main one being a fast blurring class to provide the option of blurred edges to the stroke – to essentially produce Glow) and got things working. The answer does depend on a SuperFastBlur alghorithm (see here) which was written in C#. I couldn’t be bothered to convert it to VB.net, so I just compiled it into a library and included it in my project.

Then, you simply include the Classes at the bottom of this page (I just saved the all to a single file). To apply a Stroke to your image, you then just use:

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

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

_image is either Image or Bitmap and the other parameters should be self explanatory. Here are some results:

And some unexpected funky effects by changing LineJoin:

Not perfect, but not bad for GDI+?

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

Add an outline to images via GDI+ with .NET Framework

Building a Stroke Class to outline your images via GDI+

Be the first to comment

Leave a Reply Cancel reply

Keep Focussed

Automate publishing to your personal NuGet repo

MantisBT WordPress Plugin

SFXInstaller

VisualSVN auto backup script

GIMP Plugin – Search and Replace in Layer Names

Simple scheduled MySQL database backups with FTP offsite hosting

CBMStudioSVN