Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?-VBForums

# Thread: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

1. ## Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Hi,

i want algorithm VB or VBA to get all XY Coordinates of picture pixels colors in correct order to trace the contours edges to plot a vector shape of original picture.

i am able to get the coords of neighbors pixels but not in correct order.

2. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

What have you tried so far?

3. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Hi, Arnoutdv,

my algorithm to scan pixels is (but i not able to get the correct ordering of pixels to draw a shape):

Code:
```Private Sub GetPixels(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long

PixelCount = 0

For X = 0 To Picture1.ScaleWidth - 1
For Y = 0 To Picture1.ScaleHeight - 1
TempColor = GetPixel(Picture1.hdc, X, Y)
If TempColor <> BGColor Then
ReDim Preserve PixelStack(PixelCount)
PixelStack(PixelCount).X = X
PixelStack(PixelCount).Y = Y
PixelStack(PixelCount).Color = TempColor
PixelCount = PixelCount + 1
End If
Next
Next
End Sub```

4. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

I don't understand what you mean with the following:
... I'm not able to get the correct ordering of pixels to draw a shape ...
What ordering and what shape?

Do you have special reason to write this yourself?
There are already some tools available.

https://rasor.wordpress.com/2013/08/...nned-drawings/

5. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

each pixel (point) of image have a x,y coordinates, but the scan algorithm gives the coords by horizontal line of picture, line after line, but not in same contour arrange to i plot a autoshape vectorial image with Polyline function.

vectorization process.
i am not want other tools, i am need only the algorithm to get the correct arrange of coords of pixels.

thanks.

edit: i look other edge detections algorithms but not know arrange the coords.

6. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

It's just not a simple algorithm, it's very complex!

https://en.wikipedia.org/wiki/Edge_detection

7. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

i am have some examples in vb but i not sucess in give x y coords Because I'm using another VBA platform and not VB platform.

8. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

You are doing this from within Excel or some other Office application?
Most code is fairly compatible between VBA (MS Office) and VB6.

What samples did you find?

9. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

my problem: this code uses 3 picturebox and i not sucessful to work, i need simplify this code to uses only 1 or 2 picturebox and choose the color values more simply.

Another part of previous code, full code by Cyborg here:

File Type: zip outline.zip (5.3 KB, 245 views)

Code:
```Private Sub DrawOutline(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long
Picture1.Cls
For X = 0 To Picture1.ScaleWidth - 1
For Y = 0 To Picture1.ScaleHeight - 1
If GetPixel(Picture2.hdc, X, Y) = BGColor Then
If GetPixel(Picture2.hdc, X + 1, Y) <> BGColor Or GetPixel(Picture2.hdc, X - 1, Y) <> BGColor Then
If X <> Picture1.ScaleWidth - 1 And X <> 0 Then
SetPixelV Picture1.hdc, X, Y, vbBlack
End If
End If
If GetPixel(Picture2.hdc, X, Y + 1) <> BGColor Or GetPixel(Picture2.hdc, X, Y - 1) <> BGColor Then
If Y <> Picture1.ScaleHeight - 1 And Y <> 0 Then
SetPixelV Picture1.hdc, X, Y, vbBlack
End If
End If
End If
Next
Next
Picture1.Refresh
End Sub```

10. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

full source code of Form1.frm

