3
\$\begingroup\$

This code is extremely slow and ideally I would appreciate someone walking me through getting this going on the GPU, but if nobody has time for that which is understandable, any and all optimisations would be most welcome!

Private Sub Picture(source As Image, picturebox As PictureBox)
    Dim r As Double
    Dim g As Double
    Dim b As Double

    Dim bmp As New Bitmap(source)
    Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
    Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.[ReadOnly], bmp.PixelFormat)
    Dim ptr As IntPtr = bmpData.Scan0
    Dim bytes As Integer = bmpData.Stride * bmp.Height
    Dim rgbValues As Byte() = New Byte(bytes - 1) {}
    System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)

    Dim linWhiteMult = 1 / (((LinearWhiteTextBox.Text * ((ShoulderStrengthTextBox.Text * LinearWhiteTextBox.Text) + (LinearAngleTextBox.Text * LinearStrengthTextBox.Text)) + (ToeStrengthTextBox.Text * ToeNumeratorTextBox.Text)) _
    / (LinearWhiteTextBox.Text * ((ShoulderStrengthTextBox.Text * LinearWhiteTextBox.Text) + LinearStrengthTextBox.Text) + ToeStrengthTextBox.Text * ToeDenominatorTextBox.Text) - (ToeNumeratorTextBox.Text / ToeDenominatorTextBox.Text)))

    'precalculations for optimisation

    Dim LaLs = LinearAngleTextBox.Text * LinearStrengthTextBox.Text
    Dim TsTn = ToeStrengthTextBox.Text * ToeNumeratorTextBox.Text
    Dim TsTd = ToeStrengthTextBox.Text * ToeDenominatorTextBox.Text
    Dim Tn_Td = ToeNumeratorTextBox.Text / ToeDenominatorTextBox.Text

    Dim list As New List(Of String)
    For x As Integer = 0 To bmp.Width - 1
        For y As Integer = 0 To bmp.Height - 1
            Dim position As Integer = (y * bmpData.Stride) + (x * Image.GetPixelFormatSize(bmpData.PixelFormat) / 8)
            b = rgbValues(position)
            g = rgbValues(position + 1)
            r = rgbValues(position + 2)

            '^2.2 lookup table (for optimisation) for gamma correction 

            b = table.Item(b)
            g = table.Item(g)
            r = table.Item(r)

'the following is the filmic tone map formula, i.e.
'x*(A*x+C*B)+D*E)/(x*(A*x+B)+D*F)) - E/F

            r = (((r * ((ShoulderStrengthTextBox.Text * r) + (LaLs)) + (TsTn)) _
                    / (r * ((ShoulderStrengthTextBox.Text * r) + LinearStrengthTextBox.Text) + TsTd) - (Tn_Td))) * linWhiteMult

            g = (((g * ((ShoulderStrengthTextBox.Text * g) + (LaLs)) + (TsTn)) _
                    / (g * ((ShoulderStrengthTextBox.Text * g) + LinearStrengthTextBox.Text) + TsTd) - (Tn_Td))) * linWhiteMult

            b = (((b * ((ShoulderStrengthTextBox.Text * b) + (LaLs)) + (TsTn)) _
                    / (b * ((ShoulderStrengthTextBox.Text * b) + LinearStrengthTextBox.Text) + TsTd) - (Tn_Td))) * linWhiteMult
            If r > 1 Then
                r = 1
            End If
            If g > 1 Then
                g = 1
            End If
            If b > 1 Then
                b = 1
            End If

            rgbValues(position) = Math.Round((b ^ 0.45) * 255)
            rgbValues(position + 1) = Math.Round((g ^ 0.45) * 255)
            rgbValues(position + 2) = Math.Round((r ^ 0.45) * 255)

        Next
    Next

    System.Runtime.InteropServices.Marshal.Copy(rgbValues, 0, ptr, bytes)

    bmp.UnlockBits(bmpData)

    ' apply the bmp to the avatars and dispose old

    Dim OldImage = picturebox.Image
    picturebox.Image = bmp
    OldImage.Dispose()

End Sub
\$\endgroup\$
  • \$\begingroup\$ Friend of mine pointed out that taking the string parsing out of the loop is an obvious way to speed it up - he was right, it's now lightning fast :) \$\endgroup\$ – Dr. Kaii Jul 30 '18 at 4:18
1
\$\begingroup\$

First, I have to say that you are using good variable names.

Turn Option Strict On

This setting is important, it'll help you see errors and needed conversion.

You'll notice that this isn't possible

Dim LaLs = LinearAngleTextBox.Text * LinearStrengthTextBox.Text

But instead you need to convert it to integer.

Dim LaLs = Int32.Parse(LinearAngleTextBox.Text) * Int32.Parse(LinearStrengthTextBox.Text)

Don't repeat yourself

You'll then notice that some conversions are done often.

Int32.Parse(LinearStrengthTextBox.Text)

Put these in proper variable right at the begining.

Dim linearStrength As Integer = Int32.Parse(LinearStrengthTextBox.Text)

There are formula like the below that are done in the inner loop, which can be moved outside of the loop.

(x * Image.GetPixelFormatSize(bmpData.PixelFormat) / 8)
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.