agajewski
asked on
How to scan a picture and paint pixels with black if their color value is FFFFFF
Hello,
I would like to make it so that when I open an image, all pixels of that image that have pure white value FFFFFF, would blink to 000000 color value and back to FFFFFF.
Is there a way I could do this?
I would like to make it so that when I open an image, all pixels of that image that have pure white value FFFFFF, would blink to 000000 color value and back to FFFFFF.
Is there a way I could do this?
if you just want to load a picture and then make any pixel with OLE_COLOR value FFFFFF black then i guess it would go something like this:
Private Sub LoadAndColorPic(PicBox As PictureBox, Pic As String)
Dim X As Long
Dim Y As Long
'first load it
PicBox.Picture = LoadPicture(Pic)
'now you want to overdraw any FFFFFF pixel with black
PicBox.ForeColor = &H0&
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = &HFFFFFF Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub Picture1_Click()
LoadAndColorPic Picture1, "c:\test.bmp"
End Sub
tested and works. but jpeg isnt the best format to test such a thing in. i suggest that you make a new white pic (in paint or so) and then you use spray can to make some other colors on it. then save as bmp. but whatever.
to chage the picture. simply change the: "c:\test.bmp" to what you want. and if your picturebox has another name just change: Picture1 to that name.
Enjoy
Private Sub LoadAndColorPic(PicBox As PictureBox, Pic As String)
Dim X As Long
Dim Y As Long
'first load it
PicBox.Picture = LoadPicture(Pic)
'now you want to overdraw any FFFFFF pixel with black
PicBox.ForeColor = &H0&
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = &HFFFFFF Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub Picture1_Click()
LoadAndColorPic Picture1, "c:\test.bmp"
End Sub
tested and works. but jpeg isnt the best format to test such a thing in. i suggest that you make a new white pic (in paint or so) and then you use spray can to make some other colors on it. then save as bmp. but whatever.
to chage the picture. simply change the: "c:\test.bmp" to what you want. and if your picturebox has another name just change: Picture1 to that name.
Enjoy
and now for the flash:
Dim iPic As String
Private Sub LoadAndColorPic(PicBox As PictureBox)
'first load it
PicBox.Picture = LoadPicture(iPic)
'now you want to overdraw any FFFFFF pixel with black
PicBox.ForeColor = &H0&
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = &HFFFFFF Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
Timer1.Enabled = True
End Sub
Private Sub Picture1_Click()
iPic = "c:\test.bmp"
LoadAndColorPic Picture1
End Sub
Private Sub Timer1_Timer()
Picture1.AutoRedraw = False
Picture1.Picture = LoadPicture(iPic)
Timer1.Enabled = False
End Sub
this form has a timer with an interval of 500 and the name Timer1 and a picturebox by the name Picture1
Dim iPic As String
Private Sub LoadAndColorPic(PicBox As PictureBox)
'first load it
PicBox.Picture = LoadPicture(iPic)
'now you want to overdraw any FFFFFF pixel with black
PicBox.ForeColor = &H0&
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = &HFFFFFF Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
Timer1.Enabled = True
End Sub
Private Sub Picture1_Click()
iPic = "c:\test.bmp"
LoadAndColorPic Picture1
End Sub
Private Sub Timer1_Timer()
Picture1.AutoRedraw = False
Picture1.Picture = LoadPicture(iPic)
Timer1.Enabled = False
End Sub
this form has a timer with an interval of 500 and the name Timer1 and a picturebox by the name Picture1
and the timer is disabled*
ASKER
Instead of reloading the picture all the time, how can load it once and then cache the pixels with FFFFFF value and keep going from FFFFFF to 000000 and then back to FFFFFF again and again?
Dim Black(0 To 293, 0 To 189) As Integer
Private Sub Color1(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = &HFFFFFF Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
Black(X, Y) = 1
End If
Next Y
Y = 0
Next X
End Sub
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("c:\test.bmp")
Color1 Picture1, &H0&
Timer1.Enabled = True
End Sub
Private Sub Color2(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub Timer1_Timer()
Color2 Picture1, &HFFFFFF
End Sub
this should do the job
Dim Black(0 To 293, 0 To 189) As Integer
293 is the picturebox scaleheight in pixels (ScaleHeight / 15) and 189 is the picturebox scalewidth in pixels (ScaleWidth / 15)
Private Sub Color1(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = &HFFFFFF Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
Black(X, Y) = 1
End If
Next Y
Y = 0
Next X
End Sub
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("c:\test.bmp")
Color1 Picture1, &H0&
Timer1.Enabled = True
End Sub
Private Sub Color2(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub Timer1_Timer()
Color2 Picture1, &HFFFFFF
End Sub
this should do the job
Dim Black(0 To 293, 0 To 189) As Integer
293 is the picturebox scaleheight in pixels (ScaleHeight / 15) and 189 is the picturebox scalewidth in pixels (ScaleWidth / 15)
Dim iPic As String
Dim Black(0 To 293, 0 To 189) As Integer
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("c:\test.bmp")
AnalyzeColors Picture1, &HFFFFFF
Do
XColor Picture1, &H0&
DoEvents
XColor Picture1, &HFFFFFF
DoEvents
Loop
End Sub
Private Sub XColor(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub AnalyzeColors(PicBox As PictureBox, ColorToRecord As OLE_COLOR)
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = ColorToRecord Then
Black(X, Y) = 1
End If
Next Y
Y = 0
Next X
End Sub
as you can see these functions cuts off the unnecesarry analyzation. and its a load faster. hope this helps
Dim Black(0 To 293, 0 To 189) As Integer
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("c:\test.bmp")
AnalyzeColors Picture1, &HFFFFFF
Do
XColor Picture1, &H0&
DoEvents
XColor Picture1, &HFFFFFF
DoEvents
Loop
End Sub
Private Sub XColor(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub AnalyzeColors(PicBox As PictureBox, ColorToRecord As OLE_COLOR)
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = ColorToRecord Then
Black(X, Y) = 1
End If
Next Y
Y = 0
Next X
End Sub
as you can see these functions cuts off the unnecesarry analyzation. and its a load faster. hope this helps
ASKER
Great...
One more thing... How can I resize the loaded picture to fit the window of picturebox? I have a picture with a size of 800x600 but the picturebox is only 400 width? I can't find stretch function for the loaded pic....
One more thing... How can I resize the loaded picture to fit the window of picturebox? I have a picture with a size of 800x600 but the picturebox is only 400 width? I can't find stretch function for the loaded pic....
on the picture box there is no Scale function. but its still possible to scale it.
Dim Black(0 To 1000, 0 To 1000) As Integer
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("c:\test.bmp")
Picture1.Width = ScaleX(Picture1.Picture.Wi
Picture1.Height = ScaleY(Picture1.Picture.He
DoEvents
AnalyzeColors Picture1, &HFFFFFF
Do
XColor Picture1, &H0&
DoEvents
XColor Picture1, &HFFFFFF
DoEvents
Loop
End Sub
Private Sub XColor(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub AnalyzeColors(PicBox As PictureBox, ColorToRecord As OLE_COLOR)
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = ColorToRecord Then
Black(X, Y) = 1
End If
Next Y
Y = 0
Next X
End Sub
this full code supports pictures with sizes up to 1000x1000.
change the values of Black(0 To 1000, 0 To 1000) to change the supported size
Dim Black(0 To 1000, 0 To 1000) As Integer
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("c:\test.bmp")
Picture1.Width = ScaleX(Picture1.Picture.Wi
Picture1.Height = ScaleY(Picture1.Picture.He
DoEvents
AnalyzeColors Picture1, &HFFFFFF
Do
XColor Picture1, &H0&
DoEvents
XColor Picture1, &HFFFFFF
DoEvents
Loop
End Sub
Private Sub XColor(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub AnalyzeColors(PicBox As PictureBox, ColorToRecord As OLE_COLOR)
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = ColorToRecord Then
Black(X, Y) = 1
End If
Next Y
Y = 0
Next X
End Sub
this full code supports pictures with sizes up to 1000x1000.
change the values of Black(0 To 1000, 0 To 1000) to change the supported size
the scalex and scaley functions converts from one scale format to another. i use them here to convert the pic's scale format from HiMetric(picturwe scale format) to Twips(controls scale format)
ASKER
>on the picture box there is no Scale function. but its still possible to scale it.
I don't want to scale the control to the size of picture, but I want to resize the loaded picture to fit the control of certain size.
I don't want to scale the control to the size of picture, but I want to resize the loaded picture to fit the control of certain size.
Picture1.Picture = LoadPicture("c:\test.bmp",
ASKER
I can't seem to find a way to resize the picture. Would it be possible to do all this with Image control?
i found it!
Dim Black(0 To 1000, 0 To 1000) As Integer
Private Sub Picture1_Click()
AnalyzeColors Picture1, &HFFFFFF
DoEvents
Do
XColor Picture1, &H0&
DoEvents
XColor Picture1, &HFFFFFF
DoEvents
Loop
End Sub
Private Sub XColor(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub AnalyzeColors(PicBox As PictureBox, ColorToRecord As OLE_COLOR)
PicBox.AutoRedraw = True
PicBox.Picture = LoadPicture("c:\test.cur")
PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleWidth
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = ColorToRecord Then
Black(X, Y) = 1
Else
Black(X, Y) = 0
End If
Next Y
Y = 0
Next X
End Sub
paste this into a form with only a picture control called Picture1
Dim Black(0 To 1000, 0 To 1000) As Integer
Private Sub Picture1_Click()
AnalyzeColors Picture1, &HFFFFFF
DoEvents
Do
XColor Picture1, &H0&
DoEvents
XColor Picture1, &HFFFFFF
DoEvents
Loop
End Sub
Private Sub XColor(PicBox As PictureBox, Color As OLE_COLOR)
PicBox.ForeColor = Color
PicBox.AutoRedraw = True
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If Black(X, Y) = 1 Then
PicBox.Line (X * 15, Y * 15)-((X + 1) * 15, (Y + 1) * 15)
End If
Next Y
Y = 0
Next X
End Sub
Private Sub AnalyzeColors(PicBox As PictureBox, ColorToRecord As OLE_COLOR)
PicBox.AutoRedraw = True
PicBox.Picture = LoadPicture("c:\test.cur")
PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleWidth
For X = 0 To PicBox.ScaleWidth / 15
For Y = 0 To PicBox.ScaleHeight / 15
If PicBox.Point(X * 15, Y * 15) = ColorToRecord Then
Black(X, Y) = 1
Else
Black(X, Y) = 0
End If
Next Y
Y = 0
Next X
End Sub
paste this into a form with only a picture control called Picture1
PicBox.Picture = LoadPicture("c:\test.cur")
ASKER
That works ok with the width, but the height is still not correct (Leaves out about 15% from the bottom of the picture)
do'h i made a big bummer.
PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleWidth
is supposted to be
PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleHeight
PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleWidth
is supposted to be
PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleHeight
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
How fast is this new code? Previous code was pretty slow analyzing all 6 million pixels. I am using this software to load a picture taken with 6mp digital camera and blinks all burned-out pixels whose value is FFFFFF. Analyzing all 6 million pixels took a long time.
ASKER
Wow that works just great! Thanks you so much!
Have a look: http://www.s5000.net/artur/evcheck/install.exe
This is the software I made with your help!
Thanks again!
Have a look: http://www.s5000.net/artur/evcheck/install.exe
This is the software I made with your help!
Thanks again!
well then do me a favor and accept the answer ;-)
ASKER
I thought I did already but here you go! Did you have a look at the app?
yea. its pretty nice :D howd' you make that windows installer? i think theres a flaw in the code. 'cuz when i try to open a pic without any white pixels it crashes telling me: Runtime Error: 13 Type Mismatch.
ive just checked. my code works ok with it. i think the problem lies in the % calculation ;-) just for your information
ive just checked. my code works ok with it. i think the problem lies in the % calculation ;-) just for your information
ASKER
I count each pixel found (totalPixels) and then each pixel painted black (countPixels).
percentage = (countPixels / totalPixels) * 100
percentage = Format(percentage, "###.##")
If the countPixels is 0, then ofcourse it will raise an error... Thanks for your help man!
I made the installation script with InnoScript at http://www.randem.com/innoscript.html
percentage = (countPixels / totalPixels) * 100
percentage = Format(percentage, "###.##")
If the countPixels is 0, then ofcourse it will raise an error... Thanks for your help man!
I made the installation script with InnoScript at http://www.randem.com/innoscript.html
assuming that when the error is produced that precentage = 0. add:
On Error Resume Next
above the percentage = (countPixels / totalPixels) * 100. and you should avoid the error
On Error Resume Next
above the percentage = (countPixels / totalPixels) * 100. and you should avoid the error
ASKER
Already did, thanks ;-)
ASKER
By the way, would you happen to know how do I measure instensity of each of the pixel in the image, meaning that black is 0 and white is 255 and then draw a histogram based on those values for each of intensity?
Hi,
Sorry to "get into" but the program is still under devlopping? (it has a few bugs... )
Regards
Sorry to "get into" but the program is still under devlopping? (it has a few bugs... )
Regards
ASKER
What kind of bugs? I implied this software into another one.
I downloaded the the software from the link above.
When I run it and try to transfer a multy photos I'm getting a runtime error (no.9 ?).
Another thing: to explor for photos at the windows, it is better to have a Windows-like styl explorer becuase to find photos, let say, on the DESKTOP I have to look for it under the subfolders........
Regards.
When I run it and try to transfer a multy photos I'm getting a runtime error (no.9 ?).
Another thing: to explor for photos at the windows, it is better to have a Windows-like styl explorer becuase to find photos, let say, on the DESKTOP I have to look for it under the subfolders........
Regards.
well this algorithm is NOT flawless, the problem is probably in there somewhere. also, the program you downloaded calculates % in a "not so good" way. eg. if theres no white pixels, it will produce an error. that might be the problem :)
ASKER