[VB6 - API] - selection of an item\image graphic effect

**joaquim** · Sep 13th, 2010, 04:32 AM

i'm build 1 code for show\select 1 item\object in an image.
for now i can show the item\object in that color selection, but i only need the selection in line way and show the item\object.

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Dim x As Long, y As Long
    Dim blnFirstPixel As Boolean
    Dim lngBackColor As Long
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    blnFirstPixel = False
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor And blnFirstPixel = False Then
                blnFirstPixel = True
                SetPixel Destination.hdc, x, y, SelectionColor
            ElseIf GetPixel(Source.hdc, x, y) <> lngBackColor And blnFirstPixel = True Then
                SetPixel Destination.hdc, x, y, SelectionColor
                blnFirstPixel = False
            ElseIf GetPixel(Source.hdc, x, y) = lngBackColor And blnFirstPixel = False Then
                SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
            Else
                SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

i have the blnFirstPixel for try do the line, but isn't correct

can anyone advice me?
see the image in selection of rectangule(from black to green). i want do the same in these sub selections of itens(what is in image). thanks

**MarMan** · Sep 13th, 2010, 08:03 AM

What are you trying to do? What is it doing now?

**joaquim** · Sep 13th, 2010, 11:07 AM

Originally Posted by MarMan

What are you trying to do? What is it doing now?

