Image PIxel Color Coordinates Correct Orderind XY To Plot Shape ?-VBForums
Results 1 to 22 of 22

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

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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.

    please the code, thank you.

  2. #2
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

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

    What have you tried so far?

  3. #3

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

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

    Hi, Arnoutdv,

    thank you for your atention.


    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. #4
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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?

    It's not a trivial task.
    Do you have special reason to write this yourself?
    There are already some tools available.

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

  5. #5

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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.
    Last edited by xman2000; May 18th, 2017 at 07:54 AM.

  6. #6
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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. #7

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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. #8
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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. #9

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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:

    http://www.vbforums.com/showthread.p...pe-on-a-bitmap


    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. #10

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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
       LinkTopic       =   "Form1"
       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. #11
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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. #12

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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.

    edit: please look other my thread.
    http://www.vbforums.com/showthread.p...xcel-Worksheet

    "http://www.vbforums.com/showthread.php?847507-ImageControl-Brightness-propertie-on-Excel-Worksheet"

  13. #13
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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.
    Attached Files Attached Files

  14. #14

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

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

    "http://www.vbforums.com/showthread.php?847507-ImageControl-Brightness-propertie-on-Excel-Worksheet"
    http://www.vbforums.com/showthread.p...xcel-Worksheet

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

    thanks!

  15. #15
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

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

    Please don't refer to other questions threads multiple times.
    And don't forget to read post #13 in this thread.

  16. #16

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

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

    Hi, Arnoutdv ,

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

    your code have only this:

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

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

  17. #17
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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. #18

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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. #19
    PowerPoster
    Join Date
    Oct 2013
    Posts
    2,842

    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
    
    Private Sub Form_Load()
      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. #20

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

    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. #21
    Fanatic Member
    Join Date
    May 2014
    Location
    Preveza Greece
    Posts
    862

    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. #22

    Thread Starter
    Junior Member
    Join Date
    Jun 2016
    Posts
    26

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

    Quote Originally Posted by georgekar View Post
    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


Click Here to Expand Forum to Full Width

Survey posted by VBForums.