I am drawing a series of lines on a PrintPreviewControl using the DrawLines method. Here is my code where I take x and y values and convert them into coordinates inside a page rectangle, adding them to a list. I then call DrawLines with a pen and the list converted to an array. I have found that DrawLines will only draw 8125 lines using 8126 point pairs. I receive no exception when DrawLines fails. Any way to increase the number of point pairs that DrawLines will use? Alternatively, I could draw each line individually, or I could parse the points array into 8000 point blocks.
Private Sub DrawGammaLog(ByVal gr As Graphics)
Try
'draw log in chart area
If Points.Count <> 0I Then
gr.SetClip(LogRect)
Dim LPoints As New List(Of PointF)
For Each pt In Points
Dim PointY As Single = LogRect.Top + ((pt.Depth - VScaleMinValue) * VScale)
Dim PointX As Single = LogRect.Left + (pt.Count * HScale)
If PointY >= LogRect.Top AndAlso PointY <= LogRect.Bottom Then
LPoints.Add(New PointF(PointX, PointY))
End If
Next
Debug.Print("{0}", LPoints.Count)
If LPoints.Count >= 2I Then gr.DrawLines(gpp.LogPen, LPoints.ToArray)
End If
'draw box around chart area
gr.DrawRectangle(gpp.LogPen, Rectangle.Round(LogRect))
Catch ex As Exception
MessageBox.Show(ex.Message.ToString & ", " & ex.Source.ToString, Me.Text & " DrawGammaLog")
Finally
gr.ResetClip()
End Try
End Sub
Same issue here using c# in Visual Studio 2010. 8125 seems to be the limit, even if there are no references to this problem online...
I have splitted my array into 8000 PointF[] array blocks as a work-around.
int counter = 0;
int block_size = Math.Min(data.Length, 8000);
PointF[] data_subset;
while (counter != data.Length)
{
data_subset = new PointF[block_size];
Array.Copy(data, counter, data_subset, 0, data_subset.Length);
g.DrawLines(p, data_subset);
counter += block_size;
block_size = Math.Min(data.Length - counter, 8000);
}
Related
I'm trying to do a boundary around a GraphicsPath for easy group sizing. This works fine but when I convert one of the points to a bezier it includes the location of the Bezier handles within the boundary making the selection rectangle much larger than it is supposed to be.
Here is how it looks when the path is first created, by default the points are lines only without beziers. Selection rectangle works as expected.
lines not beziers are right
When I double click on a point it automatically converts the points to a bezier (or if bezier, toggles back to Line) and then the selection rectangle reflects the handle points as well in the path.
when using beziers path is bigger
As you can see, it should stop the rectangle just under the curve made by the bezier but it also seems to expand to the handles.
Here is the code for doing the rectangle perimeter.
Public Overrides Sub DrawSelectionRectangle(ByVal g As Graphics)
SelectionRectangle = New RectangleF(0, 0, 0, 0)
Dim GP As GraphicsPath = _lastGp 'DAVE
If GP IsNot Nothing Then
If _lastGp.PointCount > 1 Then
Try
Dim BH As New Single : Dim TH As New Single : Dim LW As New Single : Dim RW As New Single
TH = GP.PathPoints(0).Y
LW = GP.PathPoints(0).X
For i = 0 To GP.PathPoints.Length - 1
With GP.PathPoints(i)
If .Y < TH Then TH = .Y
If .X < LW Then LW = .X
If .Y > BH Then BH = .Y
If .X > RW Then RW = .X
End With
Next i
'DAVE - This code won't work as it doesn't factor in for space made by the actual bezier curves, GP path must be followed. BUT! this is a tidier solution.
'SelectionRectangle = New RectangleF(0, 0, 0, 0)
'If _pointArray IsNot Nothing Then
' If _pointArray.Count > 1 Then
' Try
' Dim BH As New Single : Dim TH As New Single : Dim LW As New Single : Dim RW As New Single
' LW = _pointArray(0).P.X
' TH = _pointArray(0).P.Y
' For i = 0 To _pointArray.Count - 1
' With _pointArray(i).P
' If .Y < TH Then TH = .Y
' If .X < LW Then LW = .X
' If .Y > BH Then BH = .Y
' If .X > RW Then RW = .X
' End With
' Next i
'=================================
SelectionRectangle = New RectangleF(New PointF(LW, TH), New SizeF(RW - LW, BH - TH))
Dim r As RectangleF = DrawRectangle.GetNormalizedRectangle(SelectionRectangle)
Dim gpen As Pen = New Pen(Color.Gray, MyBase.StrokeWidth)
gpen.DashStyle = DashStyle.Dash
g.DrawRectangle(gpen, r.X, r.Y, r.Width, r.Height)
gpen.Dispose()
Catch ex As Exception
ErrH.Log("DrawSelectionRectangle", "Draw", ex.ToString(), ErrH._LogPriority.Info)
End Try
End If
End If
End Sub
Any help on a simple solution would be much appreciated. :)
I have tried using the actual point array as a reference but this does not factor in for the curves thrown by the Bezier. See example if the above commented code is run.
trying to follow path array instead of graphics path
WOW...
That took a while but I found the answer!
Literally 1 line!
GP.Flatten
The fixed line
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.
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
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 am hoping that someone can help me with a problem I've got at the moment using Compact Framework.Net 2 SP 2.
At the moment I have a UI with a series of text boxes and each textbox displays the contents of a database field. These are shown one beneath another with a scroll bar on the right hand side of the form. Each textbox has a set width which might
I would like to adjust the height each text box based on the number of lines it is holding, the font size and the font in order to avoid using scroll bars on each textbox.
At the moment I am been able to do this in a test application.
Screenshot:
see screenshot for output http://morrislgn.brinkster.net/SO/screenshot.jpg
My code:
'Text used in this example:
'TextBox1qwertyuiop lkjhgfdsazxcvbnm1234567890 TextBo
'x1qwer tyuioplkjhgfdsazxcvb nm1234567890
'qwe
'End of exmaple text.
Me.Textbox2.Text = Me.Textbox1.Text
Dim pobjGraphic As Graphics = Me.Textbox2.Parent.CreateGraphics()
Dim pobjSize As SizeF
'Padding values:
Dim piTop As Int32 = 4 'top of text and top of textbox
Dim piBottom As Int32 = 3 'bottom of text and top of textbox
Dim piLines As Int32 = 0
'Based on the font size chosen by the user, create a font to perform the calculation with.
Dim piFontSize As Single = 10
If Me.CheckBox1.Checked.Equals(True) Then
piFontSize = 6
ElseIf Me.CheckBox2.Checked.Equals(True) Then
piFontSize = 8
ElseIf Me.CheckBox3.Checked.Equals(True) Then
piFontSize = 12
Else
piFontSize = 10
End If
Dim pobjFont As New Font("Tahoma", piFontSize, FontStyle.Regular)
'Calculate the height of one line.
pobjSize = pobjGraphic.MeasureString("HELLO WORLD", pobjFont)
'Value of pobjSize returned: {Width = 71.0 Height = 13.0}
'Calculate the number of lines
Dim b As Bitmap
b = New Bitmap(1, 1, Imaging.PixelFormat.Format32bppRgb)
'Calculate the number of lines required to display the text properly based on the lenght of the text the width of the control.
'Length of text to show divide by the width of the textbox
piLines = Graphics.FromImage(b).MeasureString(Me.Textbox2.Text, pobjFont).Width / Me.Textbox2.Width
'Value of piLines returned: 2
If piLines = 0 Then
piLines = 1
End If
'Calculate the size of the text to be displayed using the margins, height of one line and number of lines.
Me.Textbox2.Height = (pobjSize.Height * piLines) + piTop + piBottom
' value produced: 33 = (13 * 2) + 4 + 3
'set font of text box
Me.Textbox2.Font = pobjFont
Finally, I know this can be achieved using a call to the COREDLL.dll using p/invoke but doing this makes the application crash.
Hi Folks,
Below is the pinvoke code as requested:
<Runtime.InteropServices.DllImport("coredll.dll")> _
Private Function SendMessage( _
ByVal hwnd As IntPtr, ByVal msg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<Runtime.InteropServices.DllImport("coredll.dll")> _
Private Function GetCapture() As IntPtr
End Function
<Runtime.InteropServices.DllImport("coredll.dll")> _
Private Function ReleaseCapture() As Boolean
End Function
Public Function GetNumberOfLines(ByVal ptxtCountBox As TextBox) As Integer
Try
Dim hnd As IntPtr = New IntPtr
ptxtCountBox.Capture = True
' Capture the textbox handle.
hnd = GetCapture()
ptxtCountBox.Capture = False
' Get the count of the lines in the box.
Dim plCount As Integer = SendMessage(ptxtCountBox.Handle, EM_GETLINECOUNT, 0, 0)
' Count the number of return lines as we minus this from the total lines to take.
plCount = plCount - (CharCount(ptxtCountBox.Text, vbCrLf, False))
plCount += RemoveNonASCIIReturns(ptxtCountBox)
ReleaseCapture()
hnd = Nothing
' Return the line count.
Return plCount
Catch ex As Exception
GenerateError(msCLASS_NAME, "GetNumberOfLines", ex.Message.ToString)
End Try
End Function
Thanks,
Morris
I asked a similar question and got an answer that completely satisfied my needs on the subject! Please check out stevo3000's answer from my question:
AutoSize for Label / TextBox in .NET Compact Framework
He referred to these two blog posts that just completely fixed my problem with one swipe!
http://www.mobilepractices.com/2007/12/multi-line-graphicsmeasurestring.html
http://www.mobilepractices.com/2008/01/making-multiline-measurestring-work.html
Think I got to the bottom of this:
Public Function GetNumberOfLines(ByVal pstext As String, ByVal pobjfont As Font, ByVal pobjDimensions As Size) As Decimal
Dim pslines As String() = Nothing
'Used to measure the string to be placed into the textbox
Dim pobjBitMap As Bitmap = Nothing
Dim pobjSize As SizeF = Nothing
Try
Dim psline As String = String.Empty
Dim pilinecount As Decimal = 0.0
'Spilt the text based on the number of lines breaks.
pslines = pstext.Split(vbCrLf)
For Each psline In pslines
'Create a graphics image which is used to work out the width of the text.
pobjBitMap = New Bitmap(1, 1, Imaging.PixelFormat.Format32bppRgb)
pobjSize = Graphics.FromImage(pobjBitMap).MeasureString(psline, pobjfont)
'If the width of the text is less than 1.0 then add one to the count. This would incidcate a line break.
If pobjSize.Width < 1.0 Then
pilinecount = pilinecount + 1
Else
'Based on the dimensions of the text, work out the number of lines. 0.5 is added to round the value to next whole number.
pilinecount = pilinecount + (Round((pobjSize.Width / pobjDimensions.Width) + 0.5))
End If
Next
'If the line count it less than 1 return one line.
If pilinecount < 1.0 Then
Return 1.0
Else
Return pilinecount
End If
Catch ex As Exception
Return 1.0
Finally
If pslines IsNot Nothing Then
Array.Clear(pslines, 0, pslines.Length - 1)
pslines = Nothing
End If
If pobjBitMap IsNot Nothing Then
pobjBitMap.Dispose()
End If
End Try
End Function
Granted, its a bit of a hack but it appears to work ok at the moment! Any observations or comments on how to improve this are more than welcome.
Also, about the p/invoke stuff, discovered the root of the problem, or rather the solution. Upgraded the .Net fx on my device and that appears to have resolved the issue.
Thanks
Morris
Well, I would suggest a sound and smart solution to you.
Here's is the Algorithm:
Use a Label control for reference.
Assign:
• The size of Textbox to the Label.
• The font of Textbox to the Label.
• Autosize-property of Label to be True.
• BorderStyle Property of the Label as of Textbox'.
• MinimumSize Property of Label as original size of the Textbox.
• MaximumSize Property of Label as Width-same as original and Height to be a large multiple the original height.
Assign the Textbox' Text to Label's text.
Now: if the PrefferdHeight-property of Label > Height of the Textbox == True
It's time to increase the height of the Textbox and check the above condition until it’s False.
The Label can be disposed off now.
I have also posted a similar solution in MSDN Forum which can also be checked out:
[http://social.msdn.microsoft.com/Forums/en-US/winforms/thread/03fc8e75-fc13-417a-ad8c-d2b26a3a4dda][1]
Regards.
:)