Image Recognition between 2 images vb.net Lockbits - vb.net

I was in the process of using Pixel to do my search between a large image and a small image. I got that one to successfully work but am having trouble getting the lockbits version to do what I want it to do.
Fist I want to loop through the large image finding the first pixel of the smaller image inside it. Then once finding the first pixel to do a math equation to tell me what percentage of accuracy it got off it. In doing so if it meets the criteria to move my mouse to that location on the screen at the first pixel (top most left) of that small image inside the large image. Which works with a great rate of success and is extremely fast compared to GetPixel format.
Problem Cannot get location on the large image of where the beginning Pixel of the small image is and move the mouse to that location. Below is the code:
Try
Dim ifnd As Boolean = False
Dim PreviousX As Integer
Dim PreviousY As Integer
PreviousX = MousePosition.X
PreviousY = MousePosition.Y
Dim MatchCount As Integer = 0
Dim oX As Integer = 0
Dim oi As Integer = 0
Dim iX As Integer = 0
Dim iY As Integer = 0
Dim bmp_original As Bitmap
Dim ImG As Bitmap
ImG = PictureBox2.BackgroundImage
bmp_original = ImG
Dim bmp_large As Bitmap
Dim SmG As Image
SmG = PictureBox1.BackgroundImage
bmp_large = SmG
Dim bmg As Bitmap
'large image
ImG = BBt
'small image
bmg = Abt
Thread.Sleep(1000)
'large image
If BBt Is Nothing Then
Dim xbit As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(xbit)
BBt = xbit
g.CopyFromScreen(0, 0, 0, 0, Screen.PrimaryScreen.Bounds.Size)
g.Dispose()
Thread.Sleep(2000)
End If
'small image
PictureBox5.BackgroundImage = Abt
'large image
PictureBox6.BackgroundImage = BBt
'For value As Integer = 0 To 5
'For value As Integer = 10 To 0 Step -2
Thread.Sleep(1000)
'original image
Dim oRect As New Rectangle(0, 0, bmg.Width, bmg.Height)
Dim oBmpData As BitmapData = bmg.LockBits(oRect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim oPtr As IntPtr = oBmpData.Scan0
Dim oPixels(99) As Integer
Dim oMaxPix As Integer = bmg.Width + bmg.Height
Marshal.Copy(oPtr, oPixels, 0, oMaxPix)
Dim smWidth As Integer
smWidth = bmg.Width - 1
'small image
PictureBox3.BackgroundImage = bmg
'large image
Dim lRect As Rectangle = New Rectangle(0, 0, bmp_large.Width, bmp_large.Height)
Dim lBmpData As BitmapData = ImG.LockBits(lRect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim lPtr As IntPtr = lBmpData.Scan0
Dim PixelCount As Integer = ImG.Width * ImG.Height
Dim lPixels(PixelCount - 1) As Integer
Marshal.Copy(lPtr, lPixels, 0, PixelCount)
'large image
PictureBox4.BackgroundImage = ImG
Dim MathScore As Integer
Dim MaxScore As Integer = bmg.Height
'beginning of Marshal Loop
For i As Integer = 0 To lPixels.GetUpperBound(0)
If oPixels(0) = lPixels(i) Then
'we have a match for top left pixel - so compare the other pixels
Dim PixelsToLeft As Integer = (i Mod ImG.Width) - 1 'pixels to left of 10by10 section of large image
Dim PixelsToRight As Integer = ImG.Width - PixelsToLeft - smWidth 'pixels to right of 10by10 section of large image
Dim d As Integer = PixelsToLeft + PixelsToRight 'array distance between right edge of 10by10 section and left edge of next row
For y As Integer = 0 To 9
For x As Integer = 0 To 9
Dim oIndex As Integer = (y * 10) + x
Dim lIndex As Integer = (i + (y * (d + smWidth))) + x
If oPixels(oIndex) = lPixels(lIndex) Then
MathScore = MathScore + 1
xx = oPixels(0) + 2
yy = lPixels(i) + 3
SetCursorPos(xx, yy)
End If
Next
Next
If MathScore >= Val(MaxScore / 2.5) Then
SetCursorPos(xx, yy)
Dim percent As String
Dim myDec As Decimal
'inttemp = (intData2 * 100) / intData1
myDec = Val((MathScore * 100) / MaxScore)
myDec = FormatNumber(myDec, 0)
percent = myDec & "%"
Label16.Text = "Match Score: " & percent
Label17.Text = "Math Score: " & MathScore & " out of " & MaxScore
Me.ToolStripStatusLabel2.Text = "Completed"
Me.Button4.Enabled = True
GoTo Foundit
End If
End If
Next
PictureBox1.Image = (Abt)
PictureBox2.Image = (BBt)
ImG.UnlockBits(oBmpData)
bmg.UnlockBits(lBmpData)
Foundit:
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Catch
End Try
Now if I could figure out how to get the mouse to move on the screen then I would have figured it out. Unfortunately I have been working on this for several days without any success. If you could help I would greatly appreciate it. Thank you in advance.

to move the mouse do this
dim a as new point
a.x = "the number you want"
a.y = "the number you want"
windows.forms.cursor.position = a

Related

Convert SVG or Base30 to image file

I'm trying to convert an SVG file to any format of image file.
I'm creating SVG file from base30 value.
Public Sub SaveSignature()
Dim B30 As New Base30Converter
Dim Img = B30.GetData("aQ4895d6d7j5h94840Z39baa6bfb6430Y4538d6a49c59db8863003240Z4374b7ek7j4a33Y255e8j5d6Z52Y3b2428385e9n1vd1Bfq6a4Z4Y3949456Z1e91wi2B2N1u2Eh1H9bY5j81ye1w1u8e5724983329d8pe1Ai1Nf1V1Uft9d5_7WZ266594c4g7gc36452542000Y2648a67334524112100Z1235766Y64Z9ah593420Y75g7d483401000Z34Y133Z332Y7e29262300Z43a3652Y26252556400Z2ig6h2200473720Y2263542006736424241000Z826010")
Dim svg = SVGConverter.ToSVG(Img)
Dim sw As New System.IO.StreamWriter("D:\Sign.svg", False)
sw.Write(svg)
sw.Close()
Dim bmp As Bitmap = renderFile("D:\Sign.svg")
Dim g As Graphics
g = Graphics.FromImage(bmp)
Using g
g.Clear(Color.White)
g.DrawImageUnscaled(bmp, 0, 0)
End Using
bmp.Save("D:\Sign.bmp", System.Drawing.Imaging.ImageFormat.Bmp)
bmp.Save("D:\Sign.jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
bmp.Save("D:\Sign.emf", System.Drawing.Imaging.ImageFormat.Emf)
End Sub
Public Function renderFile(filename As String) As Bitmap
Dim displaySize As System.Drawing.Size
displaySize.Width = 300
displaySize.Height = 200
Dim svgDoc As SvgDocument = SvgDocument.Open(filename)
Dim svgSize = svgDoc.GetDimensions()
If svgSize.Width = 0 Then
Throw New Exception("SVG does not have size specified. Cannot work with it.")
End If
Dim displayProportion = (displaySize.Height * 1.0F) / displaySize.Width
Dim svgProportion = svgSize.Height / svgSize.Width
Dim scalingFactor As Single = 0.0F
Dim padding As Integer = 10
If displayProportion > svgProportion Then
scalingFactor = ((displaySize.Width - padding * 2) * 1.0F) / svgSize.Width
Else
scalingFactor = ((displaySize.Height - padding * 2) * 1.0F) / svgSize.Height
End If
If scalingFactor < 0 Then
Throw New Exception("Viewing area is too small to render the image")
End If
Dim centeringX As Integer = Convert.ToInt16((displaySize.Width - (padding + CInt(svgDoc.Width) * scalingFactor)) / 2)
Dim centeringY As Integer = Convert.ToInt16((displaySize.Height - (padding + CInt(svgDoc.Height) * scalingFactor)) / 2)
svgDoc.Transforms = New SvgTransformCollection()
svgDoc.Transforms.Add(New SvgTranslate(padding + centeringX, padding + centeringY))
svgDoc.Transforms.Add(New SvgScale(scalingFactor))
svgDoc.Width = New SvgUnit(svgDoc.Width.Type, displaySize.Width)
svgDoc.Height = New SvgUnit(svgDoc.Height.Type, displaySize.Height)
Return svgDoc.Draw()
End Function
After all these process the image file left with empty file.
The base30 value I'm getting from a signature panel in asp application.

Load a screenshot into a function as a bitmap without saving it as a file first

Basically my program takes a "sample" image from the user, then takes a screenshot of the entire user's screen, and then if it found that sample on the users screen, it returns the coordinates of it and moves the mouse there.
It works fine if I save the screenshot to a bitmap and compare the sample to a file, but when I try to call the screenshot directly into the function, it fails to find a match.
Any idea why?
First the code for the button click that triggers the comparison:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim clickhere As Point
Dim bounds As Rectangle
Dim screenshot As System.Drawing.Bitmap
Dim graph As Graphics
bounds = Screen.PrimaryScreen.Bounds
screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
graph = Graphics.FromImage(screenshot)
graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
Dim src As New Bitmap(srcpath.Text)
Dim g = Graphics.FromImage(screenshot)
g.CopyFromScreen(0, 0, 0, 0, screenshot.Size)
g.Dispose()
clickhere = BitmapExtension.Contains(screenshot, src)
MsgBox(clickhere.ToString)
Cursor.Position = clickhere
End Sub
And here is the function:
Imports System.Drawing
Imports System.Runtime.CompilerServices
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Module BitmapExtension
<Extension()>
Public Function Contains(src As Bitmap, ByRef bmp As Bitmap) As Point
'
'-- Some logic pre-checks
'
If src Is Nothing OrElse bmp Is Nothing Then Return New Point(Integer.MinValue, Integer.MinValue)
If src.Width < bmp.Width OrElse src.Height < bmp.Height Then
Return New Point(Integer.MinValue, Integer.MinValue)
End If
'
'-- Prepare optimizations
'
Dim sr As New Rectangle(0, 0, src.Width, src.Height)
Dim br As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim srcLock As BitmapData = src.LockBits(sr, Imaging.ImageLockMode.ReadOnly, PixelFormat.Format32bppRgb)
Dim bmpLock As BitmapData = bmp.LockBits(br, Imaging.ImageLockMode.ReadOnly, PixelFormat.Format32bppRgb)
Dim sStride As Integer = srcLock.Stride
Dim bStride As Integer = bmpLock.Stride
Dim srcSize As Integer = sStride * src.Height
Dim bmpSize As Integer = bStride * bmp.Height
Dim srcBuff(srcSize) As Byte
Dim bmpBuff(bmpSize) As Byte
Marshal.Copy(srcLock.Scan0, srcBuff, 0, srcSize)
Marshal.Copy(bmpLock.Scan0, bmpBuff, 0, bmpSize)
' we don't need to lock the image anymore as we have a local copy
bmp.UnlockBits(bmpLock)
src.UnlockBits(srcLock)
Return FindMatch(srcBuff, src.Width, src.Height, sStride, bmpBuff, bmp.Width, bmp.Height, bStride)
End Function
Private Function FindMatch(srcBuff() As Byte, srcWidth As Integer, srcHeight As Integer, srcStride As Integer,
bmpBuff() As Byte, bmpWidth As Integer, bmpHeight As Integer, bmpStride As Integer) As Point
For Y As Integer = 0 To srcHeight - bmpHeight - 1
For x As Integer = 0 To srcWidth - bmpWidth - 1
If AllPixelsMatch(x, Y, srcBuff, srcStride, bmpBuff, bmpWidth, bmpHeight, bmpStride) Then
Return New Point(x, Y)
End If
Next
Next
Return New Point(Integer.MinValue, Integer.MinValue)
End Function
Private Function AllPixelsMatch(X As Integer, Y As Integer, srcBuff() As Byte, srcStride As Integer,
bmpBuff() As Byte, bmpWidth As Integer, bmpHeight As Integer, bmpStride As Integer) As Boolean
For by As Integer = 0 To bmpHeight - 1
For bx As Integer = 0 To bmpWidth - 1
Dim bmpIndex As Integer = by * bmpStride + bx * 4
Dim a As Byte = bmpBuff(bmpIndex + 3)
'If bmp pixel is not transparent, check if the colours are identical
If a > 0 T
hen
Dim srcX = X + bx
Dim srcY = Y + by
Dim srcIndex = srcY * srcStride + srcX * 4
For i As Integer = 0 To 2
'check if the r, g and b bytes match
If srcBuff(srcIndex + i) <> bmpBuff(bmpIndex + i) Then Return False
Next
Else
'if bmp pixel is transparent, continue seeking.
Continue For
End If
Next
Next
Return True
End Function
End Module

Changing the area of a pixel search

I have been working on an app to search for 3 pixels in a certain area then play a sound. It currently works however I wish to reduce the zone of which it searches from the whole screen to a rectangular area on my screen, this is to save memory usage of the app, here's the code that works
Private Sub dcdTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dcdTimer.Tick
Dim screensize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim screenshot As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
Dim pointx As Integer = 1
Dim pointy As Integer = 1
ge.CopyFromScreen(New Point(0, 0), New Point(0, 0), screensize)
looking = True
Try
While looking = True
Dim atpoint As Color = screenshot.GetPixel(pointx, pointy)
Dim reckcol1 As Color = Color.FromArgb(a, r, g, b) 'first pixel colour
Dim reckcol2 As Color = Color.FromArgb(a1, r1, g1, b1) 'second pixel colour
Dim reckcol3 As Color = Color.FromArgb(a2, r2, g2, b2) 'third pixel colour
If atpoint = reckcol1 Then 'Matches 3 pixels
Dim testPoint As Color = screenshot.GetPixel(pointx, pointy + 10)
If testPoint = reckcol2 Then
Dim testPoint2 As Color = screenshot.GetPixel(pointx + 10, pointy + 10)
If testPoint2 = reckcol3 Then
My.Computer.Audio.Play(sounddir + "Found.wav")
looking = False
Sleep(15000)
pointx = 0
pointy = 0
End If
End If
End If
pointy = pointy + 1
If pointy = My.Computer.Screen.Bounds.Height Then
pointy = 0
pointx = pointx + 1
End If
End While
Catch ex As Exception
End Try
End Sub
I tried to use this code as suggested:
Dim pointofY As New Point(500, 400)
Dim screensize As New Size(400, 200)
Dim screenshot As New Rectangle(pointofY, screensize)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
However, using a rectangle does not allow me to use getpixel or use ge.copyfromscreen

Attribute a code for every color

Is there any way to attribute a code for every color, and be able to read them? Programatically I mean.
My target is to convert an image into code, then convert it back to image.
Each color has 4 fields (For some images, you only have 3 fields with meaningful information)
These fields include:
Alpha (A) (This represents opacity of the pixel)
Red (R) (Red intensity)
Green (G) (Green intensity)
Blue (B) (Blue intensity)
What you would do is read them and generate a code string for each one by concatenating the values to one another.
This can most likely be considered pseudo-code as I did not check if it compiles, but you should be doing something along the lines of this.
Dim pixelColor As Color
Dim image As BitMap = New BitMap("your_image.png")
Dim a As String
Dim r As String
Dim b As String
Dim g As String
Dim fileString As New StringBuilder()
fileString.AppendLine(image.Size.Width.ToString())
fileString.AppendLine(image.Size.Height.ToString())
' Loop over all pixels
For y As Integer = 0 To image.Size.Height - 1
For x As Integer = 0 To image.Size.Width - 1
pixelColor = image.GetPixel(x, y)
' get ARGB values as strings
a = pixelColor.A.ToString()
r = pixelColor.R.ToString()
g = pixelColor.G.ToString()
b = pixelColor.B.ToString()
' Append the colors, one pixel per line
fileString.AppendLine(a & " " & r & " " & g & " " & b)
Next
Next
Using file As New StreamWriter("image_data.txt")
outfile.Write(fileString.ToString())
End Using
Again, this probably doesn't compile. (I don't have a compiler with me at the moment)
edit:
I realized that the width and height need to be stored as well.
As for reading the file:
Dim file As System.IO.StreamReader
file = File.OpenText("text_file.txt")
Dim width As Integer = Convert.ToInt32(file.ReadLine)
Dim height As Integer = Convert.ToInt32(file.ReadLine)
Dim image As BitMap = New BitMap(width, height)
Dim currentX As Integer = 0
Dim currentY As Integer = 0
Do Until file.EndOfStream
Dim line As String = file.ReadLine
Dim valueArray(4) As String = line.Split(" ")
Dim a As Integer = Convert.ToInt16(valueArray(0))
Dim r As Integer = Convert.ToInt16(valueArray(1))
Dim g As Integer = Convert.ToInt16(valueArray(2))
Dim b As Integer = Convert.ToInt16(valueArray(3))
image.SetPixel(currentX, currentY, Color.FromArgb(a, r, g, b))
currentX = currentX + 1
If currentX == width Then
currentX = 0
currentY = currentY + 1
If currentY == height Then
Exit Do ' We're done here.
End If
End If
Loop
' At this point, you'll have a BitMap with all the pixels set.
Again, consider this pseudo-code.
each color is actually a ARGB color code just get integer value
Dim myColor As Color = Color.Red
Dim Code As Integer = myColor.ToArgb()
Dim myColorBack As Color = Color.FromArgb(Code)

VB.NET - Creating, resizing and appending images

I have two bmp files:
footer.bmp: 200 x 200
product.bmp: 1000 x 1000
I want to create a new bmp file with 200 x 500:
Append the footer.bmp into the bottom of the new image - position (0, 300)
Resize the product.bmp to 200 x 300 and position into (0, 0)
How do I do this using VB.NET?
Dim oBitmap As New Bitmap(200, 500)
Dim oGraphics As Graphics
oGraphics = Graphics.FromImage(oBitmap)
... ?
Dim Path As String = "C:\Delivery\"
Dim Height As Integer = 400
Using oFooter As System.Drawing.Image = Drawing.Image.FromFile(Path + "Footer.png")
Dim Width As Integer = oFooter.Width
Using oBitmap As New Bitmap(Width, Height)
Using oGraphic As Graphics = Graphics.FromImage(oBitmap)
Using oBrush As New SolidBrush(Color.White)
oGraphic.FillRectangle(oBrush, 0, 0, Width, Height)
End Using
oGraphic.DrawImage(oFooter, 0, 300)
Using oProduto As System.Drawing.Image = Drawing.Image.FromFile(Path + "Produto.png")
Dim pWidth As Integer = oProduto.Width
Dim pHeight As Integer = oProduto.Height
If pWidth > Width Then
pHeight = CInt(pHeight * Width / pWidth)
pWidth = Width
End If
If pHeight > Height Then
pWidth = CInt(pWidth * Height / pHeight)
pHeight = Height
End If
Dim x As Integer = CInt((Width - pWidth) / 2)
Dim y As Integer = CInt((Height - oFooter.Height - pHeight) / 2)
oGraphic.DrawImage(oProduto, x, y, pWidth, pHeight)
End Using
oBitmap.Save(Path + "Final.jpg", Imaging.ImageFormat.Jpeg)
End Using
End Using
End Using