Code:
```VERSION 5.00
Begin VB.Form Form1
Caption         =   "Outline by Cyborg - daniel_hansson@telia.com"
ClientHeight    =   8655
ClientLeft      =   60
ClientTop       =   345
ClientWidth     =   6825
ScaleHeight     =   8655
ScaleWidth      =   6825
StartUpPosition =   1  'CenterOwner
Begin VB.OptionButton Option2
Caption         =   "Store object info (click gradient pic to redraw)"
Height          =   975
Left            =   4440
TabIndex        =   4
Top             =   4800
Width           =   1575
End
Begin VB.OptionButton Option1
Caption         =   "Draw Outlines"
Height          =   495
Left            =   4440
TabIndex        =   3
Top             =   4320
Value           =   -1  'True
Width           =   1575
End
Begin VB.PictureBox Picture3
AutoRedraw      =   -1  'True
AutoSize        =   -1  'True
BackColor       =   &H00000000&
BorderStyle     =   0  'None
Height          =   4050
Left            =   120
Picture         =   "Form1.frx":0000
ScaleHeight     =   270
ScaleMode       =   3  'Pixel
ScaleWidth      =   276
TabIndex        =   2
Top             =   4200
Width           =   4140
End
Begin VB.PictureBox Picture2
AutoRedraw      =   -1  'True
AutoSize        =   -1  'True
BorderStyle     =   0  'None
Height          =   4050
Left            =   4440
Picture         =   "Form1.frx":3698A
ScaleHeight     =   270
ScaleMode       =   3  'Pixel
ScaleWidth      =   276
TabIndex        =   1
Top             =   120
Width           =   4140
Visible         =   0   'False
End
Begin VB.PictureBox Picture1
AutoRedraw      =   -1  'True
AutoSize        =   -1  'True
BorderStyle     =   0  'None
Height          =   4050
Left            =   120
Picture         =   "Form1.frx":6D314
ScaleHeight     =   270
ScaleMode       =   3  'Pixel
ScaleWidth      =   276
TabIndex        =   0
Top             =   120
Width           =   4140
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private Type PixelStackType
X As Single
Y As Single
Color As Long
End Type

Dim PixelStack() As PixelStackType
Dim PixelCount As Double

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Caption = "Working..."
If Option1.Value = True Then
DrawOutline GetPixel(Picture1.hdc, X, Y)
Picture1.Picture = Picture1.Image
Picture2.Picture = Picture1.Image
Else
GetPixels GetPixel(Picture1.hdc, X, Y)
End If
Me.Caption = "Done!"
End Sub

Private Sub DrawOutline(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long
Picture1.Cls
For X = 0 To Picture1.ScaleWidth - 1
For Y = 0 To Picture1.ScaleHeight - 1
If GetPixel(Picture2.hdc, X, Y) = BGColor Then
If GetPixel(Picture2.hdc, X + 1, Y) <> BGColor Or GetPixel(Picture2.hdc, X - 1, Y) <> BGColor Then
If X <> Picture1.ScaleWidth - 1 And X <> 0 Then
SetPixelV Picture1.hdc, X, Y, vbBlack
End If
End If
If GetPixel(Picture2.hdc, X, Y + 1) <> BGColor Or GetPixel(Picture2.hdc, X, Y - 1) <> BGColor Then
If Y <> Picture1.ScaleHeight - 1 And Y <> 0 Then
SetPixelV Picture1.hdc, X, Y, vbBlack
End If
End If
End If
Next
Next
Picture1.Refresh
End Sub

Private Sub GetPixels(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long

PixelCount = 0

For X = 0 To Picture1.ScaleWidth - 1
For Y = 0 To Picture1.ScaleHeight - 1
TempColor = GetPixel(Picture1.hdc, X, Y)
If TempColor <> BGColor Then
ReDim Preserve PixelStack(PixelCount)
PixelStack(PixelCount).X = X
PixelStack(PixelCount).Y = Y
PixelStack(PixelCount).Color = TempColor
PixelCount = PixelCount + 1
End If
Next
Next
End Sub

Private Sub RedrawPixels(X As Single, Y As Single)
Dim i As Long

For i = 0 To PixelCount - 1
SetPixelV Picture3.hdc, PixelStack(i).X + X - Picture3.ScaleWidth / 2, PixelStack(i).Y + Y - Picture3.ScaleHeight / 2, PixelStack(i).Color
Next
End Sub

Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture3.Cls
RedrawPixels X, Y
Picture3.Refresh
End If
End Sub```

11. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

You don't need the 3rd picture box, that's was just fore some other demo.
The 2nd picturebox is a copy from the 1st to always work on a clean unmodified image.

Code for 2 pictureboxes (1=main, 2=backup)
Code:
```Option Explicit

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As _
Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As _
Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private Type PixelStackType
X As Single
Y As Single
Color As Long
End Type

Dim PixelStack() As PixelStackType
Dim PixelCount As Double

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Caption = "Working..."
DrawOutline GetPixel(Picture1.hdc, X, Y)
Picture1.Picture = Picture1.Image
Picture2.Picture = Picture1.Image
Me.Caption = "Done!"
End Sub

Private Sub DrawOutline(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long
Picture1.Cls
For X = 0 To Picture1.ScaleWidth - 1
For Y = 0 To Picture1.ScaleHeight - 1
If GetPixel(Picture2.hdc, X, Y) = BGColor Then
If GetPixel(Picture2.hdc, X + 1, Y) <> BGColor Or GetPixel(Picture2.hdc, X - 1, Y) <> BGColor Then
If X <> Picture1.ScaleWidth - 1 And X <> 0 Then
SetPixelV Picture1.hdc, X, Y, vbBlack
End If
End If
If GetPixel(Picture2.hdc, X, Y + 1) <> BGColor Or GetPixel(Picture2.hdc, X, Y - 1) <> BGColor Then
If Y <> Picture1.ScaleHeight - 1 And Y <> 0 Then
SetPixelV Picture1.hdc, X, Y, vbBlack
End If
End If
End If
Next
Next
Picture1.Refresh
End Sub```

12. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Arnoutdv , thanks, i will test your code for some hous ( i am very slow).
but notice i not trully want trace the contour color over the picture only, i want get the coords of this outline.

i think i grab the coords instead this line "SetPixelV Picture1.hdc, X, Y, vbBlack"
after, i will plot the shape with this coords.

thanks
i will be back soon.

13. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Updated the sample by Cyborg to work with only 2 images.
The input image on which you click to trace a color
The output image on which the outline is drawn.

14. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Hi Arnoutdv , i need simulate or get the brightness of a picture on imagebox in Excel, please look, is to the same goal.

thanks!

16. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Hi, Arnoutdv ,

i am not understand is missing use Getpixel(s):

Code:
`Private Sub GetPixels(BGColor As Long)`
is missing like this:

Code:
`GetPixels GetPixel(lDC, PixelX1, PixelY1)`
cheers!

17. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Huh?
Did you try the program?

Partial source code:
Code:
```Private Sub GetPixels(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long

PixelCount = 0

For X = 0 To picOutline.ScaleWidth - 1
For Y = 0 To picOutline.ScaleHeight - 1
TempColor = GetPixel(picOutline.hdc, X, Y)
If TempColor <> BGColor Then
ReDim Preserve PixelStack(PixelCount)
PixelStack(PixelCount).X = X
PixelStack(PixelCount).Y = Y
PixelStack(PixelCount).Color = TempColor
PixelCount = PixelCount + 1
End If
Next
Next
End Sub```

18. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Hi, Arnoutdv,

I'm trying to adapt your code but I did not understand Where it is used the "Getpixel(s)"
in original code the function is called (GetPixel(s) GetPixel):

Code:
`GetPixels GetPixel(hdc, x, y)`
I will continue testing, I have not finished because Excel is more complicated to do.

19. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Sorry, but did you even read the source code?

If you click on the main image it retrieves the current color on the mouse-position using GetPixel.
Then this color is passed to DrawOutline, GetPixels() is not even used anymore

Code:
```Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As _
Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As _
Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private Type PixelStackType
X As Single
Y As Single
Color As Long
End Type

Dim PixelStack() As PixelStackType
Dim PixelCount As Double

picOutline.AutoRedraw = True
picOutline.BackColor = vbWhite
End Sub

Private Sub picImage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Caption = "Working..."
DrawOutline GetPixel(picImage.hdc, X, Y)
Me.Caption = "Done!"
End Sub

Private Sub DrawOutline(BGColor As Long)
Dim X As Single
Dim Y As Single
Dim TempColor As Long

'picOutline.Cls
For X = 0 To picOutline.ScaleWidth - 1
For Y = 0 To picOutline.ScaleHeight - 1
If GetPixel(picImage.hdc, X, Y) = BGColor Then
If GetPixel(picImage.hdc, X + 1, Y) <> BGColor Or GetPixel(picImage.hdc, X - 1, Y) <> BGColor Then
If X <> picOutline.ScaleWidth - 1 And X <> 0 Then
SetPixelV picOutline.hdc, X, Y, vbBlack
End If
End If
If GetPixel(picImage.hdc, X, Y + 1) <> BGColor Or GetPixel(picImage.hdc, X, Y - 1) <> BGColor Then
If Y <> picOutline.ScaleHeight - 1 And Y <> 0 Then
SetPixelV picOutline.hdc, X, Y, vbBlack
End If
End If
End If
Next
Next
picOutline.Refresh
End Sub

Private Sub picOutline_Click()
picOutline.Cls
End Sub```

20. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Arnoutdv, thank you very, very mutch!

i still testing, but in Excel this is more complex, the colors on Getpixel at mouse pointer not get directly to 2 ImageBox at same procedure, and more Setpixel at same procedure, i need passes the values of a procedure to other procedure or put all code in same procedure.

i have all thing to make this work, but i will have more time to check if work.
and my ultimate goal is rearrange the coordinates of x,y.

thanks!

21. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

I found this http://www.engineers-excel.com/Apps/...NewVersion.htm
maybe you found some clues about image manipulation in Excel

22. ## Re: Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?

Originally Posted by georgekar
I found this http://www.engineers-excel.com/Apps/...NewVersion.htm
maybe you found some clues about image manipulation in Excel
Thank you, georgekar ,
but it not the same thing.

i know this website, if you know some detail of this samples, file tell to me.

i need now to make "Arnoutdv" code to work :
"I want pass the coords X,Y mouse Pointer and color values of ImageControl to Other Procedure Not im same ImageControl."
"i able to get the values, but not retrieve on memory and pass to other procedure."

Code:
`    lColour1Image1 = GetPixel(lDC, X, Y)`

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•

Featured