how convert VB6 to VB2010 code?

[.paul.]

While I appreciate the compliment, I don't consider myself an expert.

I do have a lot of experience with image processing but I still don't possess anywhere near the talent of true gods of the art like Tanner Helland or Olaf.

Knowing Olaf he could probably write a flood fill that works in microseconds.

From several seconds to less than 1/5th of a second, in a top-level language is quite an achievement though

[Niya]

From several seconds to less than 1/5th of a second, in a top-level language is quite an achievement though

BTW, I found where you got that algorithm from. You found it here most likely:
http://vb-helper.com/howto_net_unsafe_flood.html

I also just release that CodeBank entry I was talking about:-
https://www.vbforums.com/showthread....re-VB-Net-code

It has to be moved by a mod though. Posted it to the wrong forum by accident.

[EDIT]

I also found where you posted it on the forums originally:-
https://www.vbforums.com/showthread....=1#post3438045

[.paul.]

I also found where you posted it on the forums originally:-
https://www.vbforums.com/showthread....=1#post3438045

In 2009, it was the best i could find

I understood what the algorithm did, but the kludgy way it did it was what stopped me trying to rewrite it...

[Niya]

In 2009, it was the best i could find

I understood what the algorithm did, but the kludgy way it did it was what stopped me trying to rewrite it...

That's actually understandable. Back in the day no one really took Visual Basic seriously as a language of performance so all the super optimized algorithms were were written in the "elite" languages like C while we were left with the dregs.

[Schmidt]

Knowing Olaf he could probably write a flood fill that works in microseconds.

Nah, factor 1000 would be a bit much...

But I observe a speedup of about factor 11 (15.5msec for your large image), with this (VB6-code, native compiled, all Optimizations):

Sub RecFloodFill(Pxl() As Long, ByVal x As Long, ByVal y As Long, ByVal NewColor As Long)
  Dim xL As Long, xR As Long, OldColor As Long, UBx As Long, UBy As Long
  
  UBx = UBound(Pxl, 1): UBy = UBound(Pxl, 2)
  If x < 0 Or x > UBx Or y < 0 Or y > UBy Then Exit Sub
  If Pxl(x, y) = NewColor Then Exit Sub Else OldColor = Pxl(x, y)

  For xL = x To 1 Step -1 'find most left pixel
    If Pxl(xL - 1, y) <> OldColor Then Exit For
  Next xL
  For xR = x To UBx - 1 'find most right pixel
    If Pxl(xR + 1, y) <> OldColor Then Exit For
  Next xR
  For x = xL To xR: Pxl(x, y) = NewColor: Next 'fill this part

  'Recursion only in y-direction
  If y > 0 Then 'check scanline above
    For x = xL To xR
      If Pxl(x, y - 1) = OldColor Then RecFloodFill Pxl, x, y - 1, NewColor
    Next
  End If
  If y < UBy Then 'check scanline below
    For x = xL To xR
      If Pxl(x, y + 1) = OldColor Then RecFloodFill Pxl, x, y + 1, NewColor
    Next
  End If
End Sub

The above resembles a recursive-scanline-algo a bit, but comes with a few optimizations.

The function expects a 32bpp(BGRA) 2D-Pxl-Array as input (e.g. retrievable via SafeArray-mappings) -
and the NewColor-Param needs to be given in BGRA-format as well.

Here's a complete example, which is using Cairo-32bpp-Surfaces (which are internally BGRA as well):
(VB6-Project needs an RC6-reference, to work)

Option Explicit

Private Sub Form_Click()
  Dim Srf As cCairoSurface, Pxl() As Long
  Set Srf = Cairo.ImageList.AddImage("", "C:\temp\large.png")
  
  New_c.Timing True
    Srf.BindToArrayLong Pxl
        RecFloodFill Pxl, 1, 1, &HFF0000FF 'BGRA-blue with full opacity
    Srf.ReleaseArrayLong Pxl
  Caption = New_c.Timing
  
  Srf.WriteContentToPngFile "C:\temp\large_green.png"
End Sub

