Can this code be speeded up ? Picturebox mask

[CdRsKuLL]

Public Function transpicture(ByVal pic As PictureBox)
        Dim x As Integer, y As Integer
        Dim bmp As New Bitmap(pic.Image)
        Dim gp As New System.Drawing.Drawing2D.GraphicsPath
        Dim mask As Color = bmp.GetPixel(0, 0)

        For x = 0 To bmp.Width - 1
            For y = 0 To bmp.Height - 1
                If Not bmp.GetPixel(x, y).Equals(mask) Then
                    gp.AddRectangle(New Rectangle(x, y, 1, 1))
                End If
            Next
        Next

        pic.Region = New System.Drawing.Region(gp)
        bmp.Dispose()
    End Function

Is there a way to speed up this code at all, maybe a diffeent way of doing it. I am placing the picturebox onto a moving map so I cant use the transparent option on a picturebox as it makes the whole picture disappear, this function does work, but it takes about 4 sec's to do the picture.

thanks

Steve

 

[JohnH]

LockBits is well known for faster image processing, but it is more difficult. I have translated your method using LockBits instead of GetPixel. Since you are only reading pixels I have simplified and grab all bytes into an array and unlock the bitmap again. The lockbits method can in other cases be used to both read and write byte values directly to the bitmap. Overall should give you 2-3 times speed improvement. Btw, your function doesn't return a value, change it to Sub method.

Sub lockbitsMethod(ByVal pic As PictureBox)
    Dim bTemp As New Bitmap(pic.Image)
    If bTemp.PixelFormat <> Imaging.PixelFormat.Format32bppArgb Then
        bTemp.Dispose()
        MsgBox("Only PixelFormat.Format32bppArgb supported here.")
    Else
        Dim mask As Color = bTemp.GetPixel(0, 0)
        Dim gp As New System.Drawing.Drawing2D.GraphicsPath
        'get bitmap data bytes
        Dim rct As New Rectangle(0, 0, bTemp.Width, bTemp.Height)
        Dim bTempData As Imaging.BitmapData = bTemp.LockBits(rct, Imaging.ImageLockMode.ReadOnly, bTemp.PixelFormat)
        Dim total_size As Integer = bTempData.Stride * bTempData.Height
        Dim ImageBytes(total_size) As Byte
        Runtime.InteropServices.Marshal.Copy(bTempData.Scan0, ImageBytes, 0, total_size)
        Dim strideTemp As Integer = bTempData.Stride
        bTemp.UnlockBits(bTempData)
        bTemp.Dispose()
        'analyze each pixel
        Dim red, green, blue As Byte, position As Integer
        For x As Integer = 0 To rct.Width - 1
            For y As Integer = 0 To rct.Height - 1
                position = (y * strideTemp) + (x * 4)
                blue = ImageBytes(position)
                green = ImageBytes(position + 1)
                red = ImageBytes(position + 2)
                If Not (mask.R = red AndAlso mask.B = blue AndAlso mask.G = green) Then
                    gp.AddRectangle(New Rectangle(x, y, 1, 1))
                End If
            Next
        Next
        pic.Region = New System.Drawing.Region(gp)
    End If
End Sub

 

[JohnH]

The above post present the improvement between GetPixel and Lockbits for reading pixel data but it still use the "Region method from GraphicsPath" to make parts transparent. What the region method does then is to walk through the image yet again and set the alpha channel for all pixels not part of the region to value 0. Here is the same method, only this time I don't use Region but write the transparent pixels directly while analyzing the pixels. The speed improvement over the original getpixel/region method is from 300 to 1000 times better!

Sub lockbitsMethod2(ByVal pic As PictureBox)
    Dim bTemp As New Bitmap(pic.Image)
    If bTemp.PixelFormat <> Imaging.PixelFormat.Format32bppArgb Then
        bTemp.Dispose()
        MsgBox("Only PixelFormat.Format32bppArgb supported here.")
    Else
        Dim mask As Color = bTemp.GetPixel(0, 0)
        'get bitmap data bytes
        Dim rct As New Rectangle(0, 0, bTemp.Width, bTemp.Height)
        Dim bTempData As Imaging.BitmapData = bTemp.LockBits(rct, Imaging.ImageLockMode.ReadWrite, bTemp.PixelFormat)
        Dim total_size As Integer = bTempData.Stride * bTempData.Height
        Dim ImageBytes(total_size) As Byte
        Runtime.InteropServices.Marshal.Copy(bTempData.Scan0, ImageBytes, 0, total_size)
        Dim strideTemp As Integer = bTempData.Stride
        'analyze each pixel and set transparent pixels
        Dim red, green, blue As Byte, position As Integer
        For x As Integer = 0 To rct.Width - 1
            For y As Integer = 0 To rct.Height - 1
                position = (y * strideTemp) + (x * 4)
                blue = ImageBytes(position)
                green = ImageBytes(position + 1)
                red = ImageBytes(position + 2)
                If (mask.R = red AndAlso mask.B = blue AndAlso mask.G = green) Then
                    ImageBytes(position + 3) = 0 'sets the alpha channel
                End If
            Next
        Next
        'copy all the bytes back and unlock
        Runtime.InteropServices.Marshal.Copy(ImageBytes, 0, bTempData.Scan0, total_size)
        bTemp.UnlockBits(bTempData)
        pic.Image = bTemp
    End If
End Sub