VB Downscaling coordinates - vb.net

I have the need to know when a gdi+ drawn line is clicked on by the mouse.
I have fashioned this function which is used in a loop on all the existing lines and what the function does is:
It makes a buffer of the line's container's size
It makes the whole thing black
It draws the line in green
It gets the pixel at the mouse location
If the pixel is different from black a.k.a green, the line has successfully been clicked and the function should then return true.
This works great, there's no misinterpretations, but I'm afraid that there's a tiny delay (not really noticeable) when my form is in full screen (due to the large buffer).
I'm looking for a way to optimize this, and my first thought is to downscale everything. So what I mean by that is make the buffer like 20x20 and then draw the line in a scaled down version using math. Problem is, I suck at math, so I'm basically asking you how to do this and preferably with an explanation for dummies.
This is the function:
Public Function Contains(ByVal e As Point) As Boolean
Dim Width As Integer = Container.Size.Width
Dim Height As Integer = Container.Size.Height
Dim Buffer As Bitmap = New Bitmap(Width, Height)
Using G As Graphics = Graphics.FromImage(Buffer)
G.Clear(Color.Black)
Dim Start As Point = New Point(ParentNode.Location.X + ParentNode.Size.Width / 2, ParentNode.Location.Y + ParentNode.Size.Height / 2)
Dim [End] As Point = New Point(ChildNode.Location.X + ChildNode.Size.Width / 2, ChildNode.Location.Y + ChildNode.Size.Height / 2)
Dim Control1 As Point
Dim Control2 As Point
Control1.X = Start.X + GetAngle(ChildNode.Location, ParentNode.Location, ChildNode.Location.X - ParentNode.Location.X, ChildNode.Location.Y - ParentNode.Location.Y)
Control1.Y = Start.Y
Control2.X = [End].X
Control2.Y = Start.Y
G.DrawBezier(New Pen(Color.Green, 4), Start, Control1, Control2, [End])
End Using
If Buffer.GetPixel(e.X, e.Y).ToArgb() <> Color.Black.ToArgb() Then
Return True
End If
Return False
End Function
This is one of my attempts to make the function use the idea above:
Public Function Contains(ByVal e As Point) As Boolean
Dim Width As Integer = 20
Dim Height As Integer = 20
Dim Buffer As Bitmap = New Bitmap(Width, Height)
Using G As Graphics = Graphics.FromImage(Buffer)
G.Clear(Color.Black)
Dim Start As Point = New Point(ParentNode.Location.X + ParentNode.Size.Width / 2, ParentNode.Location.Y + ParentNode.Size.Height / 2)
Dim [End] As Point = New Point(ChildNode.Location.X + ChildNode.Size.Width / 2, ChildNode.Location.Y + ChildNode.Size.Height / 2)
Dim Control1 As Point
Dim Control2 As Point
Control1.X = Start.X + GetAngle(ChildNode.Location, ParentNode.Location, ChildNode.Location.X - ParentNode.Location.X, ChildNode.Location.Y - ParentNode.Location.Y)
Control1.Y = Start.Y
Control2.X = [End].X
Control2.Y = Start.Y
G.DrawBezier(New Pen(Color.Green, 4), New Point(Start.X / Width, Start.Y / Height), New Point(Control1.X / Width, Control1.Height / Height), New Point(Control2.X / Width, Control2.Y / Height), New Point([End].X / Width, [End].Y / Height))
End Using
If Buffer.GetPixel(Width, Height).ToArgb() <> Color.Black.ToArgb() Then
Return True
End If
Return False
End Function

Try using a GraphicsPath for drawing and testing with the built-in IsOutlineVisible function:
Public Function Contains(ByVal e As Point) As Boolean
Dim result as Boolean = False
Using gp As New GraphicsPath
gp.AddBezier(your four points)
Using p As New Pen(Color.Empty, 4)
result = gp.IsOutlineVisible(e, p)
End Using
End Using
Return result
End Function
Side note: Bitmaps and Graphic objects need to be disposed when you create them.

Related

Creating a Custom Polygon Class in vb.net

