Im trying to create a pie chart and have seen many different ways of doing so. I am trying to do it with the seemingly simplest method that I could find however I cannot get it to work. My code is below
If chkboxPieChart.CheckState = True Then
Dim percents() As Decimal = {EStock, EWages, EAdvertising, ERent, EElectricity, ERepayments, EPackaging}
Dim colors() As Color = {Color.Blue, Color.Green, Color.Red, Color.Orange, Color.Purple, Color.Azure, Color.Chartreuse}
Dim graphics As Graphics = Me.picboxPieChart.CreateGraphics
Dim location As Point = New Point(462, 257)
Dim size As Size = New Size(200, 200)
DrawPieChart(percents, colors, graphics, location, size)
End If
With this being the code for the DrawPieChart Sub
Public Sub DrawPieChart(ByVal percents() As Decimal, ByVal colors() As Color, ByVal surface As Graphics, ByVal location As Point, ByVal pieSize As Size)
Dim sum As Integer = 0
For Each percent As Integer In percents
sum += percent
Next
Dim percentTotal As Integer = 0
For percent As Integer = 0 To percents.Length() - 1
surface.FillPie(New SolidBrush(colors(percent)), New Rectangle(location, pieSize), CType(percentTotal * 360 / 100, Single), CType(percents(percent) * 360 / 100, Single))
percentTotal += percents(percent)
Next
Return
End Sub
Any help is greatly appreciated, thanks
Related
I am having problems with a project which should show the acceleration of a simple pendulum swinging over time. It should model a negative cosine curve, and I have the X and Y axis set so that the cosine curve will peak at the top of the chart area. However, it does not do this. For example, the maximum acceleration is calculated to be 17.746 m/s^2, however on the chart it says the maximum is around 1.71 m/s^2. Screenshot attached below.
https://drive.google.com/file/d/1AcmIDXsJIbzihH8Nq4mgSn1CofJCkQ6T/view?usp=sharing
I have wondered whether my maths are wrong or whether the problem lies somewhere in the chart. I have two other charts working, displacement and velocity of the pendulum, so I am confused as to why this will not work, especially as the coding behind each different chart is almost identical. I will attach all necessary code beneath.
Private Function CalculateAcceleration(ByVal amplitude As Double, ByVal frequency As Double, ByVal time As Double) As Double
Dim acceleration, maxAcc As Double
maxAcc = sq((2 * PI * frequency)) * amplitude
acceleration = -(maxAcc * Cos(2 * PI * frequency * time))
Return acceleration
End Function
Private Sub CreateAccelerationGraph(ByVal angularSpeed As Double, ByVal amplitude As Double, ByVal timePeriod As Double, ByVal frequency As Double)
If AccelerationChart.Series("Acceleration").Points.Count <> 0 Then
AccelerationChart.Series("Acceleration").Points.Clear()
End If
Dim maxAcceleration As Double = sq(angularSpeed) * amplitude
With AccelerationChart.ChartAreas("Default")
.AxisX.Minimum = 0
.AxisX.Maximum = (1 * timePeriod)
.AxisY.Minimum = -(maxAcceleration)
.AxisY.Maximum = maxAcceleration
End With
Dim increment As Double = (1 * timePeriod) / 100
For time As Double = 0 To (1 * timePeriod) Step increment
Dim xPos, yPos As Double
yPos = CalculateAcceleration(amplitude, frequency, time)
xPos = time
AccelerationChart.Series("Acceleration").Points.AddXY(xPos, yPos)
Dim label As New CalloutAnnotation
With label
AccelerationChart.Annotations.Add(label)
End With
Next
End Sub
Private Sub SetUpAccelerationGraph()
Dim innerPlotPosition As ElementPosition = New ElementPosition(10, 10, 80, 80)
AccelerationChart.Series.Add("Acceleration")
AccelerationChart.ChartAreas.Add("Default")
With AccelerationChart.Series("Acceleration")
.Color = Color.BlueViolet
.BorderWidth() = 5
.ChartType = DataVisualization.Charting.SeriesChartType.Spline
End With
With AccelerationChart.ChartAreas("Default")
.IsSameFontSizeForAllAxes = True
.InnerPlotPosition = innerPlotPosition ' sets the inner plot position
End With
AccelerationChart.ChartAreas.FirstOrDefault.AxisX.LabelStyle.Format = "{0:0.0}" 'sets the format of labels to 1dp
AccelerationChart.ChartAreas.FirstOrDefault.AxisY.LabelStyle.Format = "{0:0.000}"
End Sub
I have a PictureBox that is sized 1096 x 1004 with the SizeMode set to StretchImage. I am able to get the coordinates of each pixel correctly(see code below) by factoring in the StrechImage effect on the pixel coordinates.
Now what I am trying to accomplish is converting those pixel coordinates to a Cartesian Coordinate to be able to graph. In the long run, I am going to take the Cartesian Coordinates and convert them to Polar Coordinates.
I have tried to convert the pixel coordinates to cartesian by using this method.
cartesianx = scalefactor*screenx - screenwidth / 2;
cartesiany = -scalefactor*screeny + screenheight / 2;
This method is not putting the origin at (0,0) in the center of the PictureBox. It seems to be setting the origin closer to the Upper Left of the PictureBox. Is there any idea as to what I am missing?
Below is my code to convert the image to BitMap and get those coordinates and scale them correctly.
Imports System.IO
Public Class HomePanel
Dim realX As Int32
Dim realY As Int32
Private Sub HomePanel_Load(sender As Object, e As EventArgs) Handles MyBase.Load
chartImageDisplay_box.Image = Image.FromFile("C:\Users\UserB\Desktop\test.jpg")
End Sub
Private Sub chartImageDisplay_box_MouseMove(sender As Object, e As MouseEventArgs) Handles chartImageDisplay_box.MouseMove
If (e.Button = MouseButtons.Left) Then
ShowCoords(e.X, e.Y)
End If
End Sub
Private Sub chartImageDisplay_box_MouseDown(sender As Object, e As MouseEventArgs) Handles chartImageDisplay_box.MouseDown
If (e.Button = MouseButtons.Left) Then
ShowCoords(e.X, e.Y)
Dim MyBitmap As Bitmap
MyBitmap = CType(chartImageDisplay_box.Image, Bitmap)
'Me.BackColor = MyBitmap.GetPixel(realX, realY)
rgbValue.Text = "RGB Value: " & MyBitmap.GetPixel(realX, realY).ToString()
End If
'printAllPixels()
End Sub
Private Sub ShowCoords(ByVal mouseX As Int32, ByVal mouseY As Int32)
Dim realW As Int32 = chartImageDisplay_box.Image.Width
Dim realH As Int32 = chartImageDisplay_box.Image.Height
Dim currentW As Int32 = chartImageDisplay_box.ClientRectangle.Width
Dim currentH As Int32 = chartImageDisplay_box.ClientRectangle.Height
Dim zoomW As Double = (currentW / CType(realW, Double))
Dim zoomH As Double = (currentH / CType(realH, Double))
Dim zoomActual As Double = Math.Min(zoomW, zoomH)
Dim padX As Double = If(zoomActual = zoomW, 0, (currentW - (zoomActual * realW)) / 2)
Dim padY As Double = If(zoomActual = zoomH, 0, (currentH - (zoomActual * realH)) / 2)
realX = CType(((mouseX - padX) / zoomActual), Int32)
realY = CType(((mouseY - padY) / zoomActual), Int32)
lblPosXval.Text = "X: " & If(realX < 0 OrElse realX > realW, "-", realX.ToString())
lblPosYVal.Text = "Y: " & If(realY < 0 OrElse realY > realH, "-", realY.ToString())
cartX.Text = "X: " 'Where to add the cart conversion for X
cartY.Text = "Y: " 'Where to add the cart conversion for Y
End Sub
'Writes all the pixels to a text file along with RGB values for each pixel
Public Sub printAllPixels()
Using writer As StreamWriter =
New StreamWriter("C:\Users\UserB\Desktop\Pixels.txt")
Dim MyBitmap As Bitmap
MyBitmap = CType(chartImageDisplay_box.Image, Bitmap)
For y = 0 To MyBitmap.Height - 1
For x = 0 To MyBitmap.Width - 1
writer.WriteLine("XY Coord: " & x & ", " & y & "; " & MyBitmap.GetPixel(x, y).ToString)
Next
Next
End Using
End Sub
End Class
I don't know if the content of the variable contains the right value but the formula should look more like this:
cartesianx = scalefactor * (screenx - (screenwidth / 2))
cartesiany = -scalefactor* (screeny - (screenheight / 2))
Translate to 0,0 add the scale factor then flip the y.
I believe I figured my question out. I was using the wrong value for my screenx and screeny. I was using the calculated scale value but I needed to just use the mouse event X and Y values.
I have created a routine that is intended to print a variable number of lines and/or pages, based on a queue of line information previously stored. Each page prints fine, but when printing more than one page, two pages overprint. I can't see my logic error, but there must be one. A copy of the offending code is follows. Nextline.newpage is a boolean set to true to force a new page. In my text example there were six "Newpage" and "hasmorepages" was set to true six times, and the routine was exited six times. Still the output was four pages with one printing correctly, and three with two pages printed on one sheet. Any help would be greatly appreciated. By the way, this is my first question, so be kind.
Private Sub PrintLines(Sender As Object, e As PrintPageEventArgs) Handles PrintDoc.PrintPage
Dim White As String = GetARGBString(PrinterDefaultBackcolor)
Do Until Lines.Count = 0
Dim Nextline As Lineformat = Lines.Dequeue
If Nextline.NewPage Then
e.HasMorePages = True
Exit Sub
End If
With Nextline
Dim LineBackColor As String = Nextline.backColor
If LineBackColor <> White Or .Borders = True Then DrawShape(Nextline, e)
If .Text <> "" Then DrawText(Nextline, e)
End With
Loop
End Sub
Private Sub DrawShape(Line As Lineformat, E As PrintPageEventArgs)
With Line
Dim Top As Integer = .Top * 100
Dim Left As Integer = .Left * 100
Dim Width As Integer = .BackGroundWidth * 100
Dim Height As Integer = .BackGroundHeight * 100
Dim Point As New Point(Left, Top)
Dim Size As New Size(Width, Height)
Dim Rect As New Rectangle(Point, Size)
Dim TransparentFillColor As String = "00" & Strings.Right(.backColor, 6)
Dim FillColor As FullColor = GetColorFromString(.backColor)
Dim BorderPen As New Pen(Color.Black)
Dim FillBrush As New SolidBrush(FillColor.Color)
E.Graphics.FillRectangle(FillBrush, Rect)
If Line.Borders = True Then
E.Graphics.DrawRectangle(BorderPen, Rect)
End If
End With
End Sub
Private Sub DrawText(Line As Lineformat, E As PrintPageEventArgs)
With Line
Dim MyFont = SetFontStyle(.FontFamily, .FontPoints, .FontBold, .FontItalic, .FontUnderline)
Dim TextColor As FullColor = GetColorFromString(.ForeColor)
Dim MyBrush As New SolidBrush(TextColor.Color)
Dim top As Integer = .Top * 100
Dim Left As Integer = .Left * 100
Dim Width As Integer = .LineWidth * 100
Dim Height As Integer = .LineHeight * 100
Dim point As New Point(Left, top)
Dim Size As New Size(Width, Height)
Dim Rect As New RectangleF(point, Size)
Dim SF As New StringFormat()
SF.FormatFlags = TextFormatFlags.WordEllipsis
E.Graphics.DrawString(.Text, MyFont, MyBrush, Rect, SF)
End With
End Sub
End Class
Afternoon, I have a maths-formula type query in VB.NET
I have a screen, it can be resized and the only input I get from the user, is the quantity of "balls" that go inside the screen.
I know I need to square root the width and height, to get my "quantity" of balls for a best-as equal rows and columns - but Im a bit stuffed on calculating:
The size of the balls.
The distance between the balls (if need-be, the balls need to be smaller)
and as per not-my example below, I need the ball start position to be at the top left corner of the form.
So, open up a copy of VS, add a new winforms project, paste the code below into the Paint event of the form and run it.
So what I need is: A indeterminate amount of balls to generate (fed by a user) to fill up the form, as equally best on the X and Y axis to fill up the form staying the same size and if possible, a little distance between them, say, a quarter of the size of the ball itself.
Feel free to resize the screen or change the _BallsInTotal variable for it to auto-generate the amount of balls.
Dim _BallsInTotal As Integer
_BallsInTotal = 100
Dim TotalColumns As Integer
Dim TotalRows As Integer
TotalColumns = Math.Sqrt(_BallsInTotal)
TotalRows = Math.Sqrt(_BallsInTotal)
Dim BallWidth As Single = 20
Dim BallHeight As Single = 20
Dim BallPositionX As Long = BallWidth * 2
Dim BallPositionY As Long = BallHeight * 2
Dim solidBrush As New SolidBrush(Color.FromArgb(255, 255, 0, 0))
Dim rows As Single
Dim columns As Single
For columns = 1 To TotalColumns
For rows = 1 To TotalRows
e.Graphics.FillEllipse(solidBrush, BallPositionX * columns, BallPositionY * rows, BallWidth , BallHeight )
Next
Next
Ive been scratching my head for the last two hour where Im at the point where its going to bleed! (seriously, its doing my head in).
What I've added is an InputBox that allows the user to specify the total number of balls. I placed the code in the OnPaint event for drawing the graphics. I've calculated the width of the columns and rows based on the form width/height. I'm using variables for the column/row in the For loops to track which column and row I'm drawing in, then using the column/row width/height to find my x and y (plus an additional .1 of the column/row width/height for spacing). And finally using .8 of the column/row width/height for how much space I want the ball to take up in the column/row.
Public Class Form1
Dim _total As Int32 = 120
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
Dim columns As Int32 = Math.Ceiling(Math.Sqrt(_total))
Dim rows As Int32 = Math.Ceiling(Math.Sqrt(_total))
Dim width As Int32 = Me.ClientSize.Width
Dim height As Int32 = Me.ClientSize.Height
Dim columnWidth As Int32 = width / columns
Dim rowHeight As Int32 = height / rows
Dim brush As Brush = New SolidBrush(Color.FromArgb(255, 255, 0, 0))
Me.SuspendLayout()
Dim painted As Int32 = 0
For r As Int32 = 0 To rows - 1
For c As Int32 = 0 To columns - 1
Dim x As Int32 = (c * columnWidth) + (columnWidth * 0.1)
Dim y As Int32 = (r * rowHeight) + (rowHeight * 0.1)
e.Graphics.FillEllipse(brush, New Rectangle(x, y, columnWidth * 0.8, rowHeight * 0.8))
painted += 1
If painted = _total Then
Me.ResumeLayout()
Exit Sub
End If
Next
Next
End Sub
Private Sub Form1_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Me.Invalidate()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim input As String = InputBox("Enter a total.")
Dim number As Int32 = 0
If Int32.TryParse(input, number) Then
_total = number
Me.Invalidate()
End If
End Sub
End Class
I have a listview to which i add images of different sizes, eg. 123x23, 23,43, and so on..
How do i go on about this problem. I know listview has a tilesize property but that sets the general size of all the tiles
Tried with an imagelist, changing the imagelist imagesize doesnt help either... Heres the code i use to add the images to the listbox
The imglist in the code is an imagelist to which all the required images are loaded.
Private Sub frm_load_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Form1.ListViewEx1.LargeImageList = imglist
For i = 0 To imglist.Images.Count - 1
Dim x = Form1.ListViewEx1.Items.Add(New ListViewItem("", i))
x.Tag = imglist.Images.Keys(i).ToString
Next
Form1.lbl_status1.Text = "Image Count: " & Form1.ListViewEx1.Items.Count
End sub
I had the same problem.
I found this and that works for me: Click here
Public Sub LoadImageList(ByVal ImagePath As String, ByVal Key As String)
Dim picImage As Image = Nothing
Dim final_Bitmap As Bitmap = Nothing
Dim org_Image As Bitmap = Nothing
If File.Exists(ImagePath) Then
picImage = Image.FromFile(ImagePath)
'********************* Drawing the Image in proportion to the imagelist Size Here ****************
Dim proportion As Integer = 0
Dim startx As Decimal = 0
Dim startY As Decimal = 0
Dim drawwidth As Decimal = 0
Dim drawheight As Decimal = 0
org_Image = New Bitmap(picImage)
final_Bitmap = New Bitmap(ImageList1.ImageSize.Width, ImageList1.ImageSize.Height)
Dim gr As Graphics = Graphics.FromImage(final_Bitmap)
Dim factorscale As Decimal
factorscale = org_Image.Height / org_Image.Width
drawwidth = final_Bitmap.Width
drawheight = final_Bitmap.Width * factorscale
If drawheight > final_Bitmap.Height Then
proportion = 1
factorscale = org_Image.Width / org_Image.Height
drawheight = final_Bitmap.Height
drawwidth = final_Bitmap.Height * factorscale
End If
startx = 0
startY = final_Bitmap.Height - drawheight
gr.DrawImage(org_Image, startx, startY, drawwidth, drawheight)
ImageList1.Images.Add(Key, final_Bitmap)
org_Image.Dispose()
final_Bitmap.Dispose()
'************************** End Loading the Image****************
End If
End Sub