How can I show I winform that I create in VB.NET just below the active cell?
I have no idea how to solve this. I found the following promising solutions:
Excel addin: Cell absolute position
-The accepted solution seems too complicated to work reliably. I got an error on the first row (Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long)
-The second solution looked promising, but it didn't give me the right positions for my windows form.
The following adaptations of the second proposed solution does not create any errors but does not put the windows form in the correct position:
Public Sub GetScreenPositionFromCell(cell As Excel.Range, excel As Excel.Application)
Dim x As Double
Dim y As Double
If Not excel.ActiveWindow Is Nothing Then
x = excel.ActiveWindow.PointsToScreenPixelsX(cell.Left)
y = excel.ActiveWindow.PointsToScreenPixelsY(cell.Top)
End If
Me.Left = x
Me.Top = y
Me.Show()
Me.TopMost = True
End Sub
EDIT: #Loating, here is how I have used your code. It's great and I am very happy that you are taking your time to help me with a solution. The x-coordinates seems to work while the x-coordinates are a bit off and more or less off depending on the zoom level.
Public Sub ShowMeBelowActiveCell()
Dim ExcelApp As Excel.Application = CType(AddinExpress.MSO.ADXAddinModule.CurrentInstance, AddinModule).ExcelApp
Dim excelWindow = ExcelApp.ActiveWindow
Dim cell = ExcelApp.ActiveCell
Dim zoomFactor As Double = excelWindow.Zoom / 100
Dim ws = cell.Worksheet
' PointsToScreenPixels returns different values if the scroll is not currently 1
' Temporarily set the scroll back to 1 so that PointsToScreenPixels returns a
' value we know how to handle.
Dim origScrollCol = excelWindow.ScrollColumn
Dim origScrollRow = excelWindow.ScrollRow
excelWindow.ScrollColumn = 1
excelWindow.ScrollRow = 1
' (x,y) are screen coordinates for the top left corner of the top left cell
Dim x As Integer = excelWindow.PointsToScreenPixelsX(0)
' e.g. window.x + row header width
Dim y As Integer = excelWindow.PointsToScreenPixelsY(0)
' e.g. window.y + ribbon height + column headers height
Dim dpiX As Single = 0
Dim dpiY As Single = 0
Using g = Drawing.Graphics.FromHwnd(IntPtr.Zero)
dpiX = g.DpiX
dpiY = g.DpiY
End Using
' Note: Each column width / row height has to be calculated individually.
' Before, tried to use this approach:
' var r2 = (Microsoft.Office.Interop.Excel.Range) cell.Worksheet.Cells[origScrollRow, origScrollCol];
' double dw = cell.Left - r2.Left;
' double dh = cell.Top - r2.Top;
' However, that only works when the zoom factor is a whole number.
' A fractional zoom (e.g. 1.27) causes each individual row or column to round to the closest whole number,
' which means having to loop through.
For i As Integer = origScrollCol To cell.Column - 1
Dim col = DirectCast(ws.Cells(cell.Row, i), Microsoft.Office.Interop.Excel.Range)
Dim ww As Double = col.Width * dpiX / 72
Dim newW As Double = zoomFactor * ww
x += CInt(Math.Round(newW))
Next
For i As Integer = origScrollRow To cell.Row - 1
Dim row = DirectCast(ws.Cells(i, cell.Column), Microsoft.Office.Interop.Excel.Range)
Dim hh As Double = row.Height * dpiY / 72
Dim newH As Double = zoomFactor * hh
y += CInt(Math.Round(newH))
Next
excelWindow.ScrollColumn = origScrollCol
excelWindow.ScrollRow = origScrollRow
Me.StartPosition = Windows.Forms.FormStartPosition.Manual
Me.Location = New Drawing.Point(x, y)
Me.Show()
End Sub
End Class
When the ScrollColumn and ScrollRow are both 1, then PointsToScreenPixelsX/Y seems to return the top left point of the top left visible cell in screen coordinates. Using this, the offset width and height to the active cell is calculated, taking into consideration the zoom setting.
var excelApp = Globals.ThisAddIn.Application;
var excelWindow = excelApp.ActiveWindow;
var cell = excelApp.ActiveCell;
double zoomFactor = excelWindow.Zoom / 100;
var ws = cell.Worksheet;
var ap = excelWindow.ActivePane; // might be split panes
var origScrollCol = ap.ScrollColumn;
var origScrollRow = ap.ScrollRow;
excelApp.ScreenUpdating = false;
// when FreezePanes == true, ap.ScrollColumn/Row will only reset
// as much as the location of the frozen splitter
ap.ScrollColumn = 1;
ap.ScrollRow = 1;
// PointsToScreenPixels returns different values if the scroll is not currently 1
// Temporarily set the scroll back to 1 so that PointsToScreenPixels returns a
// value we know how to handle.
// (x,y) are screen coordinates for the top left corner of the top left cell
int x = ap.PointsToScreenPixelsX(0); // e.g. window.x + row header width
int y = ap.PointsToScreenPixelsY(0); // e.g. window.y + ribbon height + column headers height
float dpiX = 0;
float dpiY = 0;
using (var g = Graphics.FromHwnd(IntPtr.Zero)) {
dpiX = g.DpiX;
dpiY = g.DpiY;
}
int deltaRow = 0;
int deltaCol = 0;
int fromCol = origScrollCol;
int fromRow = origScrollRow;
if (excelWindow.FreezePanes) {
fromCol = 1;
fromRow = 1;
deltaCol = origScrollCol - ap.ScrollColumn; // Note: ap.ScrollColumn/Row <> 1
deltaRow = origScrollRow - ap.ScrollRow; // see comment: when FreezePanes == true ...
}
// Note: Each column width / row height has to be calculated individually.
// Before, tried to use this approach:
// var r2 = (Microsoft.Office.Interop.Excel.Range) cell.Worksheet.Cells[origScrollRow, origScrollCol];
// double dw = cell.Left - r2.Left;
// double dh = cell.Top - r2.Top;
// However, that only works when the zoom factor is a whole number.
// A fractional zoom (e.g. 1.27) causes each individual row or column to round to the closest whole number,
// which means having to loop through.
for (int i = fromCol; i < cell.Column; i++) {
// skip the columns between the frozen split and the first visible column
if (i >= ap.ScrollColumn && i < ap.ScrollColumn + deltaCol)
continue;
var col = ((Microsoft.Office.Interop.Excel.Range) ws.Cells[cell.Row, i]);
double ww = col.Width * dpiX / 72;
double newW = zoomFactor * ww;
x += (int) Math.Round(newW);
}
for (int i = fromRow; i < cell.Row; i++) {
// skip the columns between the frozen split and the first visible column
if (i >= ap.ScrollRow && i < ap.ScrollRow + deltaRow)
continue;
var row = ((Microsoft.Office.Interop.Excel.Range) ws.Cells[i, cell.Column]);
double hh = row.Height * dpiY / 72;
double newH = zoomFactor * hh;
y += (int) Math.Round(newH);
}
ap.ScrollColumn = origScrollCol;
ap.ScrollRow = origScrollRow;
excelApp.ScreenUpdating = true;
Form f = new Form();
f.StartPosition = FormStartPosition.Manual;
f.Location = new Point(x, y);
f.Show();
Related
I am using VB.NET with mschart. I am using ErroBar chartype but i am not able to label all the values (medium, upper and lower). When i set chart.Series("ErrorBar").IsValueShownAsLabel = True, only upper value is shown.
I want to show the center, upper and lower values.
Thanks in advance
The solution adopted by me was a simpler one using annotations as can be seen in the code below
Dim Media1 As New RectangleAnnotation()
Media1.BackColor = Color.Yellow
Media1.Text = FormatNumber(D20, 4)
Dim point As PointF = New PointF(chart.ChartAreas(0).AxisX.ValueToPosition(1), chart.ChartAreas(0).AxisY.ValueToPosition(D20))
Media1.AnchorX = point.X + 10
Media1.AnchorY = point.Y + 2
Media1.AllowMoving = True
Dim L1 As New RectangleAnnotation()
L1.BackColor = Color.Yellow
L1.Text = FormatNumber(D20 - result * My.Settings("IncertezaDensidade20") / 2, 4)
point = New PointF(chart.ChartAreas(0).AxisX.ValueToPosition(1), chart.ChartAreas(0).AxisY.ValueToPosition(D20 - result * My.Settings("IncertezaDensidade20") / 2))
L1.AnchorX = point.X
L1.AnchorY = point.Y + 10
L1.AllowMoving = True
Dim L2 As New RectangleAnnotation()
L2.BackColor = Color.Yellow
L2.Text = FormatNumber(D20 + result * My.Settings("IncertezaDensidade20") / 2, 4)
point = New PointF(chart.ChartAreas(0).AxisX.ValueToPosition(1), chart.ChartAreas(0).AxisY.ValueToPosition(D20 + result * My.Settings("IncertezaDensidade20") / 2))
L2.AnchorX = point.X
L2.AnchorY = point.Y - 5
L2.AllowMoving = True
The chart now, can be seen below
I am fairly new to coding (started early this year) and I'm making a program in VB 2010 express that makes a line chart for values that have been given by the user.
In other words, I ask for values and make the program create rectangles on a canvas, one rectangle for every item added to my ArrayList.
This part of the code works, now I want a gradient color scheme, so another color for every rectangle. To achieve this I tried this:
Dim red As Integer = 254
Dim green As Integer = 141
Dim blue As Integer = 150
calcColor(red, green, blue)
Dim MyBrushColor As Color = Color.FromRgb(red, green, blue)
Private Sub calcColor(ByVal red As Integer, ByVal green As Integer, ByVal blue As Integer)
If (red <= 0 Or green <= 0 Or blue <= 0) Then
red = 254
green = 141
blue = 150
red = red + 8
green = green + 8
blue = blue + 8
End If
If (red >= 254 Or green >= 141 Or blue >= 150) Then
red = 254
green = 141
blue = 150
red = red - 8
green = green - 8
blue = blue - 8
End If
End Sub
Just doing -8 and +8 every time is not going to cut it and once they reach either zero or their inital value they'll have another ratio..
As a very inexperienced coder I have no idea how to calculate this ratio. I just know that it's this kind of code I want.
Don't reinvent the wheel. The GDI+ library provides linear gradient brushes. You define starting point and an end point and colors in between and just use this brush for painting.
Example (will comment below):
Dim bmp As New Bitmap(400, 400)
Using brush As Drawing2D.LinearGradientBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), _
New Point(400, 400), _
Color.Blue, _
Color.Red)
Using p As New Pen(brush)
Using g As Graphics = Graphics.FromImage(bmp)
For i = 1 To 400 Step 10
g.DrawRectangle(p, i - 5, i - 5, 10, 10)
Next
End Using
End Using
End Using
If PictureBox1.Image IsNot Nothing Then PictureBox1.Image.Dispose()
PictureBox1.Image = bmp
First I create a bitmap as a canvas (bmp).
I then create a new object of the paint class. In the constructor I provide an object of the LinearGradientBrush class, with a start point in the top left corner, and an end point in the lower right with colors blue at the start and red at the end.
I then just paint a row of rectangles along the diagonal with this pen for reference.
This brush can do much more, as well. It can use several points on planes and so on and does the color interpolation for you. You just draw with it. Refer to the MSDN for further details: http://msdn.microsoft.com/de-de/library/system.drawing.drawing2d.lineargradientbrush.aspx
Please only look at this if you get stuck. You will learn more by trying it yourself first. Your teacher has probably seen this.
If you use the HSL colour representation, you should be able to get a nice effect by keeping S (saturation) and L (lightness) constant while varying H (hue). You will need to write functions to convert between RGB and HSL - there are many instances of that on the Internet, so here's another one:
Public Class ColourRepresentation
' Adapted from http://www.geekymonkey.com/Programming/CSharp/RGB2HSL_HSL2RGB.htm
' with conversion from C# to VB.NET by http://www.developerfusion.com/tools/convert/csharp-to-vb/
Public Class HSLcolour
Property H As Double
Property S As Double
Property L As Double
Public Overrides Function ToString() As String
Return String.Format("H={0}, S={1}, L={2}", H, S, L)
End Function
End Class
''' <summary>
''' Convert from HSL to RGB.
''' </summary>
''' <param name="c">An HSLcolour</param>
''' <returns>A System.Drawing.Color with A set to 255.</returns>
''' <remarks>H, S, L in the range [0.0, 1.0].</remarks>
Public Shared Function HSLtoRGB(c As HSLcolour) As Color
Dim r As Double = c.L
Dim g As Double = c.L
Dim b As Double = c.L
Dim v As Double = If((c.L <= 0.5), (c.L * (1.0 + c.S)), (c.L + c.S - c.L * c.S))
If v > 0 Then
Dim m As Double = c.L + c.L - v
Dim sv As Double = (v - m) / v
c.H *= 6.0
Dim sextant As Integer = CInt(Math.Truncate(c.H))
Dim fract As Double = c.H - sextant
Dim vsf As Double = v * sv * fract
Dim mid1 As Double = m + vsf
Dim mid2 As Double = v - vsf
Select Case sextant
Case 0, 6
r = v
g = mid1
b = m
Case 1
r = mid2
g = v
b = m
Case 2
r = m
g = v
b = mid1
Case 3
r = m
g = mid2
b = v
Case 4
r = mid1
g = m
b = v
Case 5
r = v
g = m
b = mid2
End Select
End If
Return Color.FromArgb(255, CByte(r * 255), CByte(g * 255), CByte(b * 255))
End Function
' Given a Color (RGB Struct) in range of 0-255
' Return H,S,L in range of 0-1
''' <summary>
''' Convert from a Color to an HSLcolour.
''' </summary>
''' <param name="rgb">A System.Drawing.Color.</param>
''' <returns>An HSLcolour.</returns>
''' <remarks>Ignores Alpha value in the parameter.</remarks>
Public Shared Function RGBtoHSL(rgb As Color) As HSLcolour
Dim r As Double = rgb.R / 255.0
Dim g As Double = rgb.G / 255.0
Dim b As Double = rgb.B / 255.0
Dim v As Double = Math.Max(r, g)
v = Math.Max(v, b)
Dim m As Double = Math.Min(r, g)
m = Math.Min(m, b)
Dim l As Double = (m + v) / 2.0
If l <= 0.0 Then
Return New HSLcolour With {.H = 0, .L = 0, .S = 0}
End If
Dim vm As Double = v - m
Dim s As Double = vm
If s > 0.0 Then
s /= If((l <= 0.5), (v + m), (2.0 - v - m))
Else
Return New HSLcolour With {.H = 0, .L = 0, .S = 0}
End If
Dim r2 As Double = (v - r) / vm
Dim g2 As Double = (v - g) / vm
Dim b2 As Double = (v - b) / vm
Dim h As Double = 0
If r = v Then
h = (If(g = m, 5.0 + b2, 1.0 - g2))
ElseIf g = v Then
h = (If(b = m, 1.0 + r2, 3.0 - b2))
Else
h = (If(r = m, 3.0 + g2, 5.0 - r2))
End If
h /= 6.0
Return New HSLcolour With {.H = h, .L = l, .S = s}
End Function
End Class
Then you will need a way of varying the hue, which I have used in this crude example of drawing a bar chart (I put one PictureBox on a Form):
Option Strict On
Option Infer On
Public Class Form1
Dim rand As New Random
Dim data As List(Of Double)
Private Function DoubleModOne(value As Double) As Double
While value > 1.0
value -= 1.0
End While
While value < 0.0
value += 1.0
End While
Return value
End Function
Sub DrawBars(sender As Object, e As PaintEventArgs)
Dim target = DirectCast(sender, PictureBox)
e.Graphics.Clear(Color.DarkGray)
' an approximation of the bar width
'TODO: Improve the approximation.
Dim barWidth As Integer = CInt(CDbl(target.Width) / data.Count)
Dim maxBarHeight = target.Height
Using br As New SolidBrush(Color.Black)
Dim r As Rectangle
'TODO: make it work for Color.Gainsboro
Dim startColour = ColourRepresentation.RGBtoHSL(Color.Fuchsia)
' these components are broken out in case something needs to be done to them.
Dim startColourH = startColour.H
Dim startColourS = startColour.S
Dim startColourL = startColour.L
' Using 1.0 as the quotient makes the colours go through the whole spectrum.
Dim colourInc As Double = 1.0 / data.Count
' Only expects data to be in the range (0, 1).
For i = 0 To data.Count - 1
Dim thisHSLcolour As New ColourRepresentation.HSLcolour With {.H = DoubleModOne(startColourH + i * colourInc), .S = startColourS, .L = startColourL}
br.Color = ColourRepresentation.HSLtoRGB(thisHSLcolour)
r = New Rectangle(CInt(i * barWidth), CInt(data(i) * maxBarHeight), barWidth, maxBarHeight)
e.Graphics.FillRectangle(br, r)
Next
End Using
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim nBars = 100
data = New List(Of Double)(nBars)
For i = 0 To nBars - 1
data.Add(rand.NextDouble())
Next
AddHandler PictureBox1.Paint, AddressOf DrawBars
End Sub
End Class
Resulting in:
No-one ever accused me of choosing subtle colours, lol.
Is there anybody know how to make normal distributed random number in vb.net?
thank you
From this forum post :
Usage:
GaussNumDist(Mean, Standard Deviation, Sample Size)
Code example below, which will populate GaussNumArray() with the sample of numbers, whose distribution will have the mean and standard deviation specified:
Imports System.Math
Module Module1
Friend GaussNumArray() As Double
Friend intICell As Long
Friend Function GaussNumDist(ByVal Mean As Double, ByVal StdDev As Double, ByVal SampleSize As Integer)
intICell = 1 'Loop variable
ReDim GaussNumArray(SampleSize)
Do While (intICell < (SampleSize + 1))
Call NumDist(Mean, StdDev)
Application.DoEvents()
Loop
End Function
Sub NumDist(ByVal meanin As Double, ByVal sdin As Double)
'---------------------------------------------------------------------------------
'Converts uniform random numbers over the region 0 to 1 into Gaussian distributed
'random numbers using Box-Muller algorithm.
'Adapted from Numerical Recipes in C
'---------------------------------------------------------------------------------
'Defining variables
Dim dblR1 As Double
Dim dblR2 As Double
Dim mean As Double
Dim var As Double
Dim circ As Double
Dim trans As Double
Dim dblY1 As Double
Dim dblY2 As Double
Dim Pi As Double
Pi = 4 * Atan(1)
'Get two random numbers
dblR1 = (2 * UniformRandomNumber()) - 1
dblR2 = (2 * UniformRandomNumber()) - 1
circ = (dblR1 ^ 2) + (dblR2 ^ 2) 'Radius of circle
If circ >= 1 Then 'If outside unit circle, then reject number
Call NumDist(meanin, sdin)
Exit Sub
End If
'Transform to Gaussian
trans = Sqrt(-2 * Log(circ) / circ)
dblY1 = (trans * dblR1 * sdin) + meanin
dblY2 = (trans * dblR2 * sdin) + meanin
GaussNumArray(intICell) = dblY1 'First number
'Increase intICell for next random number
intICell = (intICell + 1)
GaussNumArray(intICell) = dblY2 'Second number
'Increase intICell again ready for next call of ConvertNumberDistribution
intICell = (intICell + 1)
End Sub
Friend Function UniformRandomNumber() As Double
'-----------------------------------------------------------------------------------
'Outputs random numbers with a period of > 2x10^18 in the range 0 to 1 (exclusive)
'Implements a L'Ecuyer generator with Bays-Durham shuffle
'Adapted from Numerical Recipes in C
'-----------------------------------------------------------------------------------
'Defining constants
Const IM1 As Double = 2147483563
Const IM2 As Double = 2147483399
Const AM As Double = (1.0# / IM1)
Const IMM1 As Double = (IM1 - 1.0#)
Const IA1 As Double = 40014
Const IA2 As Double = 40692
Const IQ1 As Double = 53668
Const IQ2 As Double = 52774
Const IR1 As Double = 12211
Const IR2 As Double = 3791
Const NTAB As Double = 32
Const NDIV As Double = (1.0# + IM1 / NTAB)
Const ESP As Double = 0.00000012
Const RNMX As Double = (1.0# - ESP)
Dim iCell As Integer
Dim idum As Double
Dim j As Integer
Dim k As Long
Dim temp As Double
Static idum2 As Long
Static iy As Long
Static iv(NTAB) As Long
idum2 = 123456789
iy = 0
'Seed value required is a negative integer (idum)
Randomize()
idum = (-Rnd() * 1000)
'For loop to generate a sequence of random numbers based on idum
For iCell = 1 To 10
'Initialize generator
If (idum <= 0) Then
'Prevent idum = 0
If (-(idum) < 1) Then
idum = 1
Else
idum = -(idum)
End If
idum2 = idum
For j = (NTAB + 7) To 0
k = ((idum) / IQ1)
idum = ((IA1 * (idum - (k * IQ1))) - (k * IR1))
If (idum < 0) Then
idum = (idum + IM1)
End If
If (j < NTAB) Then
iv(j) = idum
End If
Next j
iy = iv(0)
End If
'Start here when not initializing
k = (idum / IQ1)
idum = ((IA1 * (idum - (k * IQ1))) - (k * IR1))
If (idum < 0) Then
idum = (idum + IM1)
End If
k = (idum2 / IQ2)
idum2 = ((IA2 * (idum2 - (k * IQ2))) - (k * IR2))
If (idum2 < 0) Then
idum2 = idum2 + IM2
End If
j = (iy / NDIV)
iy = (iv(j) - idum2)
iv(j) = idum
If (iy < 1) Then
iy = (iy + IMM1)
End If
temp = AM * iy
If (temp <= RNMX) Then
'Return the value of the random number
UniformRandomNumber = temp
End If
Next iCell
End Function
End Module
You can use following line
Dim x1 as Double = MathNet.Numerics.Distributions.Normal.Sample(MEAN, STDEV)
Math.Net Numeric package can be installed using following NuGet command
Install-Package MathNet.Numerics -Version 4.9.0
You can found more information on NuGet site
I am using the ZedGraph control (zgc) to create individual stacked bar charts and display them in a single stacked column as shown in the image below.
The issue that I am having is that I have no control over the number of panes that are displayed in the control as this is determined by the number of items in a listbox. It seems that the default nature of the control allows the height of the graph panes to change depending on the number of panes that are displayed within the control.
The zgc is set to dock=fill within a panel control that is set to dock=fill within the form. I would like to force the graph panes to be a static height and when needed have a vertical scroll bar appear in the panel when the number of graph panes exceeds the height of the form. How can I go about achieving this? My code for creating and populating the zgc is posted below the image.
Private Sub CreateGraph(ByVal dat As Date)
Dim count As Integer = 0
Dim master As MasterPane = zgc.MasterPane
master.Fill = New Fill(Color.FromArgb(180, 180, 180), Color.FromArgb(180, 180, 180), 45.0F)
master.PaneList.Clear()
master.Title.IsVisible = True
master.Title.Text = "Workload for " & dat.ToShortDateString()
master.Margin.All = 10
master.InnerPaneGap = 5
master.IsCommonScaleFactor = False
For Each mach As String In lbMach.Items
rowCount = 0
Dim myPaneT As New GraphPane(New Rectangle(10, 10, 10, 10), "", "Time in Minutes", mach)
myPaneT.Fill.IsVisible = False
myPaneT.Chart.Fill = New Fill(Color.White, Color.White, 45.0F)
myPaneT.BaseDimension = 3.0F
myPaneT.XAxis.Title.IsVisible = False
myPaneT.XAxis.Scale.IsVisible = False
myPaneT.XAxis.Scale.Min = 0
myPaneT.XAxis.Scale.Max = (MeiSettings.WrkHrs * 60)
myPaneT.Legend.IsVisible = True
myPaneT.Border.IsVisible = False
myPaneT.Title.IsVisible = False
myPaneT.XAxis.MajorTic.IsOutside = False
myPaneT.XAxis.MinorTic.IsOutside = False
myPaneT.XAxis.MajorGrid.IsVisible = True
myPaneT.XAxis.MinorGrid.IsVisible = True
myPaneT.Margin.All = 1
If count = lbMach.Items.Count - 1 Then
myPaneT.XAxis.Title.IsVisible = True
myPaneT.XAxis.Scale.IsVisible = True
myPaneT.Margin.Bottom = 10
End If
If count > 0 Then
myPaneT.YAxis.Scale.IsSkipLastLabel = True
End If
myPaneT.YAxis.MinSpace = 20
myPaneT.Y2Axis.MinSpace = 20
Dim dt As DataTable = ItemsByMachineDT(mach, dat)
Dim myCurve As BarItem
If dt.Rows.Count > 0 Then
Dim profName As String = Nothing
Dim timeDur() As Double
For Each dr As DataRow In dt.Rows
If profName = dr("PRO").ToString() Then
timeDur = {((Convert.ToDouble(dr("QTY")) / Convert.ToDouble(dr("MPM"))))}
Else
timeDur = {((Convert.ToDouble(dr("QTY")) / Convert.ToDouble(dr("MPM")) + Convert.ToDouble(dr("Time"))))}
End If
myCurve = myPaneT.AddBar(dr("JOB").ToString & " - " & dr("PRO").ToString(), timeDur, Nothing, BarColor(rowCount))
If MeiSettings.IsGradient = True Then
myCurve.Bar.Fill = New Fill(BarColor(rowCount), Color.White, BarColor(rowCount), 90.0F)
Else
myCurve.Bar.Fill = New Fill(BarColor(rowCount), BarColor(rowCount), BarColor(rowCount), 90.0F)
End If
rowCount += 1
profName = dr("PRO").ToString()
Next
End If
myPaneT.YAxis.MajorTic.IsBetweenLabels = True
myPaneT.YAxis.Type = AxisType.Text
myPaneT.BarSettings.Type = BarType.Stack
myPaneT.BarSettings.Base = BarBase.Y
master.Add(myPaneT)
count += 1
Next
zgc.IsShowPointValues = True
Using g As Graphics = Me.CreateGraphics()
master.SetLayout(g, PaneLayout.SingleColumn)
master.AxisChange(g)
End Using
End Sub
to get control for each GraphPane :
GraphPane temp = zgc.MasterPane.PaneList.ElementAt(ind); //ind => index of the graphpane in zedgraphcontrol
to set static height n width ZedgraphControl :
zgc.Size = new Size(Width,Height);
to set visibility of scrollbar ZedgraphControl :
zgc.IsShowHScrollBar = true;
zgc.IsShowVScrollBar = true;
After some research, I've decided to use the Liang-Barsky line clipping algorithm in my 2D game. Google did not deliver on any VB.NET implementations of this algorithm but plenty C/++ ones. Therefore, as I have knowledge in C++, decided to port one found on Skytopia over to VB.Net. Unfortunately, it does not work with:
Public Class PhysicsObject
Public Function CollideRay(ByVal p0 As Point, ByVal p1 As Point, ByRef clip0 As Point, ByRef clip1 As Point) As Boolean
Dim t0 As Double = 0.0
Dim t1 As Double = 1.0
Dim xdelta As Double = p1.X - p0.X
Dim ydelta As Double = p1.Y - p0.Y
Dim p, q, r As Double
For edge = 0 To 3
' Traverse through left, right, bottom, top edges
If (edge = 0) Then
p = -xdelta
q = -(AABB.Left - p0.X)
ElseIf (edge = 1) Then
p = xdelta
q = (AABB.Right - p0.X)
ElseIf (edge = 2) Then
p = -ydelta
q = -(AABB.Bottom - p0.Y)
ElseIf (edge = 3) Then
p = ydelta
q = (AABB.Top - p0.Y)
End If
r = q / p
If p = 0 And q < 0 Then Return False ' Don't draw line at all. (parallel line outside)
If p < 0 Then
If r > t1 Then
Return False ' Don't draw line at all.
ElseIf r > t0 Then
t0 = r ' Line is clipped!
End If
ElseIf p > 0 Then
If r < t0 Then
Return False ' Don't draw line at all.
ElseIf r < t1 Then
t1 = r ' Line is clipped!
End If
End If
Next
clip0.X = p0.X + t0 * xdelta
clip0.Y = p0.Y + t0 * ydelta
clip1.X = p0.X + t1 * xdelta
clip1.Y = p0.Y + t1 * ydelta
Return True ' (clipped) line is drawn
End Function
Public AABB As Rectangle
End Class
I'm using the class/method like:
Dim testPhysics As PhysicsObject = New PhysicsObject
testPhysics.AABB = New Rectangle(30, 30, 20, 20)
Dim p0, p1 As Point
p0 = New Point(0, 0)
p1 = New Point(120, 120)
Dim clip0, clip1 As Point
clip0 = New Point(-1, -1)
clip1 = New Point(-1, -1)
GlobalRenderer.Graphics.DrawLine(Pens.LimeGreen, p0, p1)
If testPhysics.CollideRay(p0, p1, clip0, clip1) Then
GlobalRenderer.Graphics.DrawLine(Pens.Magenta, clip0, clip1)
End If
However, the CollideRay method fails on its 3rd edge iteration (edge = 3), r < t0, therefore the function returns false.
I'm wondering if anyone can spot some issue with my CollideRay function which would result in this behaviour, because I'm well and truly stumped.
Thanks in advance.
The code assumes a different coordinate system, note that topEdge is larger than bottomEdge in the linked web page. Your test works with normal graphics coordinates where Bottom is larger than Top. You have to swap the bottom and top arguments.