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.
Related
For fun I'm trying to recreate the first level of one my favorite games, Fire Emblem 7. I got a picture of the map online. I've broken down the image into "squares" with each square assigned a picture box to display the image. This is because each square needs to have certain properties such as terrain values, units inside them, etc.
The actual image is quite small (240 x 160), so I want to be able to scale it to any user defined value. The size of each square should be 16c x 16c with a scaler of c (all map dimensions are divisible by 16). For some reason, when c > 1, white lines appear between the squares. I've check the code and it looks like the squares should be adjacent with no empty spaces regardless of c.
I have provided a piece of my code and links to the images of different values of c below. Thank you for you help.
'This Sub Creates The Map From Initial Image And Assigns Part Of Image to Each Square
Public Sub New(Name As String, Image As Image)
Dim cropRect As Rectangle
Dim cropImage As Bitmap
Me.Name = Name
Me.Image = Image
Height = Me.Image.Height / 16
Width = Me.Image.Width / 16
ReDim Squares(Height - 1, Width - 1)
For i = 0 To Height - 1
For j = 0 To Width - 1
cropRect = New Rectangle(16 * j, 16 * i, 16, 16)
cropImage = New Bitmap(16, 16)
Graphics.FromImage(cropImage).DrawImage(Me.Image, 0, 0, cropRect, GraphicsUnit.Pixel)
Squares(i, j) = New Square(cropImage)
Next
Next
End Sub
'This Sub Sizes Each Square With User Defined Scale Value
Public Sub Draw(Scale As Double)
For i = 0 To Height - 1
For j = 0 To Width - 1
With Squares(i, j).Box
.Size = New Size(16 * Scale, 16 * Scale)
.Location = New Point(16 * j * Scale, 16 * i * Scale)
.SizeMode = PictureBoxSizeMode.StretchImage
End With
Next
Next
End Sub
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.
I create a recolor function to recolor my picture box,
my function works red, it turn everything to red.
But now i want to input some Scroll Bar function to control it.
if i want 3 scroll bars which represent R , G , B
how can i do that base on my current function?
Try
' Retrieve the image.
image1 = New Bitmap("C:\Users\Anons\Desktop\Winter.jpg", True)
Dim x, y As Integer
' Loop through the images pixels to reset color.
For x = 0 To image1.Width - 1
For y = 0 To image1.Height - 1
Dim pixelColor As Color = image1.GetPixel(x, y)
Dim newColor As Color = _
Color.FromArgb(pixelColor.R, 0, 0)
image1.SetPixel(x, y, newColor)
Next
Next
' Set the PictureBox to display the image.
PictureBox1.Image = image1
' Display the pixel format in Label1.
Label1.Text = "Pixel format: " + image1.PixelFormat.ToString()
Catch ex As ArgumentException
MessageBox.Show("There was an error." _
& "Check the path to the image file.")
End Try
End Sub$
You simply need to multiply all three color components (R, G, and B) by a fractional factor which is determined by the scroll bar. For instance, a factor of 1 would keep it the same color. A factor of .5 would make the color half as bright. A factor of 2 would make it twice as bright, etc.
Dim rFactor As Single = rScroll.Value / 100
Dim gFactor As Single = gScroll.Value / 100
Dim bFactor As Single = bScroll.Value / 100
Dim newColor As Color = Color.FromArgb(pixelColor.R * rFactor, pixelColor.R * gFactor, pixelColor.B * bFactor)
Is that possible? I want to pass my custom color as a parameter and I want to receive an Image (rectangle for example).
Public Function createIcon(ByVal c As Color) As Bitmap
Dim g As Graphics
Dim Brush As New SolidBrush(c)
g.FillRectangle(Brush, New Rectangle(0, 0, 20, 20))
Dim bmp As New Bitmap(20, 20, g)
Return bmp
End Function
I tried this way and couldn't success.
Bitmap: A canvas (in memory) that contains an image.
Graphics: A tool set that allows you to draw on an associated canvas.
With this in mind, here is the solution:
Public Function CreateIcon(ByVal c As Color, ByVal x As Integer, ByVal y As Integer) As Bitmap
Dim icon As New Bitmap(x, y)
Using g = Graphics.FromImage(icon)
Using b As New SolidBrush(c)
g.FillRectangle(b, New Rectangle(0, 0, 20, 20))
End Using
End Using
Return icon
End Function
The Using blocks here merely serve the purpose of disposing the graphics resources properly (by automatically calling their Dispose method at the end of the block). You need to do this, otherwise you will leak graphics resources.
Okay, got it. I am going to share what I did just in case.
Public Function createIcon(ByVal c As Color, ByVal x As Integer, ByVal y As Integer) As Bitmap
createIcon = New Bitmap(x, y)
For i = 0 To x - 1
For j = 0 To y - 1
If i = 0 Or j = 0 Or i = x - 1 Or j = y - 1 Then
createIcon.SetPixel(i, j, Color.Black)
Else
createIcon.SetPixel(i, j, c)
End If
Next
Next
Return createIcon
End Function
This function will give you a colored rectangle with black border.
Is there a way to detect the actual width of text in a vb.net web app? It needs to be dependant upon its font-style and size.
In vb6 you could copy the text into a label and make it expand to fit then measure its width, but this won't work in vb.net.
Update: On further inspection, TextRenderer.MeasureText seems a better option:
Dim text1 As String = "Measure this text"
Dim arialBold As New Font("Arial", 12.0F)
Dim textSize As Size = TextRenderer.MeasureText(text1, arialBold)
See Graphics.MeasureString:
Measures the specified string when
drawn with the specified Font.
Dim myFontBold As New Font("Microsoft Sans Serif", 10, FontStyle.Bold)
Dim StringSize As New SizeF
StringSize = e.Graphics.MeasureString("How wide is this string?", myFontBold)
i have just recently done this in one of my projects here is how i did it
Dim textsize As Size = TextRenderer.MeasureText(cbx_Email.Text, cbx_Email.Font)
cbx_Email.Width = textsize.Width + 17
this is in a combobox.SelectedIndex changed sub.
The +17 is for the pixels that the dropdown arrow takes up in a combobox so it doesntcover text.
by using control.font it allows the code to dynamically change no matter what font is being used. Using Control.Text means you can use this on anything and wont have to change the code when changing the text of the control or page.
I wrote this low-end function to do just that without higher-level API's.
It creates a bitmap and graphics object, writes the string to the bitmap, scans backwards for the font edge and then returns the width in pixels
Private Function FontLengthInPixels(inputString As String, FontStyle As Font) As Integer
' Pick a large, arbitrary number for the width (500) in my case
Dim bmap As New Bitmap(500, 100)
Dim g As Graphics = Graphics.FromImage(bmap)
g.FillRectangle(Brushes.Black, bmap.GetBounds(GraphicsUnit.Pixel))
g.DrawString(inputString, FontStyle, Brushes.White, New Point(0, 0))
' Scan backwards to forwards, since we know the first pixel location is 0,0; we need to find the LAST and subtract
' the bitmap width from it to find the width.
For x = -(bmap.Width - 1) To -1
' Scan from the 5th pixel to the 10th, we'll find something within that range!
For y = 5 To 10
Dim col As Color = bmap.GetPixel(Math.Abs(x), y)
' Look for white (ignore alpha)
If col.R = 255 And col.G = 255 And col.B = 255 Then
Return Math.Abs(x) ' We got it!
End If
Next
Next
' Lets do this approx
Return 0
End Function