I want to make a custom polygon shape class, which i can drag and drop unto my form at will (just as it is done in the case of OvalShape and RectangleShape objects in VS toolbox). I checked site1, site2 and site3, one of which specifically said that the OnPaint Event of my form should be overridden. Is there any way I can achieve the same while creating the custom polygon shape, and still have my polygon appear on the toolbox?
Edit:
#Jens: I'll like the control to generate its code with the following tested code:
Me.ClientSize = New Point(24, 24)
Dim r1 As Integer = Min(cx, cy) - 10
Dim r2 As Integer = Min(cx, cy) \ 2
Dim pts(9) As Point
For i As Integer = 0 To 9 Step 2
pts(i).X = cx + CInt(r1 * Cos(i * PI / 5 - PI / 2))
pts(i).Y = cy + CInt(r1 * Sin(i * PI / 5 - PI / 2))
pts(i + 1).X = cx + CInt(r2 * Cos((i + 1) * PI / 5 - PI / 2))
pts(i + 1).Y = cy + CInt(r2 * Sin((i + 1) * PI / 5 - PI / 2))
Next i
That gives me a star with 5 spikes. How can i store them in the Points variable created,
OR
store the points as a region so that whenever i change forecolor, it fills the region (i.e. polygn) with the selected color. I also want to prevent painting the backcolor. Please take a look at the links below to a c# solution of what i really want, but i suck at converting c# to vb.
link1; Link2
Thanks a lot
I am not entirely sure that that is what you want. You can always derive a new class from Control and use its Paint event to draw whatever you like. In your case a polygon.
The control therefore contains a Points property that is just an array of PointF values that define the edges of the polygon. By using the DesignerSerializationVisible.Content attribute you make it possible to edit these values through the designer directly. The code looks like this:
Public Class PolygonControl
Inherits Control
Private _Points(2) As PointF
<System.ComponentModel.DesignerSerializationVisibility(System.ComponentModel.DesignerSerializationVisibility.Content)>
Public Property Points As PointF()
Get
Return _Points
End Get
Set(value As PointF())
_Points = value
End Set
End Property
Public Property LineColor As Color = Color.Black
Public Property LineWidth As Integer = 2
Private Sub PolygonControl_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
e.Graphics.Clear(Me.BackColor)
If Points IsNot Nothing AndAlso Points.Count > 1 Then
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Using b As New SolidBrush(ForeColor)
Using p As New Pen(b, LineWidth)
e.Graphics.DrawPolygon(p, Points)
End Using
End Using
End If
End Sub
End Class
I added a color and width property as well. This is just to give you a rough idea. Notice the attribute above the Points property.
In "action" it looks like this:
Adding better designer support is certainly possible, but I have no experience with that whatsoever. But it is a start.
Edit
Since you always draw the same shape, you can precalculate the points in the control's constructor and just draw the shape in the paint event:
Public Class StarControl
Inherits Control
'Storage for the shape's points
Private pts(9) As Point
'Constructor
Public Sub New()
Me.ClientSize = New Size(24, 24)
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Transparent
'Precalculate the shape
Dim cx = CInt(Me.ClientSize.Width / 2)
Dim cy = CInt(Me.ClientSize.Height / 2)
Dim r1 As Integer = Min(cx, cy) - 10
Dim r2 As Integer = Min(cx, cy) \ 2
ReDim pts(9)
For i As Integer = 0 To 9 Step 2
pts(i).X = cx + CInt(r1 * Cos(i * PI / 5 - PI / 2))
pts(i).Y = cy + CInt(r1 * Sin(i * PI / 5 - PI / 2))
pts(i + 1).X = cx + CInt(r2 * Cos((i + 1) * PI / 5 - PI / 2))
pts(i + 1).Y = cy + CInt(r2 * Sin((i + 1) * PI / 5 - PI / 2))
Next i
End Sub
Public Property LineColor As Color = Color.Black
Public Property FillColor As Color = Color.Gold
Public Property LineWidth As Integer = 1
Public Sub PaintMe(sender As Object, e As PaintEventArgs) Handles Me.Paint
'Draw the precalculated shape
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Using b As New SolidBrush(FillColor)
e.Graphics.FillPolygon(b, pts)
End Using
Using b As New SolidBrush(LineColor)
Using p As New Pen(b, LineWidth)
e.Graphics.DrawPolygon(p, pts)
End Using
End Using
End Sub
End Class
For an even cooler effect move the shape calculation into the Paint event handler so the shape resizes itself based on the control's size. This allows you to draw stars of arbitrary size.

