im doing wrong here... anyways, I am making a custom slider control that
takes dates as its values instead of integers... then taking that date range
and finding dates specifiec between them (in a list of dates) and putting
snap marks, so if you slide it near one of them it should snap to that tick,
but that part i cant figure out. the rest seems ok so far... here is my
control's code and the code I have running on the test form. Could someone
please help me out here! thanks!
=============================
Public Class Form1
'Form overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
MyBase.Dispose(disposing)
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Me.CtrlSliderForDateLists1 = New WindowsApplication1.ctrlSliderForDateLists
Me.DateTimePicker1 = New System.Windows.Forms.DateTimePicker
Me.SuspendLayout()
'
'CtrlSliderForDateLists1
'
Me.CtrlSliderForDateLists1.Anchor =
CType((((System.Windows.Forms.AnchorStyles.Top Or
System.Windows.Forms.AnchorStyles.Bottom) _
Or System.Windows.Forms.AnchorStyles.Left) _
Or System.Windows.Forms.AnchorStyles.Right),
System.Windows.Forms.AnchorStyles)
Me.CtrlSliderForDateLists1.BackColor = System.Drawing.SystemColors.Window
Me.CtrlSliderForDateLists1.Location = New System.Drawing.Point(12, 12)
Me.CtrlSliderForDateLists1.Name = "CtrlSliderForDateLists1"
Me.CtrlSliderForDateLists1.Size = New System.Drawing.Size(40, 212)
Me.CtrlSliderForDateLists1.TabIndex = 0
Me.CtrlSliderForDateLists1.Value = New Date(CType(0, Long))
'
'DateTimePicker1
'
Me.DateTimePicker1.Location = New System.Drawing.Point(81, 26)
Me.DateTimePicker1.Name = "DateTimePicker1"
Me.DateTimePicker1.Size = New System.Drawing.Size(200, 20)
Me.DateTimePicker1.TabIndex = 1
'
'Form1
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(292, 273)
Me.Controls.Add(Me.DateTimePicker1)
Me.Controls.Add(Me.CtrlSliderForDateLists1)
Me.Name = "Form1"
Me.Text = "Form1"
Me.ResumeLayout(False)
End Sub
Friend WithEvents CtrlSliderForDateLists1 As
WindowsApplication1.ctrlSliderForDateLists
Friend WithEvents DateTimePicker1 As System.Windows.Forms.DateTimePicker
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Load
Me.CtrlSliderForDateLists1.AddTickDate(#1/1/2006#, Color.Green)
Me.CtrlSliderForDateLists1.AddTickDate(#1/13/2006#, Color.Green)
Me.CtrlSliderForDateLists1.AddTickDate(#2/1/2006#, Color.Red)
Me.CtrlSliderForDateLists1.AddTickDate(#7/1/2006#, Color.Blue)
Me.CtrlSliderForDateLists1.AddTickDate(#10/23/2006#, Color.Blue)
'Debug.WriteLine("Start Date: " & Me.CtrlSliderForDateLists1.StartDate.Date)
'Debug.WriteLine("End Date: " & Me.CtrlSliderForDateLists1.EndDate.Date)
End Sub
Private Sub CtrlSliderForDateLists1_ValueChanged(ByVal [date] As Date)
Handles CtrlSliderForDateLists1.ValueChanged
Me.Text = [date].ToString
End Sub
Private Sub DateTimePicker1_ValueChanged(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles DateTimePicker1.ValueChanged
Me.CtrlSliderForDateLists1.Value = Me.DateTimePicker1.Value.Date
End Sub
End Class
==============================
''' <summary>
''' Stop ticked slider for graphs and date ranges
'''
''' This control takes in dates, it will display those
''' dates on a slider like control, which the user
''' can use to slide between the minimum and maximum date
''' there will be tick marks to represent dates entered
''' on the slider background. When a user slides
''' the thumb near a tick it will snap to the tick line
''' when it is within i_pixelsnapregion number of pixels
''' after dragging past that region it will continue to slide
''' normally. When snapped, the date returned will be that
''' of the snapped date. Dates between snap locations are not
''' as important as the snapped tick marks dates are. So
''' these should always return a correct date when snapped to.
''' </summary>
''' <remarks></remarks>
Public Class ctrlSliderForDateLists
Private al_DateList As New ArrayList
Private d_StartDate As DateTime
Private d_EndDate As DateTime
Private d_Value As DateTime
Private t_Thumb As New SliderTumb()
Private tp_Position As TickPosition = TickPosition.Right
Private b_MouseDown As Boolean = False
Private i_lastCurPosY As Integer = 0
Private i_lastPos As New Point(0, 0)
Private i_curPos As New Point(0, 0)
Private b_OnThumb As Boolean = False
Public Event ValueChanged(ByVal [date] As DateTime)
Private r_DragRegion As New Rectangle(0, 0, 0, 0)
Private i_PixelSnapRegion As Integer = 3
''' <summary>
''' Represents the dates as ticks on display list
''' </summary>
''' <remarks></remarks>
Private Structure DateTicks
Public [Date] As DateTime
Public PixelHeight As Integer
Public Color As Color
End Structure
''' <summary>
''' Position to draw ticks
''' </summary>
''' <remarks></remarks>
Public Enum TickPosition
Left
Right
End Enum
''' <summary>
''' Adds a date to the list
''' </summary>
''' <param name="Date">Date to tick</param>
''' <param name="TickDisplayColor">Color to show tick in</param>
''' <remarks></remarks>
Public Sub AddTickDate(ByVal [Date] As DateTime, ByVal TickDisplayColor As
Color)
Dim tick As New DateTicks
With tick
..Date = [Date]
..Color = TickDisplayColor
End With
al_DateList.Add(tick)
ReprocessDates()
End Sub
''' <summary>
''' Removes the first instance of a date from the dates list
''' </summary>
''' <param name="date"></param>
''' <remarks></remarks>
Public Sub RemoveTickDate(ByVal [date] As DateTime)
For Each t As DateTicks In al_DateList
If t.Date = [date] Then
al_DateList.Remove(t)
ReprocessDates()
Exit Sub
End If
Next
End Sub
''' <summary>
''' Retruns a list of dates that are ticked
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public ReadOnly Property DateTickList() As ArrayList
Get
Dim al_List As New ArrayList
For Each t As DateTicks In al_DateList
al_List.Add(t.Date)
Next
Return al_List
End Get
End Property
''' <summary>
''' Comparision for sorting date tick lists
''' </summary>
''' <remarks></remarks>
Private Class TickCompare
Implements IComparer
Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer
Implements System.Collections.IComparer.Compare
Dim xItem As DateTicks
Dim yItem As DateTicks
xItem = CType(x, DateTicks)
yItem = CType(y, DateTicks)
Return xItem.Date.CompareTo(yItem.Date)
End Function
End Class
Private Sub ReprocessDates()
Dim comparer As New TickCompare
al_DateList.Sort(comparer)
' figure out min and max dates should be in order now that they where sorted
If al_DateList.Count > 0 Then
d_StartDate = CDate(DirectCast(al_DateList(0), DateTicks).Date)
d_EndDate = CDate(DirectCast(al_DateList(al_DateList.Count - 1),
DateTicks).Date)
End If
End Sub
''' <summary>
''' Gets the minimum date (Start date) for the range
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public ReadOnly Property StartDate() As DateTime
Get
Return d_StartDate
End Get
End Property
''' <summary>
''' Gets or Sets the maximum date (End Date) for the range
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public ReadOnly Property EndDate() As DateTime
Get
Return d_EndDate
End Get
End Property
''' <summary>
''' Gets or sets the current value of the control
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Value() As DateTime
Get
Return d_Value
End Get
Set(ByVal value As DateTime)
d_Value = Value
Me.Invalidate()
End Set
End Property
Private Function CalculateScaleInPixelsPerDay() As Double
Dim i_Scale As Double = 0
i_Scale = d_EndDate.Subtract(d_StartDate).Days / (Me.Height -
t_Thumb.ThumbHeight)
'Debug.WriteLine("Days in range: " & d_EndDate.Subtract(d_StartDate).Days)
'Debug.WriteLine("Pixels High: " & Me.Height)
'Debug.WriteLine("Slider Scale: " & i_Scale & " days per pixel")
Return i_Scale
End Function
Private Sub ctrlSliderForDateLists_MouseDown(ByVal sender As Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
If b_OnThumb = True Then
b_MouseDown = True
Else
' wasnt on thumb, so jump to position
t_Thumb.Height = CInt(e.Y - (t_Thumb.ThumbHeight / 2))
d_Value = d_StartDate.AddDays(t_Thumb.Height *
CalculateScaleInPixelsPerDay()).Date
RaiseEvent ValueChanged(d_Value)
Me.Invalidate()
End If
End Sub
Private Sub ctrlSliderForDateLists_MouseMove(ByVal sender As Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If r_DragRegion.Contains(e.Location) Then
i_lastPos = i_curPos
i_curPos = New Point(e.X, e.Y)
If Not b_MouseDown Then
' not dragging so check to see if over thumb
If t_Thumb.Hittest(i_curPos) Then
b_OnThumb = True
Else
b_OnThumb = False
End If
Else
Dim ii_lastPos As Integer = t_Thumb.Height
' on thumb and dragging move thumb
t_Thumb.Height = t_Thumb.Height + (i_curPos.Y - i_LastPos.Y)
' snap to date if date marked within 3 pixels either direction
Dim d_temp As DateTime = d_StartDate.AddDays(t_Thumb.Height *
CalculateScaleInPixelsPerDay()).Date
'For Each d As DateTime In Me.al_DateList
' ' look for dates within 2 days of this date
' If d.Date <= d_temp.Date.AddDays(1) And d.Date >= d_temp.Date.AddDays(-1)
Then
' t_Thumb.Height = CInt(CInt(d.Date.Subtract(d_StartDate.Date).Days *
CalculateScaleInPixelsPerDay()) + (t_Thumb.ThumbHeight / 2))
' d_Value = d
' Else
For Each d As DateTicks In al_DateList
Debug.WriteLine(d.PixelHeight)
' look for date ticks within i_PixelSnapRegion pixels of hte slider location
If d.PixelHeight <= (t_Thumb.Height + i_PixelSnapRegion) And d.PixelHeight
= (t_Thumb.Height - i_PixelSnapRegion) Then
t_Thumb.Height = d.PixelHeight
Me.Invalidate()
Debug.WriteLine("snapped to: " & d.Date.Date & "Pixel height: " &
d.PixelHeight & "Thumb Height: " & t_Thumb.Height)
Exit For
End If
Next
d_Value = d_StartDate.AddDays(t_Thumb.Height *
CalculateScaleInPixelsPerDay()).Date
'End If
'Next
' if went out of range then move to last position
If Not ((t_Thumb.Height + t_Thumb.ThumbHeight) <= Me.Height And
t_Thumb.Height >= 0) Then
t_Thumb.Height = ii_lastPos
End If
RaiseEvent ValueChanged(d_Value)
Me.Invalidate()
End If
End If
End Sub
Private Sub ctrlSliderForDateLists_MouseUp(ByVal sender As Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
b_MouseDown = False
End Sub
Private Sub ctrlSliderForDateLists_Paint(ByVal sender As Object, ByVal e As
System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim i_Scale As Double = CalculateScaleInPixelsPerDay()
' draw tick marks
For Each d As DateTicks In al_DateList
Try
' figure out height from bottom, max date is on top min on bottom
' Debug.WriteLine(d.Date)
Dim i_Height As Integer = CInt(CInt(d.Date.Subtract(d_StartDate).Days /
i_Scale) + (t_Thumb.ThumbHeight / 2))
d.PixelHeight = i_Height
al_DateList(al_DateList.IndexOf(d)) = d
Dim P As Pen
If CInt(t_Thumb.Height + t_Thumb.ThumbHeight / 2) = d.PixelHeight Then
P = New Pen(d.Color, 2)
Else
P = New Pen(d.Color, 1)
End If
e.Graphics.DrawLine(P, Me.Width - 5, i_Height, Me.Width, i_Height)
ControlPaint.DrawButton(e.Graphics, New Rectangle(CInt((Me.Width - 3) / 2),
CInt((t_Thumb.ThumbHeight / 2)), 3, CInt(Me.Height -
(t_Thumb.ThumbHeight))), ButtonState.Pushed)
r_DragRegion = New Rectangle(0, CInt((t_Thumb.ThumbHeight / 2)), Me.Width,
CInt(Me.Height - (t_Thumb.ThumbHeight)))
Catch ex As Exception
Debug.Write(ex)
End Try
Next
If Not d_Value >= d_StartDate Then
d_Value = d_StartDate
End If
If Not d_Value <= d_EndDate Then
d_Value = d_EndDate
End If
t_Thumb.DrawThumb(e.Graphics)
End Sub
''' <summary>
''' Thumb class for moving
''' </summary>
''' <remarks></remarks>
Private Class SliderTumb
Private i_Height As Integer
Private r_Container As Rectangle
Private i_ThumbHeight As Integer = 10
Public ReadOnly Property ThumbHeight() As Integer
Get
Return i_ThumbHeight
End Get
End Property
Public Property Height() As Integer
Get
Return i_Height
End Get
Set(ByVal value As Integer)
i_Height = Value
End Set
End Property
Public Property Y() As Integer
Get
Return i_Height
End Get
Set(ByVal value As Integer)
i_Height = Value
End Set
End Property
Public Sub DrawThumb(ByRef g As Graphics)
g.SmoothingMode = Drawing2D.SmoothingMode.None
r_Container = New Rectangle(CInt((g.ClipBounds.Width - 22) / 2), i_Height,
20, i_ThumbHeight)
' make a triangle pointer
Dim triPoint(2) As PointF
triPoint(0) = New PointF(r_Container.Right - 2, r_Container.Top)
triPoint(1) = New PointF(r_Container.Right - 2, r_Container.Bottom)
triPoint(2) = New PointF(r_Container.Right + 4, r_Container.Top +
CInt((r_Container.Height / 2)))
ControlPaint.DrawButton(g, r_Container, ButtonState.Normal)
g.FillPolygon(Drawing.SystemBrushes.Control, triPoint)
g.DrawLine(Drawing.SystemPens.ControlLightLight, New
PointF(r_Container.Right - 1, r_Container.Top), New PointF(r_Container.Right
+ 4, r_Container.Top + CInt((r_Container.Height / 2))))
g.DrawLine(Drawing.SystemPens.ControlDarkDark, New
PointF(r_Container.Right - 1, r_Container.Bottom - 1), New
PointF(r_Container.Right + 3, r_Container.Top + CInt((r_Container.Height /
2))))
g.DrawLine(Drawing.SystemPens.ControlDark, New PointF(r_Container.Right - 1,
r_Container.Bottom - 2), New PointF(r_Container.Right + 2, r_Container.Top +
CInt((r_Container.Height / 2))))
End Sub
Public Function Hittest(ByVal p As Point) As Boolean
If r_Container.Contains(p) Then
Return True
Else
Return False
End If
End Function
End Class
Public Sub New()
' This call is required by the Windows Form Designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
Me.DoubleBuffered = True
Me.SetStyle(ControlStyles.ResizeRedraw, True)
Me.SetStyle(ControlStyles.Selectable, True)
Me.UpdateStyles()
End Sub
End Class
