VB.Net Color Variation like in Autoit - vb.net

I have a simple pixelsearch function searching for a certain Argb Color on screen.
This already works great and it finds the pixel with the color but I would like to add a Color Variation detection to it.
The Color of the pixel it should detect changes sometimes from (255, 100, 100, 100) to (255, 110, 94, 102) or something else (values are changing 10 points). Now the Pixelsearch function should have a Variationdetection so it would detect pixels with a near similar color so instead of only searching for color (255, 100, 100, 100) it should also search for (255, 101, 99, 102)... and more.
Is it possible to code that instead of Dim each Color and search for it?
Thats the code that I have already:
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim xd3 = Color.FromArgb(255, 100, 100, 100) 'Searching for this color on the screen
Dim b As New Bitmap(2210, 1100) 'Position of Bitmap
Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(b)
g.CopyFromScreen(Me.Left, Me.Top, 0, 0, b.Size) 'Searching on Screen
For i = 0 To (Me.Width - 0) 'searching each pixel
For j = 0 To (Me.Height - 0) 'searching each pixel
If b.GetPixel(i, j) = xd3 Then 'If pixel has same color that im searching for it will show a messagebox true
MessageBox.Show("true")
End If
Next
Next
End Sub

I suggest something like this :
If Color_Is_In_The_Target_Variations(10, b.GetPixel(i, j), xd3) Then
MessageBox.Show("true")
End If
and
Private Function Color_Is_In_The_Target_Variations(variation As Integer, tested As Color, target As Color) As Boolean
If tested.R >= target.R - variation And tested.R <= target.R + variation And
tested.G >= target.G - variation And tested.G <= target.G + variation And
tested.B >= target.B - variation And tested.B <= target.B + variation Then
Return True
Else
Return False
End If
End Function

Related

Strolling Image - VB.net to get the latest colour

Need some guidance, the image below is scrolling on a website, from right to left, the colors will change between red or green, which are 255 values of each. Im not sure how i would do about seeing what the latest colour is as it scrolls, the example below shows that the red is the latest, but a few seconds ago the green was. Is there a way to say what the latest colour was.
I'm taking a BMP image off a window every 2 seconds, just after a textbox that says red or green. I cant see any example code of something similar on here, nor google.
Any help would be greatly appreciated.
Pete
You can search the bitmap for the target colors and add them into a Dictionary(Of Color, Point), add or update the value of each color in the dictionary (the point) whenever you find the key color at a greater X position. Use the LockBits approach to traverse the bitmap's bytes for faster and better performance.
When you have the dictionary filled with the required data, sort the values by their X properties in descending order and return the key (the color) of the first.
Imports System.Linq
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
' TODO: Find a better name...
Private Function GetLastColor(bmp As Bitmap, ParamArray colors() As Color) As Color
If bmp Is Nothing Then Return Color.Empty
' To work with 24-bit and 32-bit images...
Dim bpp = Image.GetPixelFormatSize(bmp.PixelFormat) \ 8
Dim bmpData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height),
ImageLockMode.ReadOnly, bmp.PixelFormat)
Dim bmpBuff((Math.Abs(bmpData.Stride) * bmpData.Height) - 1) As Byte
Marshal.Copy(bmpData.Scan0, bmpBuff, 0, bmpBuff.Length)
bmp.UnlockBits(bmpData)
Dim c As Color
Dim i As Integer
Dim dict As New Dictionary(Of Color, Point)
For y = 0 To bmp.Height - 1
For x = 0 To bmp.Width - 1
i = y * bmpData.Stride + x * bpp
c = Color.FromArgb(bmpBuff(i + 2), bmpBuff(i + 1), bmpBuff(i))
' Or color.ToArgb() = c.ToArgb() ...
If colors.Any(Function(color) Color.op_Equality(color, c)) Then
Dim p = New Point(x, y)
If Not dict.ContainsKey(c) Then
dict.Add(c, p)
ElseIf x > dict(c).X Then
dict(c) = p
End If
End If
Next
Next
If dict.Count > 0 Then
Return dict.OrderByDescending(Function(x) x.Value.X).First().Key
Else
Return Color.Empty
End If
End Function
Usage:
Sub Caller()
Dim c As Color = GetLastColor(
SomeBmp,
Color.FromArgb(255, 0, 0),
Color.FromArgb(0, 255, 0),
Color.FromArgb(0, 0, 255))
' TODO: ...
End Sub
Here's a demo creates an image every two seconds and fills small rectangles with random colors at random positions. The last rectangle is the one with a circle.