Fast "for each pixel in bitmap" loop

I'm writing a Visual Basic application that takes a screenshot of the desktop and crops it down to a 200px by 200px image around the center of the screen. One part of the application would iterate through each pixel and check if the RGB of that pixel is a certain color (this is meant to take under a second for it to be efficient), and unfortunately Bitmap.Getpixel is not doing me any good whether or not It's being loaded into the memory via Bitmap.Lock or not.
Is there a faster (almost instantaneous) way of doing so? Thanks.
Sure there is. Typically what you do is :
for each pixel
Get device contex
Read Pixel
Release device contex (unless you want memory leak)
For this to work you need few external windows library calls, ex :
[DllImport("user32.dll")]
static extern IntPtr GetDC(IntPtr hwnd);
[DllImport("user32.dll")]
static extern Int32 ReleaseDC(IntPtr hwnd, IntPtr hdc);
[DllImport("gdi32.dll")]
static extern uint GetPixel(IntPtr hdc, int nXPos, int nYPos);
static public System.Drawing.Color getPixelColor(int x, int y) {
IntPtr hdc = GetDC(IntPtr.Zero);
uint pixel = GetPixel(hdc, x, y);
ReleaseDC(IntPtr.Zero, hdc);
Color color = Color.FromArgb((int)(pixel & 0x000000FF),
(int)(pixel & 0x0000FF00) >> 8,
(int)(pixel & 0x00FF0000) >> 16);
return color;
}
It would be much better to
GetDC
for each pixel
read pixel and store value
ReleaseDC
However I have found that get pixel method itself is slow. Therefore to get better performance just grab the entire screen into a bitmap and get the pixels from there.
Here is some sample code in c#, you can convert it in VB.net if you want using online converters:
var maxX=200;
var maxY=200;
var screensize = Screen.PrimaryScreen.Bounds;
var xCenterSub100 = (screensize.X-maxX)/2;
var yCenterSub100 = (screensize.Y-maxY)/2;
Bitmap hc = new Bitmap(maxX, maxY);
using (Graphics gf = Graphics.FromImage(hc)){
gf.CopyFromScreen(xCenterSub100, yCenterSub100, 0, 0, new Size(maxX, maxY), CopyPixelOperation.SourceCopy);
//...
for (int x = 0; x < maxX; x++){
for (int y = 0; y < maxY; y++){
var pColor = hc.GetPixel(x, y);
//do something with the color...
}
}
}
In Vb.net (using http://converter.telerik.com/) :
Dim maxX = 200
Dim maxY = 200
Dim screensize = Screen.PrimaryScreen.Bounds
Dim xCenterSub100 = (screensize.X - maxX) / 2
Dim yCenterSub100 = (screensize.Y - maxY) / 2
Dim hc As New Bitmap(maxX, maxY)
Using gf As Graphics = Graphics.FromImage(hc)
gf.CopyFromScreen(xCenterSub100, yCenterSub100, 0, 0, New Size(maxX, maxY), CopyPixelOperation.SourceCopy)
'...
For x As Integer = 0 To maxX - 1
For y As Integer = 0 To maxY - 1
Dim pColor = hc.GetPixel(x, y)
'do something with the color...
Next
Next
End Using
With c# on my old computer i got around 30 fps, run time is about 35ms. There are faster ways, but they start to abuse several things to get that speed. Note that you do not use the getPixelColor, it is here just for reference. You instead use the screen scraped image method.
If you don't wish to resort to p/invoke, you can use the LockBits method. This code sets each component of a 200 x 200 area at the center of a bitmap in a PictureBox to a random value. It runs in about 100 milliseconds (not counting the refresh of the PictureBox).
EDIT: I realized you were trying to read pixels, so I added a line to show how to do that.
Private Sub DoGraphics()
Dim x As Integer
Dim y As Integer
'PixelSize is 4 bytes for a 32bpp Argb image.
'Change this value appropriately
Dim PixelSize As Integer = 4
Dim rnd As New Random()
'This code uses a bitmap that is loaded in a picture box.
'Any bitmap should work.
Dim bm As Bitmap = Me.PictureBox1.Image
'lock an area of the bitmap for editing that is 200 x 200 pixels in the center.
Dim bmd As BitmapData = bm.LockBits(New Rectangle((bm.Width - 200) / 2, (bm.Height - 200) / 2, 200, 200), System.Drawing.Imaging.ImageLockMode.ReadOnly, bm.PixelFormat)
'loop through the locked area of the bitmap.
For y = 0 To bmd.Height - 1
For x = 0 To bmd.Width - 1
'Get the various pixel locations This calculation is for a 32bpp Argb bitmap
Dim blue As Integer = (bmd.Stride * y) + (PixelSize * x)
Dim green As Integer = blue + 1
Dim red As Integer = green + 1
Dim alpha As Integer = red + 1
'Set each component of the pixel to a random rgb value.
'There are 4 bytes that make up each pixel (32bpp Argb)
Marshal.WriteByte(bmd.Scan0, red, CByte(rnd.Next(0, 256)))
Marshal.WriteByte(bmd.Scan0, blue, CByte(rnd.Next(0, 256)))
Marshal.WriteByte(bmd.Scan0, green, CByte(rnd.Next(0, 256)))
Marshal.WriteByte(bmd.Scan0, alpha, 255)
'Use the ReadInt32() method to read back the entire pixel
Dim intColor As Integer = Marshal.ReadInt32(bmd.Scan0)
If intColor = Color.Blue.ToArgb() Then
'The pixel is blue
Else
'The pixel is not blue
End If
Next
Next
'Important!
bm.UnlockBits(bmd)
Me.PictureBox1.Refresh()
End Sub

How to draw circular arcs in VB.NET

I have to generate the following figure according to user fed values. How do I go about drawing the arcs (B-C-F as in figure, circular in nature) given their start point & end point (B & F respectively) & the height from the segment BF? I can do some geometric calculations & get the radius & all, but how do I draw the arc?
I have tried using the Graphics.DrawCurve() method, but it doesn't work as expected. How can I make this method work for circular arcs? Any other workaround is also welcome.
From my comment:
If you have computed the necessary radius to generate the curve, then
simply draw the entire circle with Graphics.DrawEllipse(), but use
Graphics.SetClip() and pass a rectangle using the points B and F as a
side and computing the other two points using the height C. This will
clip the entire circle to just the part visible within that rectangle.
Then call Graphics.ResetClip() and draw the rest of the lines. Repeat
the SetClip() trick to draw the curve at the bottom as well.
Here's a proof of concept for the top curve thru B, C, and F.
I used the formulas provided by Donna Roberts at Investigative Circle Activity Using Three Points.
Here's a screenshot:
...and the code that produced it:
Public Class Form1
Private B As New Point(50, 100)
Private F As New Point(250, 100)
Private DistanceFromBF As Integer = 50
Private Sub Form1_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
If B.Y = F.Y Then
Dim C As New Point(B.X + (F.X - B.X) / 2, B.Y - DistanceFromBF)
Dim ctr As Point
Dim rad As Double
CircleFromPointsOnCircumference(B, C, F, ctr, rad)
Dim rc As New Rectangle(ctr, New Size(1, 1))
rc.Inflate(rad, rad)
e.Graphics.DrawRectangle(Pens.Black, rc)
Dim clip As New Rectangle(New Point(B.X, B.Y - DistanceFromBF), New Size(F.X - B.X, DistanceFromBF))
e.Graphics.SetClip(clip)
e.Graphics.DrawEllipse(Pens.Green, rc)
e.Graphics.ResetClip()
DrawPoint(B, e.Graphics, Color.Red)
DrawPoint(C, e.Graphics, Color.Red)
DrawPoint(F, e.Graphics, Color.Red)
DrawPoint(ctr, e.Graphics, Color.Green)
End If
End Sub
Private Sub DrawPoint(ByVal pt As Point, ByVal G As Graphics, ByVal clr As Color)
Dim rc As New Rectangle(pt, New Size(1, 1))
rc.Inflate(3, 3)
Using brsh As New SolidBrush(clr)
G.FillEllipse(brsh, rc)
End Using
End Sub
Private Sub CircleFromPointsOnCircumference(ByVal ptA As Point, ByVal ptB As Point, ByVal ptC As Point, ByRef Center As Point, ByRef Radius As Double)
Dim mR As Double = CDbl(ptA.Y - ptB.Y) / CDbl(ptA.X - ptB.X)
Dim mT As Double = CDbl(ptC.Y - ptB.Y) / CDbl(ptC.X - ptB.X)
Dim X As Double = (mR * mT * (ptC.Y - ptA.Y) + mR * (ptB.X + ptC.X) - mT * (ptA.X + ptB.X)) / CDbl(2) * (mR - mT)
Dim Y As Double = CDbl(-1) / mR * (X - CDbl(ptA.X + ptB.X) / CDbl(2)) + (CDbl(ptA.Y + ptB.Y) / CDbl(2))
Center = New Point(X, Y)
Radius = Math.Sqrt(Math.Pow(ptA.X - Center.X, 2) + Math.Pow(ptA.Y - Center.Y, 2))
End Sub
End Class
Got it! Thanks #Mitch & #Idle_Mind
Using the builtin DrawArc method of Graphics
Friend Function draw_tank() As Boolean
' Create pen.
Dim blackPen As New Pen(Color.Black, 3)
' Create rectangle to bound ellipse.
Dim rect As New Rectangle(100, 100, 200, 200)
' Keeping the width & length same (200) we get a circle
' Create start and sweep angles on ellipse.
Dim startAngle As Single = 225.0F
Dim sweepAngle As Single = 90.0F
' Draw arc to screen.
Dim myarc As Graphics = Me.CreateGraphics
myarc.DrawArc(blackPen, rect, startAngle, sweepAngle)
Return True
End Function
Suggestions/Improvements welcome.
Note - This isn't the actual function from my code.

Obtaing the ROI in Visual basic errors in code after conversion from C

I've been working on obtaining the ROI of an image, I'm trying to get a square shaped box that will hoover around the region an be able to click and get the standard deviation. I'm familiar with c so i used the c to VB converter, but im getting errors that the statement is not valid in namespace. Everything seems to compatible to VB code. I will be grateful for any suggestions on this matter. Thanks
Private Function DrawRoi(Image As Bitmap, rect As RectangleF) As oid
Dim roi As New Rectangle()
roi.X = CInt(CSng(Image.Width) * rect.X)
roi.Y = CInt(CSng(Image.Height) * rect.Y)
roi.Width = CInt(CSng(Image.Width) * rect.Width)
roi.Height = CInt(CSng(Image.Height) * rect.Height)
Dim timer As New Stopwatch()
timer.Start()
' graphics manipulation takes about 240ms on 1080p image
Using roiMaskImage As Bitmap = CreateRoiMaskImage(ImageWithRoi.Width, ImageWithRoi.Height, roi)
Using g As Graphics = Graphics.FromImage(ImageWithRoi)
g.DrawImage(Image, 0, 0)
g.DrawImage(roiMaskImage, 0, 0)
Dim borderPen As Pen = CreateRoiBorderPen(ImageWithRoi)
g.DrawRectangle(borderPen, roi)
End Using
End Using
Debug.WriteLine("roi graphics: {0}ms", timer.ElapsedMilliseconds)
Me.imagePictureBox.Image = ImageWithRoi
End Function
Private Function CreateRoiMaskImage(width As Integer, height As Integer, roi As Rectangle) As Bitmap
Dim image As New Bitmap(width, height, PixelFormat.Format32bppArgb)
Using g As Graphics = Graphics.FromImage(image)
Dim dimBrush As New SolidBrush(Color.FromArgb(64, 0, 0, 0))
g.FillRectangle(dimBrush, 0, 0, width, height)
Dim roiBrush As New SolidBrush(Color.Red)
g.FillRectangle(roiBrush, roi)
image.MakeTransparent(Color.Red)
Return image
End Using
End Function

Creating listview icons on the fly on VB.NET?

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.