Sub RecFloodFill(Pxl() As Long, ByVal x As Long, ByVal y As Long, ByVal NewColor As Long)
  Dim xL As Long, xR As Long, OldColor As Long, UBx As Long, UBy As Long
  
  UBx = UBound(Pxl, 1): UBy = UBound(Pxl, 2)
  If x < 0 Or x > UBx Or y < 0 Or y > UBy Then Exit Sub
  If Pxl(x, y) = NewColor Then Exit Sub Else OldColor = Pxl(x, y)

  For xL = x To 1 Step -1 'find most left pixel
    If Pxl(xL - 1, y) <> OldColor Then Exit For
  Next xL
  For xR = x To UBx - 1 'find most right pixel
    If Pxl(xR + 1, y) <> OldColor Then Exit For
  Next xR
  For x = xL To xR: Pxl(x, y) = NewColor: Next 'fill this part

  'Recursion only in y-direction
  If y > 0 Then 'check scanline above
    For x = xL To xR
      If Pxl(x, y - 1) = OldColor Then RecFloodFill Pxl, x, y - 1, NewColor
    Next
  End If
  If y < UBy Then 'check scanline below
    For x = xL To xR
      If Pxl(x, y + 1) = OldColor Then RecFloodFill Pxl, x, y + 1, NewColor
    Next
  End If
End Sub

Olaf

[joaquim]

Niya: i'm trying testing your gray function:

Private Sub ConvertToGrayScale(ByVal bmp As Bitmap)

        'Lock the bitmap so we could read and write it's pixels
        Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height),
                                 Imaging.ImageLockMode.ReadWrite,
                                 Imaging.PixelFormat.Format32bppArgb)


        'Memory layout BGRA
        For i As Integer = 0 To ((bmpData.Stride * bmpData.Height) / 4) - 1

            'Calculate pointer to current pixel
            Dim ptr = IntPtr.Add(bmpData.Scan0, i * 4)

            'Read current pixel
            Dim pix As BGRA = Marshal.PtrToStructure(Of BGRA)(ptr)

            'Calculate the shade of gray for the current pixel
            Dim gray As Integer = pix.R * 0.299 + pix.G * 0.587 + pix.B * 0.114

            'Change the pixel to the gray we calculated
            pix.R = gray
            pix.G = gray
            pix.B = gray

            'Write pixel back to image
            Marshal.StructureToPtr(Of BGRA)(pix, ptr, False)
        Next

        'Unlock the bitmap and allow its use
        'with the updated pixel values
        bmp.UnlockBits(bmpData)

    End Sub

but i'm getting several errors... some i can fix but other i don't
the 'Option Strict' is on.
1 -

 'Memory layout BGRA
        For i As Integer = 0 To ((bmpData.Stride * bmpData.Height) / 4) - 1

i must convert that formula to Integer... it thinks it's a double lol:
"Error 1 Option Strict On disallows implicit conversions from 'Double' to 'Integer'."
i just convert it to integer... easy.... the VB2010 use caracteres for convert '4' to Integer? if so.. what are the others?;
2 -

Dim ptr = IntPtr.Add(bmpData.Scan0, i * 4)

what is the type of 'ptr'?
"Error 2 Option Strict On requires all variable declarations to have an 'As' clause."
3 -

'Read current pixel
            Dim pix As BGRA = Marshal.PtrToStructure(Of BGRA)(ptr)

"Error 3 Overload resolution failed because no accessible 'PtrToStructure' accepts this number of type arguments."
i don't know use the 'Marshal' library, maybe a link for i learn it.
4 - the 4 to 7 errors are like the 1st... i can fix them;
8 -

'Write pixel back to image
            Marshal.StructureToPtr(Of BGRA)(pix, ptr, False)

"Error 8 'Public Shared Sub StructureToPtr(structure As Object, ptr As System.IntPtr, fDeleteOld As Boolean)' has no type parameters and so cannot have type arguments."
i'm trying testing the code.. but i don't know nothing about 'Marshal' library\object

[.paul.]

Try this

For i As Integer = 0 To ((bmpData.Stride * bmpData.Height) / 4) - 1

To convert to integer, as the error says

For i As Integer = 0 To CInt((bmpData.Stride * bmpData.Height) / 4) - 1

The type of ptr

Dim ptr = IntPtr.Add(bmpData.Scan0, i * 4)

Dim ptr As IntPtr = IntPtr.Add(bmpData.Scan0, i * 4)