Imports System.Drawing.Drawing2D
'''
''' Adds an easy to use Gantt Chart to your application
''' Created by Adrian "Adagio" Grau
''' Version 0.55
'''
'''
Public Class GanttChart
Inherits Control
Private mouseHoverPart As MouseOverPart = MouseOverPart.Empty : Private mouseHoverBarIndex As Integer = -1 : Private bars As New List(Of ChartBarDate)
Private headerFromDate As Date = Nothing : Private headerToDate As Date = Nothing : Private barIsChanging As Integer = -1
Private ReadOnly barStartRight As Integer = 20 : Private barStartLeft As Integer = 100 : Private ReadOnly headerTimeStartTop As Integer = 30
Private shownHeaderList As List(Of Header) : Private ReadOnly barStartTop As Integer = 50 : Private ReadOnly barHeight As Integer = 35
Private ReadOnly barSpace As Integer = 5 : Private widthPerItem As Integer : Private _mouseOverColumnValue As Date = Nothing
Private _mouseOverRowText As String = "" : Private _mouseOverRowValue As Object = Nothing : Private lineColor As Pen = Pens.Bisque
Private dateTextFont As Font = New Font("VERDANA", 8.0, FontStyle.Regular, GraphicsUnit.Point) : Private timeTextFont As Font = New Font("VERDANA", 8.0, FontStyle.Regular, GraphicsUnit.Point)
Private rowTextFont As Font = New Font("VERDANA", 8.0, FontStyle.Regular, GraphicsUnit.Point) : Friend WithEvents ToolTip As New System.Windows.Forms.ToolTip()
Private _allowEditBarWithMouse As Boolean = False : Public Event MouseDragged(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
Public Event BarChanged(ByVal sender As Object, ByRef barValue As Object)
Private objBmp As Bitmap
Private objGraphics As Graphics
#Region "Public properties"
'''
''' Sets to true if the user should be able to manually edit bars
'''
'''
'''
'''
Public Property AllowManualEditBar() As Boolean
Get
Return _allowEditBarWithMouse
End Get
Set(ByVal value As Boolean)
_allowEditBarWithMouse = value
End Set
End Property
'''
''' The start date/time of the chart
'''
'''
'''
'''
Public Property FromDate() As Date
Get
Return headerFromDate
End Get
Set(ByVal value As Date)
headerFromDate = value
End Set
End Property
'''
''' The end date/time of the chart
'''
'''
'''
'''
Public Property ToDate() As Date
Get
Return headerToDate
End Get
Set(ByVal value As Date)
headerToDate = value
End Set
End Property
'''
''' The text for the current row the mouse hovers above
'''
'''
'''
'''
Public ReadOnly Property MouseOverRowText() As String
Get
Return _mouseOverRowText
End Get
End Property
'''
''' The value for the current bar the mouse hovers above
'''
'''
'''
'''
Public ReadOnly Property MouseOverRowValue() As Object
Get
Return _mouseOverRowValue
End Get
End Property
'''
''' The date/time the mouse hovers above
'''
'''
'''
'''
Public ReadOnly Property MouseOverColumnDate() As Date
Get
Return _mouseOverColumnValue
End Get
End Property
'''
''' The color of the grid
'''
'''
'''
'''
Public Property GridColor() As System.Drawing.Pen
Get
Return lineColor
End Get
Set(ByVal value As System.Drawing.Pen)
lineColor = value
End Set
End Property
'''
''' The font used for the row text
'''
'''
'''
'''
Public Property RowFont() As Font
Get
Return rowTextFont
End Get
Set(ByVal value As Font)
rowTextFont = value
End Set
End Property
'''
''' The font used for the "date" text in the columns
'''
'''
'''
'''
Public Property DateFont() As Font
Get
Return dateTextFont
End Get
Set(ByVal value As Font)
dateTextFont = value
End Set
End Property
'''
''' The font used for the "time" text in the colums)
'''
'''
'''
'''
Public Property TimeFont() As Font
Get
Return timeTextFont
End Get
Set(ByVal value As Font)
timeTextFont = value
End Set
End Property
#End Region
#Region "Constructor"
'''
''' Default constructor
'''
'''
Public Sub New()
ToolTip.AutoPopDelay = 15000 : ToolTip.InitialDelay = 250 : ToolTip.OwnerDraw = True
objBmp = New Bitmap(1280, 1024, Imaging.PixelFormat.Format24bppRgb) : objGraphics = Graphics.FromImage(objBmp)
' Flicker free drawing
Me.SetStyle(ControlStyles.DoubleBuffer Or ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint, True)
End Sub
#End Region
#Region "Bars"
Private Sub SetBarStartLeft(ByVal rowText As String)
Dim gfx As Graphics = Me.CreateGraphics
Dim length As Integer = gfx.MeasureString(rowText, rowTextFont, 500).Width
If length > barStartLeft Then : barStartLeft = length : End If
End Sub
'''
''' Adds a bar to the list
'''
''' Text for the row
''' Value for the row
''' The date/time the bar starts
''' The date/time the bar ends
''' The color of the bar
''' The hover color of the bar
''' The rowindex of the bar (useful if you want several bars on the same row)
'''
Public Sub AddChartBar(ByVal rowText As String, ByVal barValue As Object, ByVal fromTime As Date, ByVal toTime As Date,
ByVal color As Color, ByVal hoverColor As Color, ByVal rowIndex As Integer)
Dim bar As New ChartBarDate With {
.Text = rowText,
.Value = barValue,
.StartValue = fromTime,
.EndValue = toTime,
.Color = color,
.HoverColor = hoverColor,
.RowIndex = rowIndex
} : bars.Add(bar) : SetBarStartLeft(rowText)
End Sub
'''
''' Adds a bar to the list
'''
''' Text for the row
''' Value for the row
''' The date/time the bar starts
''' The date/time the bar ends
''' The color of the bar
''' The hover color of the bar
''' The rowindex of the bar (useful if you want several bars on the same row)
''' If you want to "hide" the bar from mousemove event
'''
Public Sub AddChartBar(ByVal rowText As String, ByVal barValue As Object, ByVal fromTime As Date, ByVal toTime As Date, ByVal color As Color,
ByVal hoverColor As Color, ByVal rowIndex As Integer, ByVal hideFromMouseMove As Boolean)
Dim bar As New ChartBarDate With {
.Text = rowText,
.Value = barValue,
.StartValue = fromTime,
.EndValue = toTime,
.Color = color,
.HoverColor = hoverColor,
.RowIndex = rowIndex,
.HideFromMouseMove = hideFromMouseMove
} : bars.Add(bar) : SetBarStartLeft(rowText)
End Sub
'''
''' Gets the next index
'''
'''
'''
'''
Public Function GetIndexChartBar(ByVal rowText As String) As Integer
Dim index As Integer = -1
For Each bar As ChartBarDate In bars : If bar.Text.Equals(rowText) = True Then : Return bar.RowIndex : End If : If bar.RowIndex > index Then : index = bar.RowIndex : End If : Next
Return index + 1
End Function
'''
''' Removes all bars from list
'''
'''
Public Sub RemoveBars()
bars = New List(Of ChartBarDate) : barStartLeft = 100
End Sub
#End Region
#Region "Draw"
'''
''' Redraws the Gantt chart
'''
'''
Public Sub PaintChart()
Me.Invalidate()
End Sub
'''
''' Redraws the Gantt chart
'''
'''
'''
Private Sub PaintChart(ByVal gfx As Graphics)
Try
gfx.Clear(Me.BackColor) : If headerFromDate = Nothing Or headerToDate = Nothing Then Exit Sub
DrawScrollBar(gfx) : DrawHeader(gfx, Nothing) : DrawNetHorizontal(gfx) : DrawNetVertical(gfx) : DrawBars(gfx)
objBmp = New Bitmap(Me.Width - barStartRight, lastLineStop, Imaging.PixelFormat.Format24bppRgb)
objGraphics = Graphics.FromImage(objBmp)
Catch ex As Exception
End Try
End Sub
'''
''' Redraws the Gantt chart
'''
'''
'''
Protected Overrides Sub OnPaint(ByVal pe As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaint(pe) : PaintChart(pe.Graphics)
End Sub
'''
''' Draws the list of headers. Automatically shows which headers to draw, based on the width of the Gantt Chart
'''
'''
'''
'''
Private Sub DrawHeader(ByVal gfx As Graphics, ByVal headerList As List(Of Header))
If headerList Is Nothing Then : headerList = GetFullHeaderList() : End If
If headerList.Count = 0 Then Exit Sub
Dim availableWidth = Me.Width - 10 - barStartLeft - barStartRight : widthPerItem = availableWidth / headerList.Count
If widthPerItem < 40 Then
Dim newHeaderList As New List(Of Header) : Dim showNext As Boolean = True
' If there's not enough room for all headers remove 50%
For Each header As Header In headerList : If showNext = True Then : newHeaderList.Add(header) : showNext = False : Else : showNext = True : End If : Next
DrawHeader(gfx, newHeaderList) : Exit Sub
End If
Dim index As Integer = 0 : Dim lastHeader As Header = Nothing ': Dim headerStartPosition As Integer = -1
For Each header As Header In headerList
Dim startPos As Integer = barStartLeft + (index * widthPerItem) : Dim showDateHeader As Boolean = False : header.StartLocation = startPos
' Checks whether to show the date or not
If lastHeader Is Nothing Then : showDateHeader = True
ElseIf header.Time.Hour < lastHeader.Time.Hour Then : showDateHeader = True
ElseIf header.Time.Minute = lastHeader.Time.Minute Then : showDateHeader = True : End If
' Show date
If showDateHeader = True Then
Dim str As String = ""
If header.HeaderTextInsteadOfTime.Length > 0 Then : str = header.HeaderTextInsteadOfTime
Else : str = header.Time.ToString("d-MMM") : End If : gfx.DrawString(str, dateTextFont, Brushes.Black, startPos, 0)
End If
' Show time
gfx.DrawString(header.HeaderText, timeTextFont, Brushes.Black, startPos, headerTimeStartTop) : index += 1 : lastHeader = header
Next
shownHeaderList = headerList : widthPerItem = (Me.Width - 10 - barStartLeft - barStartRight) / shownHeaderList.Count
End Sub
'''
''' Draws the bars
'''
'''
'''
Private Sub DrawBars(ByVal grfx As Graphics, Optional ByVal ignoreScrollAndMousePosition As Boolean = False)
If shownHeaderList Is Nothing Then Exit Sub : If shownHeaderList.Count = 0 Then Exit Sub
Dim index As Integer
' Finds pixels per minute
Dim timeBetween As TimeSpan = shownHeaderList(1).Time - shownHeaderList(0).Time
Dim minutesBetween As Integer = CInt(timeBetween.TotalMinutes) '(timeBetween.Days * 1440) + (timeBetween.Hours * 60) + timeBetween.Minutes
Dim widthBetween = (shownHeaderList(1).StartLocation - shownHeaderList(0).StartLocation) : Dim perMinute As Decimal = widthBetween / minutesBetween
' Draws each bar
For Each bar As ChartBarDate In bars
index = bar.RowIndex : Dim startLocation As Integer : Dim width As Integer : Dim startMinutes As Integer ' Number of minutes from start of the gantt chart
Dim startTimeSpan As TimeSpan : Dim lengthMinutes As Integer ' Number of minutes from bar start to bar end
Dim lengthTimeSpan As TimeSpan : Dim scrollPos As Integer = 0
If ignoreScrollAndMousePosition = False Then : scrollPos = scrollPosition : End If
' Calculates where the bar should be located
startTimeSpan = bar.StartValue - FromDate : startMinutes = (startTimeSpan.Days * 1440) + (startTimeSpan.Hours * 60) + startTimeSpan.Minutes
startLocation = perMinute * startMinutes : Dim endValue As Date = bar.EndValue
If endValue = Nothing Then : endValue = Date.Now : End If
lengthTimeSpan = endValue - bar.StartValue : lengthMinutes = (lengthTimeSpan.Days * 1440) + (lengthTimeSpan.Hours * 60) + lengthTimeSpan.Minutes
width = perMinute * lengthMinutes
Dim a As Integer = barStartLeft + startLocation : Dim b As Integer = barStartTop + (barHeight * (index - scrollPos)) + (barSpace * (index - scrollPos)) + 2
Dim c As Integer = width : Dim d As Integer = barHeight
If c = 0 Then c = 1 ' Stops a bar from going into the row-text area
If a - barStartLeft < 0 Then : a = barStartLeft : End If
Dim color As System.Drawing.Color
' If mouse is over bar, set the color to be hovercolor
If MouseOverRowText = bar.Text And bar.StartValue <= _mouseOverColumnValue And bar.EndValue >= _mouseOverColumnValue Then
color = bar.HoverColor : Else : color = bar.Color : End If
' Set the location for the graphics
bar.TopLocation.Left = New Point(a, b) : bar.TopLocation.Right = New Point(a + c, b) : bar.BottomLocation.Left = New Point(a, b + d)
bar.BottomLocation.Right = New Point(a, b + d)
Dim obBrush As LinearGradientBrush : Dim obRect As New Rectangle(a, b, c, d)
If bar.StartValue <> Nothing And endValue <> Nothing Then
If (index >= scrollPos And index < barsViewable + scrollPos) Or ignoreScrollAndMousePosition = True Then ' Makes the bar gradient
obBrush = New LinearGradientBrush(obRect, color, Color.Gray, LinearGradientMode.Vertical) ' Draws the bar
grfx.DrawRectangle(Pens.Black, obRect) : grfx.FillRectangle(obBrush, obRect) ' Draws the rowtext
grfx.DrawString(bar.Text, rowTextFont, Brushes.Black, 0, barStartTop + (barHeight * (index - scrollPos)) + (barSpace * (index - scrollPos)))
obBrush = Nothing : obRect = Nothing : obBrush = Nothing
End If
End If : color = Nothing
Next
End Sub
'''
''' Draws the vertical lines
'''
'''
'''
Public Sub DrawNetVertical(ByVal grfx As Graphics)
If shownHeaderList Is Nothing Then Exit Sub : If shownHeaderList.Count = 0 Then Exit Sub
Dim index As Integer = 0 : Dim availableWidth As Integer = Me.Width - 10 - barStartLeft - barStartRight : Dim lastHeader As Header = Nothing
For Each header As Header In shownHeaderList
Dim headerLocationY As Integer = 0
If lastHeader Is Nothing Then : headerLocationY = 0 : ElseIf header.Time.Hour < lastHeader.Time.Hour Then : headerLocationY = 0 : Else : headerLocationY = headerTimeStartTop : End If
grfx.DrawLine(Pens.Bisque, barStartLeft + (index * widthPerItem), headerLocationY, barStartLeft + (index * widthPerItem), lastLineStop) : index += 1 : lastHeader = header
Next
grfx.DrawLine(lineColor, barStartLeft + (index * widthPerItem), headerTimeStartTop, barStartLeft + (index * widthPerItem), lastLineStop)
End Sub
'''
''' Draws the horizontal lines
'''
'''
'''
Public Sub DrawNetHorizontal(ByVal grfx As Graphics)
If shownHeaderList Is Nothing Then Exit Sub : If shownHeaderList.Count = 0 Then Exit Sub
Dim index As Integer : Dim width As Integer = (widthPerItem * shownHeaderList.Count) + barStartLeft
For index = 0 To GetIndexChartBar("QQQQQQ") ' Last used index. Hopefully nobody will make a row named QQQ :o)
For Each bar As ChartBarDate In bars
grfx.DrawLine(lineColor, 0, barStartTop + (barHeight * index) + (barSpace * index), width, barStartTop + (barHeight * index) + (barSpace * index))
Next
Next : lastLineStop = barStartTop + (barHeight * (index - 1)) + (barSpace * (index - 1))
End Sub ' This is the position (in pixels, from top) of the last line. Used for drawing lines
Private lastLineStop As Integer = 0
#End Region
#Region "Header list"
'''
''' Gets the full header list, consisting of hours between the two dates set
'''
'''
'''
Private Function GetFullHeaderList() As List(Of Header)
Dim result As New List(Of Header) : Dim newFromTime As New Date(FromDate.Year, FromDate.Month, FromDate.Day) : Dim item As String : Dim interval As TimeSpan = ToDate - FromDate
If interval.TotalDays < 1 Then
With newFromTime
newFromTime = .AddHours(FromDate.Hour)
If headerFromDate.Minute < 59 And headerFromDate.Minute > 29 Then : newFromTime = .AddMinutes(30) : Else : newFromTime = .AddMinutes(0) : End If
End With
While newFromTime <= ToDate
item = newFromTime.Hour & ":" : If newFromTime.Minute < 10 Then : item += "0" & newFromTime.Minute : Else : item += "" & newFromTime.Minute : End If
Dim header As New Header With {
.HeaderText = item,
.HeaderTextInsteadOfTime = "",
.Time = New Date(newFromTime.Year, newFromTime.Month, newFromTime.Day, newFromTime.Hour, newFromTime.Minute, 0)
} : result.Add(header) : newFromTime = newFromTime.AddMinutes(5) ' The minimum interval of time between the headers
End While
ElseIf interval.TotalDays < 60 Then
While newFromTime <= ToDate
Dim header As New Header With {
.HeaderText = "",
.HeaderTextInsteadOfTime = "",
.Time = New Date(newFromTime.Year, newFromTime.Month, newFromTime.Day, 0, 0, 0)
} : result.Add(header) : newFromTime = newFromTime.AddDays(1) ' The minimum interval of time between the headers
End While
Else
While newFromTime <= ToDate
Dim header As New Header With {
.HeaderText = "",
.Time = New Date(newFromTime.Year, newFromTime.Month, newFromTime.Day, 0, 0, 0),
.HeaderTextInsteadOfTime = newFromTime.ToString("MMM")
} : result.Add(header) : newFromTime = newFromTime.AddMonths(1) ' The minimum interval of time between the headers
End While
End If : Return result
End Function
#End Region
#Region "Mouse Move"
'''
''' Finds the current row and column based on mouse position
'''
'''
'''
'''
Private Sub GanttChart_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
If shownHeaderList Is Nothing Then Exit Sub : If shownHeaderList.Count = 0 Then Exit Sub
If e.Button <> Windows.Forms.MouseButtons.Left Then : mouseHoverPart = MouseOverPart.Empty
' If bar has changed manually, but left mouse button is no longer pressed the BarChanged event will be raised
If AllowManualEditBar = True Then : If barIsChanging >= 0 Then : RaiseEvent BarChanged(Me, bars(barIsChanging).Value) : barIsChanging = -1 : End If : End If
End If
mouseHoverBarIndex = -1 : Dim LocalMousePosition As Point
LocalMousePosition = Me.PointToClient(Cursor.Position) ' Finds pixels per minute
Dim timeBetween As TimeSpan = shownHeaderList(1).Time - shownHeaderList(0).Time : Dim minutesBetween As Integer = (timeBetween.Days * 1440) + (timeBetween.Hours * 60) + timeBetween.Minutes
Dim widthBetween = (shownHeaderList(1).StartLocation - shownHeaderList(0).StartLocation) : Dim perMinute As Decimal = widthBetween / minutesBetween
' Finds the time at mousepointer
Dim minutesAtCursor As Integer
If LocalMousePosition.X > barStartLeft Then : minutesAtCursor = (LocalMousePosition.X - barStartLeft) / perMinute : _mouseOverColumnValue = FromDate.AddMinutes(minutesAtCursor)
Else : _mouseOverColumnValue = Nothing : End If ' Finds the row at mousepointer
Dim rowText As String = "" : Dim rowValue As Object = Nothing ': Dim columnText As String ' Tests to see if the mouse pointer is hovering above the scrollbar
Dim scrollBarStatusChanged As Boolean = False ' Tests to see if the mouse is hovering over the scroll-area bottom-arrow
If LocalMousePosition.X > BottomPart.Left And LocalMousePosition.Y < BottomPart.Right And LocalMousePosition.Y < BottomPart.Bottom And LocalMousePosition.Y > BottomPart.Top Then
If mouseOverBottomPart = False Then : scrollBarStatusChanged = True : End If : mouseOverBottomPart = True
Else : If mouseOverBottomPart = False Then : scrollBarStatusChanged = True : End If : mouseOverBottomPart = False : End If
' Tests to see if the mouse is hovering over the scroll-area top-arrow
If LocalMousePosition.X > topPart.Left And LocalMousePosition.Y < topPart.Right And LocalMousePosition.Y < topPart.Bottom And LocalMousePosition.Y > topPart.Top Then
If mouseOverTopPart = False Then : scrollBarStatusChanged = True : End If : mouseOverTopPart = True
Else : If mouseOverTopPart = False Then : scrollBarStatusChanged = True : End If : mouseOverTopPart = False : End If
' Tests to see if the mouse is hovering over the scroll
If LocalMousePosition.X > scroll.Left And LocalMousePosition.Y < scroll.Right And LocalMousePosition.Y < scroll.Bottom And LocalMousePosition.Y > scroll.Top Then
If mouseOverScrollBar = False Then : scrollBarStatusChanged = True : End If : mouseOverScrollBar = True : mouseOverScrollBarArea = True
Else
If mouseOverScrollBar = False Then : scrollBarStatusChanged = True : End If : mouseOverScrollBar = False : mouseOverScrollBarArea = False
End If
' If the mouse is not above the scroll, test if it's over the scroll area (no need to test if it's not above the scroll)
If mouseOverScrollBarArea = False Then
If LocalMousePosition.X > scrollBarArea.Left And LocalMousePosition.Y < scrollBarArea.Right And LocalMousePosition.Y < scrollBarArea.Bottom And LocalMousePosition.Y > scrollBarArea.Top Then
mouseOverScrollBarArea = True
End If
End If ' Tests to see if the mouse pointer is hovering above a bar
Dim index As Integer = 0
For Each bar As ChartBarDate In bars
' If the bar is set to be hidden from mouse move, the current bar will be ignored
If bar.HideFromMouseMove = False Then
If bar.EndValue = Nothing Then : bar.EndValue = Date.Now : End If
' Mouse pointer needs to be inside the X and Y positions of the bar
If LocalMousePosition.Y > bar.TopLocation.Left.Y And LocalMousePosition.Y < bar.BottomLocation.Left.Y Then
If LocalMousePosition.X > bar.TopLocation.Left.X And LocalMousePosition.X < bar.TopLocation.Right.X Then
' If the current bar is the one where the mouse is above, the rowText and rowValue needs to be set correctly
rowText = bar.Text : rowValue = bar.Value : mouseHoverBarIndex = index
If mouseHoverPart <> MouseOverPart.BarLeftSide And mouseHoverPart <> MouseOverPart.BarRightSide Then : mouseHoverPart = MouseOverPart.Bar : End If
End If
' If mouse pointer is near the edges of the bar it will open up for editing the bar
If AllowManualEditBar = True Then
Dim areaSize As Integer = 5 : If e.Button = Windows.Forms.MouseButtons.Left Then : areaSize = 50 : End If
If LocalMousePosition.X > bar.TopLocation.Left.X - areaSize And LocalMousePosition.X < bar.TopLocation.Left.X + areaSize And mouseHoverPart <> MouseOverPart.BarRightSide Then
Me.Cursor = Cursors.VSplit : mouseHoverPart = MouseOverPart.BarLeftSide : mouseHoverBarIndex = index
ElseIf LocalMousePosition.X > bar.TopLocation.Right.X - areaSize And LocalMousePosition.X < bar.TopLocation.Right.X + areaSize And mouseHoverPart <> MouseOverPart.BarLeftSide Then
Me.Cursor = Cursors.VSplit : mouseHoverPart = MouseOverPart.BarRightSide : mouseHoverBarIndex = index
Else : Me.Cursor = Cursors.Default : End If
End If
End If
End If : index += 1
Next ' Sets the mouseover row value and text
_mouseOverRowText = rowText : _mouseOverRowValue = rowValue
If e.Button = Windows.Forms.MouseButtons.Left Then : RaiseEvent MouseDragged(sender, e) : Else
' A simple test to see if the mousemovement has caused any changes to how it should be displayed
' It only redraws if mouse moves from a bar to blank area or from blank area to a bar
' This increases performance compared to having a redraw every time a mouse moves
If (_mouseOverRowValue Is Nothing And Not rowValue Is Nothing) Or (Not _mouseOverRowValue Is Nothing And rowValue Is Nothing) Or scrollBarStatusChanged = True Then : PaintChart() : End If
End If
End Sub
'''
''' Mouse leave event
'''
'''
'''
'''
Private Sub GanttChart_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.MouseLeave
_mouseOverRowText = Nothing : _mouseOverRowValue = Nothing : mouseHoverPart = MouseOverPart.Empty : PaintChart()
End Sub
'''
''' Mouse drag event
'''
'''
'''
'''
Public Sub GanttChart_MouseDragged(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDragged
If mouseOverScrollBarArea = True Then : ScrollPositionY = e.Location.Y : End If
If AllowManualEditBar = True Then
If mouseHoverBarIndex > -1 Then
If mouseHoverPart = MouseOverPart.BarLeftSide Then : barIsChanging = mouseHoverBarIndex : bars(mouseHoverBarIndex).StartValue = _mouseOverColumnValue : PaintChart()
ElseIf mouseHoverPart = MouseOverPart.BarRightSide Then : barIsChanging = mouseHoverBarIndex : bars(mouseHoverBarIndex).EndValue = _mouseOverColumnValue : PaintChart() : End If
End If
End If
End Sub
#End Region
#Region "ToolTipText"
Private _toolTipText As New List(Of String) : Private _toolTipTextTitle As String = "" : Private MyPoint As New Point(0, 0)
'''
''' The title to draw
'''
'''
'''
'''
Public Property ToolTipTextTitle() As String
Get
Return _toolTipTextTitle
End Get
Set(ByVal value As String)
_toolTipTextTitle = value
End Set
End Property
'''
''' Gets or sets the ToolTipText lines
'''
'''
'''
''' Don not use the add function directly on this, use ToolTipText = value
Public Property ToolTipText() As List(Of String)
Get
If _toolTipText Is Nothing Then _toolTipText = New List(Of String) :
Return _toolTipText
End Get
Set(ByVal value As List(Of String))
_toolTipText = value : Dim LocalMousePosition As Point : LocalMousePosition = Me.PointToClient(Cursor.Position)
If LocalMousePosition = MyPoint Then Exit Property : MyPoint = LocalMousePosition : ToolTip.SetToolTip(Me, ".")
End Set
End Property
'''
''' Draws the ToolTip window
'''
'''
'''
'''
Private Sub ToolTipText_Draw(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DrawToolTipEventArgs) Handles ToolTip.Draw
If ToolTipText Is Nothing Then : ToolTipText = New List(Of String) : Exit Sub : End If
If ToolTipText.Count = 0 Then : Exit Sub : ElseIf ToolTipText(0).Length = 0 Then : Exit Sub : End If
Dim x As Integer : Dim y As Integer
e.Graphics.FillRectangle(Brushes.AntiqueWhite, e.Bounds) : e.DrawBorder()
Dim titleHeight As Integer = 14 : Dim fontHeight As Integer = 12
' Draws the line just below the title
e.Graphics.DrawLine(Pens.Black, 0, titleHeight, e.Bounds.Width, titleHeight)
Dim lines As Integer = 1 : Dim text As String = ToolTipTextTitle ' Draws the title
Using font As New Font(e.Font, FontStyle.Bold)
x = (e.Bounds.Width - e.Graphics.MeasureString(text, font).Width) \ 2 : y = (titleHeight - e.Graphics.MeasureString(text, font).Height) \ 2
e.Graphics.DrawString(text, font, Brushes.Black, x, y)
End Using ' Draws the lines
For Each str As String In ToolTipText
Dim font As New Font(e.Font, FontStyle.Regular)
If str.Contains("[b]") Then : font = New Font(font.FontFamily, font.Size, FontStyle.Bold, font.Unit) : str = str.Replace("[b]", "") : End If
Using font
x = 5 : y = (titleHeight - fontHeight - e.Graphics.MeasureString(str, font).Height) \ 2 + 10 + (lines * 14) : e.Graphics.DrawString(str, font, Brushes.Black, x, y)
End Using : lines += 1
Next
End Sub
'''
''' Automatically resizes the ToolTip window
'''
'''
'''
'''
Private Sub ToolTipText_Popup(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PopupEventArgs) Handles ToolTip.Popup
If ToolTipText Is Nothing Then : ToolTipText = New List(Of String) : End If
If ToolTipText.Count = 0 Then : e.ToolTipSize = New Size(0, 0) : Exit Sub
ElseIf ToolTipText(0).Length = 0 Then : e.ToolTipSize = New Size(0, 0) : Exit Sub : End If ' resizes the ToolTip window
Dim height As Integer = 18 + (ToolTipText.Count * 15) : e.ToolTipSize = New Size(200, height)
End Sub
#End Region
#Region "ChartBar"
Private Class ChartBarDate
Friend Class Location
Private _right As New Point(0, 0) : Private _left As New Point(0, 0)
Public Property Right() As Point
Get
Return _right
End Get
Set(ByVal value As Point)
_right = value
End Set
End Property
Public Property Left() As Point
Get
Return _left
End Get
Set(ByVal value As Point)
_left = value
End Set
End Property
End Class
Private _startValue As Date : Private _endValue As Date : Private _color As Color : Private _hoverColor As Color : Private _text As String
Private _value As Object : Private _rowIndex As Integer : Private _topLocation As New Location : Private _bottomLocation As New Location
Private _hideFromMouseMove As Boolean = False
Public Property StartValue() As Date
Get
Return _startValue
End Get
Set(ByVal value As Date)
_startValue = value
End Set
End Property
Public Property EndValue() As Date
Get
Return _endValue
End Get
Set(ByVal value As Date)
_endValue = value
End Set
End Property
Public Property Color() As Color
Get
Return _color
End Get
Set(ByVal value As Color)
_color = value
End Set
End Property
Public Property HoverColor() As Color
Get
Return _hoverColor
End Get
Set(ByVal value As Color)
_hoverColor = value
End Set
End Property
Public Property Text() As String
Get
Return _text
End Get
Set(ByVal value As String)
_text = value
End Set
End Property
Public Property Value() As Object
Get
Return _value
End Get
Set(ByVal value As Object)
_value = value
End Set
End Property
Public Property RowIndex() As Integer
Get
Return _rowIndex
End Get
Set(ByVal value As Integer)
_rowIndex = value
End Set
End Property
Public Property HideFromMouseMove() As Boolean
Get
Return _hideFromMouseMove
End Get
Set(ByVal value As Boolean)
_hideFromMouseMove = value
End Set
End Property
Friend Property TopLocation() As Location
Get
Return _topLocation
End Get
Set(ByVal value As Location)
_topLocation = value
End Set
End Property
Friend Property BottomLocation() As Location
Get
Return _bottomLocation
End Get
Set(ByVal value As Location)
_bottomLocation = value
End Set
End Property
End Class
#End Region
#Region "Headers"
Private Class Header
Private _headerText As String
Private _startLocation As Integer
Private _headerTextInsteadOfTime As String = ""
Private _time As Date = Nothing
Public Property HeaderText() As String
Get
Return _headerText
End Get
Set(ByVal value As String)
_headerText = value
End Set
End Property
Public Property StartLocation() As Integer
Get
Return _startLocation
End Get
Set(ByVal value As Integer)
_startLocation = value
End Set
End Property
'''
''' If this string is larger than 0, this will be used instead of Time
'''
'''
'''
'''
Public Property HeaderTextInsteadOfTime() As String
Get
Return _headerTextInsteadOfTime
End Get
Set(ByVal value As String)
_headerTextInsteadOfTime = value
End Set
End Property
'''
''' Time to display
'''
'''
'''
'''
Public Property Time() As Date
Get
Return _time
End Get
Set(ByVal value As Date)
_time = value
End Set
End Property
End Class
#End Region
#Region "Resize"
'''
''' On resize the Gantt Chart is redrawn
'''
'''
'''
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
Try
MyBase.OnResize(e) : scrollPosition = 0 ' Used for when the Gantt Chart is saved as an image
If lastLineStop > 0 Then : objBmp = New Bitmap(Me.Width - barStartRight, lastLineStop, Imaging.PixelFormat.Format32bppRgb) : objGraphics = Graphics.FromImage(objBmp) : End If
PaintChart()
Catch ex As Exception
End Try
End Sub
#End Region
#Region "Scrollbar"
Private barsViewable As Integer = -1 : Private scrollPosition As Integer = 0 : Private topPart As Rectangle = Nothing : Private BottomPart As Rectangle = Nothing
Private scroll As Rectangle = Nothing : Private scrollBarArea As Rectangle = Nothing : Private mouseOverTopPart As Boolean = False
Private mouseOverBottomPart As Boolean = False : Private mouseOverScrollBar As Boolean = False : Private mouseOverScrollBarArea As Boolean = False
'''
''' Draws a scrollbar to the component, if there's a need for it
'''
'''
'''
Private Sub DrawScrollBar(ByVal grfx As Graphics)
barsViewable = (Me.Height - barStartTop) / (barHeight + barSpace) : Dim barCount As Integer = GetIndexChartBar("QQQWWW")
If barCount = 0 Then Exit Sub
Dim maxHeight As Integer = Me.Height - 30 : Dim scrollHeight As Decimal = (maxHeight / barCount) * barsViewable
' If the scroll area is filled there's no need to show the scrollbar
If scrollHeight >= maxHeight Then Exit Sub
Dim scrollSpeed As Decimal = (maxHeight - scrollHeight) / (barCount - barsViewable) : scrollBarArea = New Rectangle(Me.Width - 20, 19, 12, maxHeight)
scroll = New Rectangle(Me.Width - 20, 19 + (scrollPosition * scrollSpeed), 12, scrollHeight)
topPart = New Rectangle(Me.Width - 20, 10, 12, 8) : BottomPart = New Rectangle(Me.Width - 20, Me.Height - 10, 12, 8)
Dim colorTopPart As Brush : Dim colorBottomPart As Brush : Dim colorScroll As Brush
If mouseOverTopPart = True Then : colorTopPart = Brushes.Black : Else : colorTopPart = Brushes.Gray : End If
If mouseOverBottomPart = True Then : colorBottomPart = Brushes.Black : Else : colorBottomPart = Brushes.Gray : End If
If mouseOverScrollBar = True Then : colorScroll = New LinearGradientBrush(scroll, Color.Bisque, Color.Gray, LinearGradientMode.Horizontal)
Else : colorScroll = New LinearGradientBrush(scroll, Color.White, Color.Gray, LinearGradientMode.Horizontal) : End If ' Draws the top and bottom part of the scrollbar
grfx.DrawRectangle(Pens.Black, topPart) : grfx.FillRectangle(Brushes.LightGray, topPart) : grfx.DrawRectangle(Pens.Black, BottomPart) : grfx.FillRectangle(Brushes.LightGray, BottomPart)
' Draws arrows
Dim points(2) As PointF : points(0) = New PointF(topPart.Left, topPart.Bottom - 1) : points(1) = New PointF(topPart.Right, topPart.Bottom - 1)
points(2) = New PointF((topPart.Left + topPart.Right) / 2, topPart.Top + 1) : grfx.FillPolygon(colorTopPart, points) : points(0) = New PointF(BottomPart.Left, BottomPart.Top + 1)
points(1) = New PointF(BottomPart.Right, BottomPart.Top + 1) : points(2) = New PointF((BottomPart.Left + BottomPart.Right) / 2, BottomPart.Bottom - 1)
grfx.FillPolygon(colorBottomPart, points)
' Draws the scroll area
grfx.DrawRectangle(Pens.Black, scrollBarArea) : grfx.FillRectangle(Brushes.DarkGray, scrollBarArea)
' Draws the actual scrollbar
grfx.DrawRectangle(Pens.Black, scroll) : grfx.FillRectangle(colorScroll, scroll)
End Sub
'''
''' The Y-position of the center of the scroll
'''
'''
'''
'''
Private Property ScrollPositionY() As Integer
Get
If scroll = Nothing Then Return -1 :
Return ((scroll.Height / 2) + scroll.Location.Y) + 19
End Get
Set(ByVal value As Integer)
Dim barCount As Integer = GetIndexChartBar("QQQWWW") : Dim maxHeight As Integer = Me.Height - 30
Dim scrollHeight As Decimal = (maxHeight / barCount) * barsViewable : Dim scrollSpeed As Decimal = (maxHeight - scrollHeight) / (barCount - barsViewable)
Dim index As Integer = 0 : Dim distanceFromLastPosition = 9999 ' Tests to see what scrollposition is the closest to the set position
While index < barCount
Dim newPositionTemp As Integer = (index * scrollSpeed) + (scrollHeight / 2) + (30 / 2) : Dim distanceFromCurrentPosition = newPositionTemp - value
If distanceFromLastPosition < 0 Then
If distanceFromCurrentPosition < distanceFromLastPosition Then : scrollPosition = index - 1 : PaintChart() : Exit Property : End If
Else
If distanceFromCurrentPosition > distanceFromLastPosition Then : scrollPosition = index - 1 ' A precaution to make sure the scroll bar doesn't go too far down
If scrollPosition + barsViewable > GetIndexChartBar("QQQWWW") Then : scrollPosition = GetIndexChartBar("QQQWWW") - barsViewable : End If
PaintChart() : Exit Property
End If
End If : distanceFromLastPosition = distanceFromCurrentPosition : index += 1
End While
End Set
End Property
'''
''' Scrolls one row up
'''
'''
Public Sub ScrollOneup()
If scrollPosition = 0 Then Exit Sub : scrollPosition -= 1 : PaintChart()
End Sub
'''
''' Scrolls one row down
'''
'''
Public Sub ScrollOneDown()
If scrollPosition + barsViewable >= GetIndexChartBar("QQQWWW") Then Exit Sub : scrollPosition += 1 : PaintChart()
End Sub
'''
''' If the user clicks on the scrollbar, scrolling functions will be called
'''
'''
'''
'''
Private Sub GanttChart_Click(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick
If e.Button = Windows.Forms.MouseButtons.Left Then : If mouseOverBottomPart = True Then : ScrollOneDown() : ElseIf mouseOverTopPart = True Then : ScrollOneup() : End If : End If
End Sub
'''
''' When mousewheel is used, the scrollbar will scroll
'''
'''
'''
'''
Private Sub GanttChart_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
If e.Delta > 0 Then : ScrollOneup() : Else : ScrollOneDown() : End If
End Sub
#End Region
#Region "Save"
'''
''' Saves the GanttChart to specified image file
'''
'''
'''
Public Sub SaveImage(ByVal filePath As String)
objGraphics.SmoothingMode = SmoothingMode.HighSpeed : objGraphics.Clear(Me.BackColor) : If headerFromDate = Nothing Or headerToDate = Nothing Then Exit Sub
DrawHeader(objGraphics, Nothing) : DrawNetHorizontal(objGraphics) : DrawNetVertical(objGraphics) : DrawBars(objGraphics, True) : objBmp.Save(filePath)
End Sub
#End Region
Private Enum MouseOverPart
Empty
Bar
BarLeftSide
BarRightSide
End Enum
End Class