how convert VB6 to VB2010 code?

Quote:

---

Originally Posted by Niya

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. :bigyello:

---

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

Quote:

---

Originally Posted by .paul.

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

---

:D

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

Quote:

---

Originally Posted by Niya

:D 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 :D

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

Quote:

---

Originally Posted by .paul.

In 2009, it was the best i could find :D

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. :(

Quote:

---

Originally Posted by Niya

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

---

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):

Code:

---

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)

Code:

---

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

Niya: i'm trying testing your gray function:

Code:

---

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 -

Code:

---

'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 -

Code:

---

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 -

Code:

---

'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 -

Code:

---

'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

Try this

Code:

---

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

---

To convert to integer, as the error says

Code:

---

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

---

The type of ptr

Code:

---

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

---

Code:

---

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

---