the object has a shape, i need border that shape?(sorry my english, but i'm trying express me)

**MarMan** · Sep 13th, 2010, 11:12 AM

I'm sorry, but I am having a very difficult time understanding what you need help with.

If you are trying to get a border, then examine the pixels until they change color.m When they change color, then you have the border.

**joaquim** · Sep 13th, 2010, 11:55 AM

Originally Posted by MarMan

I'm sorry, but I am having a very difficult time understanding what you need help with.

If you are trying to get a border, then examine the pixels until they change color.m When they change color, then you have the border.

see my actual sub:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Dim x As Long, y As Long
    Dim blnFirstPixel As Boolean
    Dim lngBackColor As Long
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    blnFirstPixel = False
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
                If blnFirstPixel = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirstPixel = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
                End If
            ElseIf GetPixel(Source.hdc, x, y) = lngBackColor Then
                If blnFirstPixel = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirstPixel = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

isn't working, but i will continue testing

**MarMan** · Sep 13th, 2010, 12:01 PM

I still don't know what you want, nor what is happening. But you can try this to see if it helps:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Dim x As Long, y As Long
    Dim blnFirstPixel As Boolean
    Dim lngBackColor As Long
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    blnFirstPixel = False
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
                If blnFirstPixel = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirstPixel = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
                End If
            ElseIf GetPixel(Source.hdc, x, y) = lngBackColor Then
                If blnFirstPixel = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirstPixel = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
                End If
            End If
        Next x
        blnFirstPixel = False 
    Next y
    Destination.Refresh
End Sub

**joaquim** · Sep 13th, 2010, 12:08 PM

see the image...
the girl is totaly green. but i only want in shape way(border) and show her normaly

**MarMan** · Sep 13th, 2010, 12:17 PM

Is that what your code does now? The above code makes her totally green?

**joaquim** · Sep 13th, 2010, 12:32 PM

Originally Posted by MarMan

Is that what your code does now? The above code makes her totally green?

no but i'ts easy change it. do you wan't that code?

**MarMan** · Sep 13th, 2010, 12:35 PM

Yes, if I am correct to say "I know what it is doing (making the whole girl green) and I know that you want just the outline, right?"

**joaquim** · Sep 13th, 2010, 12:37 PM

Originally Posted by MarMan

Yes, if I am correct to say "I know what it is doing (making the whole girl green) and I know that you want just the outline, right?"

yes

heres the code:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Dim x As Long, y As Long
    Dim blnFirstPixel As Boolean
    Dim lngBackColor As Long
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    blnFirstPixel = False
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                SetPixel Destination.hdc, x, y, SelectionColor
            ElseIf GetPixel(Source.hdc, x, y) = lngBackColor Then
                SetPixel Destination.hdc, x, y, GetPixel(Destination.hdc, x, y)
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

thanks for help me m8

**MarMan** · Sep 13th, 2010, 12:44 PM

Try this:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As  Integer
    Dim lngBackColor As Long
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                SetPixel Destination.hdc, x, y, SelectionColor
                intPixelCount = intPixelCount + 1
            End If
            If intPixelCount = LENGTH Then Exit For
        Next x
        intPixelCount = 0
    Next y
    Destination.Refresh
End Sub

You can make LENGTH a different value to get whatever outline you wish.

**joaquim** · Sep 13th, 2010, 12:50 PM

Originally Posted by MarMan

Try this:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As  Integer
    Dim lngBackColor As Long
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                SetPixel Destination.hdc, x, y, SelectionColor
                intPixelCount = intPixelCount + 1
            End If
            If intPixelCount = LENGTH Then Exit For
        Next x
        intPixelCount = 0
    Next y
    Destination.Refresh
End Sub

You can make LENGTH a different value to get whatever outline you wish.

works 99% in left

but why the length variable?

**MarMan** · Sep 13th, 2010, 12:56 PM

I though one pixel might be hard to see. I wanted to make sure you can see it, then you can shrink it to suit your needs. See if you can get the right edge, there will still be the top and bottom to work on too.

**joaquim** · Sep 13th, 2010, 01:32 PM

next results:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirst = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                    blnFirst = False
                End If
            Else
                SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

see the image

**MarMan** · Sep 13th, 2010, 01:40 PM

Try this:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnLast As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirst = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            Else
                If blnFirst = False Then
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                ElseIf Not blnLast 
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnLast = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

**joaquim** · Sep 13th, 2010, 02:59 PM

Originally Posted by MarMan

Try this:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnLast As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirst = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            Else
                If blnFirst = False Then
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                ElseIf Not blnLast 
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnLast = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

just copy the image
but i put in right side working:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirst = True
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            Else
                SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                blnFirst = False
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

**MarMan** · Sep 13th, 2010, 03:08 PM

Put some breakpoints in and follow the code. Change the color to see what it is doing. I can't run it here because I don't have VB6 so mess with it, follow the logic, you should get it.

**joaquim** · Sep 13th, 2010, 03:22 PM

Originally Posted by MarMan

Put some breakpoints in and follow the code. Change the color to see what it is doing. I can't run it here because I don't have VB6 so mess with it, follow the logic, you should get it.

ok.. almost done... but i see 2 problems:
1 - in same line don't continue;
2 - the border isn't large(not important, at least, for now).

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long)
    Const LENGTH = 3
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnEnter As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    blnFirst = True
                    blnEnter = True
                    SetPixel Destination.hdc, x, y, SelectionColor
                ElseIf blnEnter = True Then
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            Else
                blnFirst = False
                If blnEnter = True Then
                    SetPixel Destination.hdc, x, y, SelectionColor
                    blnFirst = False
                    blnEnter = False
                Else
                    SetPixel Destination.hdc, x, y, GetPixel(Source.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

**MarMan** · Sep 13th, 2010, 03:26 PM

Good! I don't know what you mean by #1. As for #2, that's why I put LENGTH in there. If you figure out how to put LENGTH back in, all you need to do is change the value and the size of the outline changes. If you can't get it I will help.

**joaquim** · Sep 13th, 2010, 03:34 PM

Originally Posted by MarMan

Good! I don't know what you mean by #1. As for #2, that's why I put LENGTH in there. If you figure out how to put LENGTH back in, all you need to do is change the value and the size of the outline changes. If you can't get it I will help.

i use it in diferent way

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnEnter As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    blnFirst = True
                    blnEnter = True
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                ElseIf blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            Else
                blnFirst = False
                If blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                    blnFirst = False
                    blnEnter = False
                Else
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

see the image and the little bug in top and the bottom, but i think i know why

**joaquim** · Sep 13th, 2010, 03:43 PM

see the new sub:

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnEnter As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If blnFirst = False Then
                    blnFirst = True
                    blnEnter = True
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                    If y = 0 Then
                        SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                        SetPixel Destination.hdc, PosX + x, PosY + y - 1, SelectionColor
                        SetPixel Destination.hdc, PosX + x, PosY + y - 2, SelectionColor
                    End If
                ElseIf blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            Else
                blnFirst = False
                If blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                    If y = Source.ScaleHeight - 1 Then
                        SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                        SetPixel Destination.hdc, PosX + x, PosY + y + 1, SelectionColor
                        SetPixel Destination.hdc, PosX + x, PosY + y + 2, SelectionColor
                    End If
                    blnFirst = False
                    blnEnter = False
                Else
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

the problem here is that when y=0 or y=source.scaleheight-1 is ignored

now i must do the same for X

**MarMan** · Sep 14th, 2010, 08:25 AM

Nice job!! Looks like you almost got it. The reason the top doesn't have an outline is because you are scanning from left to right, hiliting when you find the image (or after you found the image, finding the background). Also the way you have done it will be slower, but as long as you are happy with it, great!

**joaquim** · Sep 14th, 2010, 08:30 AM

Originally Posted by MarMan

Nice job!! Looks like you almost got it. The reason the top doesn't have an outline is because you are scanning from left to right, hiliting when you find the image (or after you found the image, finding the background). Also the way you have done it will be slower, but as long as you are happy with it, great!

for resolve that i do:

Code:

If y = 0 Then
                        SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                        SetPixel Destination.hdc, PosX + x, PosY + y - 1, SelectionColor
                        SetPixel Destination.hdc, PosX + x, PosY + y - 2, SelectionColor
                    End If

but seems to be ignored

**MarMan** · Sep 14th, 2010, 08:53 AM

You are only moving down. Try y-1 and y and y+1. But then you will have to take into consideration the first row. It is not ignored, it just isn't doing what you think, try stepping through the code. You can make the pixels flash between different colors to see what is really happening. It is important to understand what is going on if you wish to be a good programmer.

**joaquim** · Sep 14th, 2010, 08:57 AM

Originally Posted by MarMan

You are only moving down. Try y-1 and y and y+1. But then you will have to take into consideration the first row. It is not ignored, it just isn't doing what you think, try stepping through the code. You can make the pixels flash between different colors to see what is really happening. It is important to understand what is going on if you wish to be a good programmer.

"It is important to understand what is going on if you wish to be a good programmer" that's true

i had that problem for very days(copy image).... but i did step to step and i found the solution.... and in these sub too

**joaquim** · Sep 14th, 2010, 09:08 AM

finally the top and bottom are resolved

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnEnter As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If y = 0 And blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y - 1, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y - 2, SelectionColor
                End If
                If y = Source.ScaleHeight - 1 And blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y + 1, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y + 2, SelectionColor
                End If
                If x = 0 Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                End If
                
                If blnFirst = False Then
                    blnFirst = True
                    blnEnter = True
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                ElseIf blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            Else
                blnFirst = False
                If blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                    blnFirst = False
                    blnEnter = False
                Else
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            End If
        Next x
    Next y
    Destination.Refresh
End Sub

finally almost done

i don't have the lines here, but i'm problem resolve 1 bug in middle(when x=source.scalewidth-1)

but the rest seems ok... i will change the border way for a loop

**joaquim** · Sep 14th, 2010, 09:22 AM

finally hehehehe

Code:

Private Sub SelectionImage(Source As PictureBox, Destination As PictureBox, SelectionColor As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim x As Long, y As Long
    Dim intPixelCount As Integer
    Dim lngBackColor As Long
    Dim blnFirst As Boolean
    Dim blnEnter As Boolean
    lngBackColor = GetPixel(Source.hdc, 0, 0)
    For y = 0 To Source.ScaleHeight - 1
        For x = 0 To Source.ScaleWidth - 1
            If GetPixel(Source.hdc, x, y) <> lngBackColor Then
                If y = 0 And blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y - 1, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y - 2, SelectionColor
                End If
                If y = Source.ScaleHeight - 1 And blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y + 1, SelectionColor
                    SetPixel Destination.hdc, PosX + x, PosY + y + 2, SelectionColor
                End If
                If x = 0 Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                End If
                
                If blnFirst = False Then
                    blnFirst = True
                    blnEnter = True
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                ElseIf blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            Else
                blnFirst = False
                If blnEnter = True Then
                    SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 1, PosY + y, SelectionColor
                    SetPixel Destination.hdc, PosX + x - 2, PosY + y, SelectionColor
                    blnFirst = False
                    blnEnter = False
                Else
                    SetPixel Destination.hdc, PosX + x, PosY + y, GetPixel(Source.hdc, x, y)
                End If
            End If
            If x = Source.ScaleWidth - 1 And blnEnter = True Then
                SetPixel Destination.hdc, PosX + x, PosY + y, SelectionColor
                SetPixel Destination.hdc, PosX + x + 1, PosY + y, SelectionColor
                SetPixel Destination.hdc, PosX + x + 2, PosY + y, SelectionColor
            End If
        Next x
        
    Next y
    Destination.Refresh
End Sub

who is the best?!? hehehehe
weel i have tested in other images, but not works 100% in every images but works hehehehe

**MarMan** · Sep 14th, 2010, 09:36 AM

Looks Great!

**joaquim** · Sep 14th, 2010, 09:39 AM

Originally Posted by MarMan

Looks Great!

yes... thanks for everything... i will give you 1 thing for you play with it

Thread: [VB6 - API] - selection of an item\image graphic effect

Thread Tools

Display

[VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Re: [VB6 - API] - selection of an item\image graphic effect

Posting Permissions