Draw centered in form on moving image

I'm trying to implement a small tool that draws sin and cos functions. The program is supposed to draw from the center of the form, so that the history will extend to the right. Imagine the following gif but with the right end of the line moving up and down, and the path to the left "showing the trace"
What I would like to do is, every time a timer elapses, draw a point (via Graphics.FillRectangle) in the center of a PictureBox. In the next timer fire move the graphics one pixel to the left, and draw the next pixel. This is what I have so far:
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
bmp = New Drawing.Bitmap(PictureBox1.Size.Width, PictureBox1.Size.Height)
g1 = Graphics.FromImage(bmp)
MathTimer = New Timers.Timer(30)
AddHandler MathTimer.Elapsed, AddressOf OnTimedEvent
MathTimer.Enabled = True
MathTimer.Start()
End Sub
Private Sub OnTimedEvent(source As Object, e As System.Timers.ElapsedEventArgs)
g1.FillRectangle(Brushes.Red, PictureBox1.Size.Width \ 2, PictureBox1.Size.Height \ 2, 1, 1)
g1.TranslateTransform(-1, 0)
PictureBox1.Image = bmp
End Sub
However, this doesn't achieve the desired effect, since the canvas of the graphics object g1 is moved to the left with this. Eventually it's not drawing anymore. (No wonder, since with this I'm drawing "with the left end of the line")
Anybody have a better idea that achieves the desired effect?
For i As Integer = 0 To pointsToDraw.Count - 2
Dim p As Point = pointsToDraw(i)
Dim xPos As Integer = (pctrBxSinCosDraw.Width / 2) + p.X - currentTick
e.Graphics.FillRectangle(Brushes.Black, xPos, CInt(p.Y + pctrBxSinCosDraw.Height / 2), 1, 1)
If xPos <= 0 Then
pointsToDraw.RemoveAt(i)
End If
Next
Where currentTick is set by a Timer, which on Tick, calculates the x/y values:
Dim yVal As Double
If useSinCalc Then
yVal = Math.Sin(DegreeToRadian(currentTick)) * (180 / Math.PI)
Else
yVal = Math.Cos(DegreeToRadian(currentTick)) * (180 / Math.PI)
End If
pointsToDraw.Add(New Point(currentTick, yVal))
currentTick += 1
pctrBxSinCosDraw.Invalidate()
And DegreeToRadian simply does (as it states):
Private Function DegreeToRadian(ByVal angle As Double)
DegreeToRadian = Math.PI * angle / 180.0
End Function
And pointsToDraw is List(Of Point)
A sample project can be found on my download page.

Brushes to Colors

Hey I was doing a VisualBasic Windows Form Control project and I encountered with an little issue:
This is my OnPaint Method:
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaint(e)
Dim g As Graphics
g = e.Graphics
Dim ancho As Integer = Me.Width / 2
Dim alto As Integer = Me.Height / 2
_posiciox = 5
Percentatge(_maxim,_minim)
For Index As Double = 0.1 To 10.0
If Index <= _percent Then
If Index >= 9 Then
g.FillRectangle(_color4, _posiciox, alto - 10, 40, 20)
ElseIf Index >= 8 Then
g.FillRectangle(_color3, _posiciox, alto - 10, 40, 20)
ElseIf Index >= 6 Then
g.FillRectangle(_color2, _posiciox, alto - 10, 40, 20)
Else
g.FillRectangle(_color1, _posiciox, alto - 10, 40, 20)
End If
End If
g.DrawRectangle(Pens.Black, _posiciox, alto - 10, 40, 20)
_posiciox = _posiciox + 45
Next
End Sub
Where the color Filled are Brushes.Color params. Also I wanted to let the User chose this Color.
I've tried with Public property like this:
Public Property ColorBaix() As Color
Get
Return Color.Coral
End Get
Set(ByVal value As Color)
End Set
End Property
But I can't transform a Brushes.Color into a Color.Color:
I've found some examples Colors to Brush but I can't use "new param" on OnPaint due to overloading issues.
Is It that the Only way or Maybe there is another solution?
SOLVED:
I adapted my project:
<Description("Color Primari")>
Public Property ColorBaix() As Color
Get
Return color1
End Get
Set(ByVal value As Color)
color1 = value
_color1 = New SolidBrush(value)
Invalidate()
End Set
End Property
You're barking up the wrong tree a bit.
You don't want to turn a brush into a colour, you want to set the color property of your existing brush to a new value.
so when you first made the brush you did something like this:
Dim mybrush As New SolidBrush(Color.Aqua)
then later you want to set the colour
mybrush.Color = Color.Azure
if you want to obtain the colour of a brush, then you can do this:
Dim myColour As New Color
myColour = mybrush.Color

How should I detect more than one occurrence of a pixel with the same color

This question is related to Visual Basic .NET 2010
Okay so, I made this program that can redraw an image on any surface on the screen. I'm using some Win32 API to move the mouse and simulate clicks and so on.
The thing is, I used to just make it click for every pixel, which resulted in a lot of lag when used on a flash or javascript surface.
I need to detect "lines" of pixels, as in, if I'm enumerating the pixels and checking their color, if the current pixel is black, and the next 10 ones are black as well, I need to be able to detect it and draw a line instead of clicking each one, in order to prevent lag.
Here's my current code, it's how I enumerate the pixels.
Private Sub Draw()
If First Then
Pos = New Point(Me.Location)
MsgBox("Position set, click again to draw" & vbCrLf _
& "Estimated time: " & (Me.BackgroundImage.Width * Me.BackgroundImage.Height) / 60 & " seconds (1ms/pixel)")
First = False
Else
Using Bmp As New Bitmap(Me.BackgroundImage)
Using BmpSize As New Bitmap(Bmp.Width, Bmp.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb) 'Use to get size of bitmap
For y As Integer = 0 To BmpSize.Height - 1
For x = 0 To BmpSize.Width - 1
Dim curPixColor As Color = Bmp.GetPixel(x, y)
If curPixColor = Color.White Then Continue For 'Treat white as nothing
If IsColorBlack(curPixColor) Then
'TODO:
'If more than 1 black pixel in a row, use _Drag() to draw line
'If 1 pixel followed by white, use _Click() to draw 1 pixel
End If
Next
Next
MsgBox("Drawn")
First = True 'Nevermind this, used for resetting the program
End Using
End Using
End If
End Sub
Private Sub _Drag(ByVal From As Point, ByVal _To As Point)
SetCursorPos(From.X, From.Y)
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
SetCursorPos(_To.X, _To.Y)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub
Private Sub _Click(ByVal At As Point)
SetCursorPos(At.X, At.Y)
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub
As always, help is much appreciated. It's a rather complicated question but I hope I made some sense.
You can try to count it like this
'Count of the black pixels
Dim BlackCount As Integer = 1
'Another intermediate X variable
Dim ThisX As Integer = x + 1
'Run along until reaching the right edge or a not black pixel
While ThisX < Bmp.Width AndAlso IsColorBlack(Bmp.GetPixel(ThisX, y))
BlackCount += 1
ThisX += 1
End While
'Act accordingly
If BlackCount > 1 Then
'Drag from x to Thisx-1
Else
'Click
End If
x = ThisX 'Update the X variable to skip over the covered area
Also try to determine what causes the lag. GetPixel and SetPixel are extremely slow. To improve the performace look into the LockBits way of reading pixel values. Try google or http://msdn.microsoft.com/de-de/library/ms229672%28v=vs.90%29.aspx for a first start. It is by magnitudes faster and should be used when reading any significant amount of pixels.

Setting the background color of a contentbyte itextsharp

MVC3 VB.NET application using Itextsharp. I have a section of code that generates a pdf file everything looks great but I would like to alternate the line colors in that pdf file between 2 color so that the values are easy to follow for the person looking at it. Is there a way to set the background color of a whole line based on font size to a set color? A function I would be using this in is below:
For Each _reg_ In _reg
Dim _registrant As reg_info = _reg_
If y_line1 <= 30 Then
doc.NewPage()
_Page = _Page + 1
y_line1 = 670
End If
If y_line1 = 670 Then
cb.BeginText()
cb.SetFontAndSize(BF_Times, 6)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, _datePrinted + " " + _timePrinted, 500, 770, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_RIGHT, "Page Number" + " " + _Page, 600, 770, 0)
cb.SetFontAndSize(BF_Times, 8)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, _reportHead + " Overrides ", 304, 720, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, "First Name", 20, 700, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, "Last Name", 80, 700, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, "Last Four", 160, 700, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, "Email Address", 300, 700, 0)
cb.EndText()
End If
cb.BeginText()
cb.SetFontAndSize(BF_Times, 8)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, _registrant.first_name, 20, y_line1, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, _registrant.last_name, 80, y_line1, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, _registrant.last_four_social, 160, y_line1, 0)
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, _registrant.email, 300, y_line1, 0)
_total += 1
cb.EndText()
y_line1 = y_line1 - 15
Next
I thought about just setting the background color of the line by using the y_line1 and using a modulus to determine if the color should be grey or white. But I have found no code samples anywhere about how to set a whole line background color.. Any ideas????
There is no concept of "background color" in the PDF spec in relation to text. Anything that looks like a background color, even a table, is just text drawn on top of a rectangle (or some other shape).
To draw a rectangle you just call the Rectangle method on your PdfContentByte object. It takes a lower left x,y and a width and a height. The color is determined by a previous call to one of the color fills such as SetColorFill().
When working with the raw canvas its recommended that you also use SaveState() and RestoreState(). Since the fill commands are shared between objects but mean different things these can help avoid confusion. SaveState() sets a flag allowing you to undo all graphics state changes when you call RestoreState().
The code below is a full working VB.Net 2010 WinForms app targeting iTextSharp 5.1.2.0 that shows off the above. It creates a sample file on the desktop with a line of text repeated 7 times. Each line toggles back and forth between two background colors. Additionally it draws a stroke around the line of text to simulate a border.
Option Strict On
Option Explicit On
Imports System.IO
Imports iTextSharp.text
Imports iTextSharp.text.pdf
Public Class Form1
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
''//Test file that we'll create
Dim TestFile = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Desktop), "TestFile.pdf")
''//Test String that we'll repeat
Dim TestString = "It was the best of times..."
''//Create an array of our test string
Dim TestArray = {TestString, TestString, TestString, TestString, TestString, TestString, TestString}
''//Create our generic font
Dim BF_Times = BaseFont.CreateFont(BaseFont.TIMES_BOLD, BaseFont.CP1250, BaseFont.NOT_EMBEDDED)
''//Standard PDF setup, change as needed for your stream type
Using FS As New FileStream(TestFile, FileMode.Create, FileAccess.Write, FileShare.None)
Using Doc As New Document(PageSize.LETTER)
Using writer = PdfWriter.GetInstance(Doc, FS)
Doc.Open()
''//Grab the raw content object
Dim cb = writer.DirectContent
''//Set our starter Y coordinate
Dim y = 670
''//Loop through our string collection
For I = 0 To (TestArray.Count - 1)
''//Store the current graphics state so that we can unwind it later
cb.SaveState()
''//Set the fill color based on eve/odd
cb.SetColorFill(If(I Mod 2 = 0, BaseColor.GREEN, BaseColor.BLUE))
''//Optional, set a border
cb.SetColorStroke(BaseColor.BLACK)
''//Draw a rectangle. NOTE: I'm subtracting 5 from the y to account for padding
cb.Rectangle(0, y - 5, Doc.PageSize.Width, 15)
''//Draw the rectangle with a border. NOTE: Use cb.Fill() to draw without the border
cb.FillStroke()
''//Unwind the graphics state
cb.RestoreState()
''//Flag to begin text
cb.BeginText()
''//Set the font
cb.SetFontAndSize(BF_Times, 6)
''//Write some text
cb.ShowTextAligned(PdfContentByte.ALIGN_LEFT, TestArray(I), 0, y, 0)
''//Done writing text
cb.EndText()
''//Decrease the y accordingly
y -= 15
Next
Doc.Close()
End Using
End Using
End Using
Me.Close()
End Sub
End Class