Custom Control Display Issue - vb.net

I have created this class in visual Basic it works fine but there is a slight design issue. As you can see there is this small bumb, how can I fix this? And also, how can I fix the spacing between the content Box and the selection menu.
Public Class VerticallTabControll
Inherits TabControl
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint, True)
DoubleBuffered = True
SizeMode = TabSizeMode.Fixed
ItemSize = New Size(30, 170)
End Sub
Protected Overrides Sub CreateHandle()
MyBase.CreateHandle()
Alignment = TabAlignment.Left
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim selected As New SolidBrush(Color.FromArgb(0, 122, 204))
Dim notSelected As New SolidBrush(Color.FromArgb(63, 63, 70))
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
G.Clear(Color.FromArgb(63, 63, 70))
For i = 0 To TabCount - 1
Dim TabRectangle As Rectangle = GetTabRect(i)
If i = SelectedIndex Then
'// if tab is selected
G.FillRectangle(selected, TabRectangle)
Else
'// tab is not selected
G.FillRectangle(notSelected, TabRectangle)
End If
'Line Test
'Dim start As New Point(10, 31 * (i + 1))
'Dim ende As New Point(160, 31 * (i + 1))
'G.DrawLine(Pens.White, start, ende)
G.DrawString(TabPages(i).Text, Font, Brushes.White, TabRectangle, New StringFormat With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Next
e.Graphics.DrawImage(B.Clone, 0, 0)
G.Dispose() : B.Dispose() : selected.Dispose() : notSelected.Dispose()
MyBase.OnPaint(e)
e.Dispose()
End Sub
End Class

You can try overriding the DisplayRectangle property to adjust the interior space accordingly:
Public Overrides ReadOnly Property DisplayRectangle As Rectangle
Get
Return New Rectangle(MyBase.DisplayRectangle.Left,
MyBase.DisplayRectangle.Top - 2,
MyBase.DisplayRectangle.Width + 2,
MyBase.DisplayRectangle.Height + 4)
End Get
End Property

Related

Changing 'lamp' Colour Indicator within the Graphical User Interface (Visual Studio 2019)

I would like to change the colour within a single circular indicator within a Graphical User Interface, so that it shows when an action is completed or when it fails ['two tone green/red LED']. I've looked through the inbuilt presets within the Toolbox but have been unable find anything.
I would therefore be grateful for any assistance.
I've found this code on the msdn.microsoft.com forum, which changes the colour of the centre of the 'dot' when you press the RadioButton.
Private Sub RadioButton_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles RadioButton1.Paint, RadioButton2.Paint
If DirectCast(sender, RadioButton).Checked Then
e.Graphics.FillEllipse(Brushes.Red, New RectangleF(2.5, 4.7, 7.2, 7.2))
End If
So have incorporated it into my code, its not at all elegant and there is clearly room for improvement, but it does work.
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If My.Computer.Network.Ping("192.168.0.1") Then
RadioButton1.ForeColor = Color.Green
RadioButton1.ForeColor = Color.Black
Else
RadioButton1.ForeColor = Color.Red
RadioButton1.ForeColor = Color.Black
End If
End Sub
Private Sub RadioButton_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles RadioButton1.Paint
If My.Computer.Network.Ping("192.168.0.1") Then
e.Graphics.FillEllipse(Brushes.Green, New RectangleF(2.5, 4.7, 7.2, 7.2))
Else
e.Graphics.FillEllipse(Brushes.Red, New RectangleF(2.5, 4.7, 7.2, 7.2))
End If
End Sub
Explanation: when the 'Test Network' button is pressed it sends out a network ping, and depending upon the return the Network RadioButton 'dot' changes colour to either Green or Red,
Here's ON/OFF LED control.
Add a new class to your project, name it say OnOffLed.vb, copy the code below and paste it in the new class.
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Drawing2D
Public Class OnOffLed
Inherits Panel
Public Enum LedState
[On]
Off
End Enum
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or
ControlStyles.OptimizedDoubleBuffer Or
ControlStyles.ResizeRedraw Or
ControlStyles.UserPaint, True)
UpdateStyles()
End Sub
Private _state As LedState = LedState.Off
Public Property State As LedState
Get
Return _state
End Get
Set(value As LedState)
_state = value
Invalidate()
End Set
End Property
Private _onText As String
Public Property OnText As String
Get
Return _onText
End Get
Set(value As String)
_onText = value
Invalidate()
End Set
End Property
Private _offText As String
Public Property OffText As String
Get
Return _offText
End Get
Set(value As String)
_offText = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim rec As New Rectangle(2, 2, Height - 5, Height - 5)
Dim recText As New Rectangle(Height + 2, 1, Width - (Height - 2), Height)
Dim G As Graphics = e.Graphics
G.SmoothingMode = SmoothingMode.AntiAlias
G.Clear(Parent.BackColor)
If _state = LedState.On Then
Dim cb As New ColorBlend With {
.Colors = {Color.Green, Color.DarkGreen, Color.Green},
.Positions = {0, 0.5, 1}
}
Using lgb As New LinearGradientBrush(rec, Color.Empty, Color.Empty, 90.0F) With {.InterpolationColors = cb}
G.FillEllipse(lgb, rec)
End Using
Else
Dim cb As New ColorBlend With {
.Colors = {Color.Red, Color.DarkRed, Color.Red},
.Positions = {0, 0.5, 1}
}
Using lgb As New LinearGradientBrush(rec, Color.Empty, Color.Empty, 90.0F) With {.InterpolationColors = cb}
G.FillEllipse(lgb, rec)
End Using
End If
G.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
Using br As New SolidBrush(ForeColor)
Using sf As New StringFormat With {.Alignment = StringAlignment.Near, .LineAlignment = StringAlignment.Center}
G.DrawString(If(_state = LedState.On, _onText, _offText), Font, br, recText, sf)
End Using
End Using
End Sub
End Class
Rebuild your project.
In the ToolBox under your project's component tab, you'll find the new control. OnOffLed. Drop it in your form as you drop any other control.
You can toggle the state through the State property, set different text if you need that for each state through the OnText and OffText properties.
Usage Example:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If My.Computer.Network.Ping("192.168.2.01") Then
OnOffLed1.State = OnOffLed.LedState.On
Else
OnOffLed1.State = OnOffLed.LedState.Off
End If
End Sub
Good luck.

Grid I can paint on

So I am trying to create an application to ease creation of pixel arts (school project), what I've done so far is draw a grid in a panel, next step would be to allow the user to click on a cell and have it painted, but I can't manage to make it work, here's the code I have:
Private Sub drawGrid(g As Graphics, rows As Integer, columns As Integer)
Dim originPoint As Point = New Point(10, 2)
Dim size As Size = New Size(64, 64)
Dim left As Integer = originPoint.X
Dim up As Integer = originPoint.Y
Dim right As Integer = originPoint.X + (columns * size.Width)
Dim down As Integer = originPoint.Y + (rows * size.Height)
For y As Integer = up To down + 1 Step size.Height
Dim pt1 As New Point(left, y)
Dim pt2 As New Point(right, y)
g.DrawLine(Pens.Black, pt1, pt2)
Next
For x As Integer = left To right + 1 Step size.Width
Dim pt1 As New Point(x, up)
Dim pt2 As New Point(x, down)
g.DrawLine(Pens.Black, pt1, pt2)
Next
End Sub
This draws a grid with the amount of columns and rows the user wants, but I've been struggling to allow painting
What I've been thinking is: dispose this code, and create a 'pixel' class, create the amount of 'pixel' objects based on user rows and columns, and draw each one individually, then just change each 'pixel's' color
This is a Grid class that allows setting the color of its cells.
The Grid cell are referenced using a List(Of List(Of Class)).
The Cell class Object contains is a simple Rectagle property that measures the size of the cell, and a Color property, which allows to set the color of the single cell:
Friend Class GridCell
Public Property Cell() As Rectangle
Public Property CellColor() As Color
End Class
You can define:
The size of the Grid → ColoredGrid.GridSize = new Size(...)
The number of Columns and Rows → ColoredGrid.GridColumnsRows = new Size(...)
The position of the Grid inside the Canvas → ColoredGrid.GridPosition = New Point(...)
The color of the Grid → ColoredGrid.GridColor = Color.Gray
The BackGround color of the cells → ColoredGrid.CellColor = Color.FromArgb(32, 32, 32)
The color of a selected cell → ColoredGrid.SelectedCellColor = Color.OrangeRed
The Grid class holds a reference to the control which will be used as the Canvas for the grid painting. This reference is set in the class contructor.
The Grid registers the Canvas control Paint() and MouseClick() events to respond to the related actions automatically.
When a Mouse Click is detected on the Canvas surface, the MouseEventArgs e.Location property reports the coordinates where the Click occurred.
To identify the Grid Cell where this action is performed, the GetUpdateCell() method inspects the List(Of List(Of GridCell)) using a simple LINQ SelectMany() and identified the Cell rectangle that contains the Mouse Click coordinates (expressed as a Point() value).
This identification is performed simply checking whether the Cell Rectangle.Contains(Point()).
When the cell is identified, the Canvas Invalidate() method is called, specifing the area to repaint.
This area corresponds to the Cell Rectangle, so only this section is repainted when a Cell is colored, to save resources and time.
To test it, create a Panel and a Button in a Form:
Imports System.Drawing
'This Grid object in defined at Form Class scope
Public ColoredGrid As ColorGrid
'Button used to trigger the Grid painting
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If ColoredGrid IsNot Nothing Then
ColoredGrid.Dispose()
End If
ColoredGrid = New ColorGrid(Panel1)
ColoredGrid.GridSize = New Size(300, 300)
ColoredGrid.GridColumnsRows = New Size(10, 10)
ColoredGrid.GridPosition = New Point(10, 10)
ColoredGrid.GridColor = Color.White
ColoredGrid.CellColor = Color.FromArgb(32, 32, 32)
ColoredGrid.SelectedCellColor = Color.OrangeRed
ColoredGrid.BuildGrid()
End Sub
This is a visual sample that shows how it works:
This is the main Grid class.
The ColorGrid Class supports IDisposable, because it registers the described events. These must be unregistered when the Class is not used anymore. Weird things can happen if you don't.
Public Class ColorGrid
Implements IDisposable
Private Grid As List(Of List(Of GridCell))
Private CurrentGridSize As New Size(100, 100)
Private GridColRows As New Size(10, 10)
Private CellSize As New Size(10, 10)
Private MouseCell As Point = Point.Empty
Private Canvas As Control = Nothing
Private UpdateCell As Boolean = False
Private NewGrid As Boolean = False
Public Sub New(DrawingControl As Control)
If DrawingControl IsNot Nothing Then
Me.Canvas = DrawingControl
AddHandler Me.Canvas.Paint, New PaintEventHandler(AddressOf Me.ControlPaint)
AddHandler Me.Canvas.MouseClick, New MouseEventHandler(AddressOf Me.MouseHandler)
Me.GridPosition = New Point(10, 10)
Me.CellColor = Color.FromArgb(32, 32, 32)
End If
End Sub
Public Property GridPosition() As Point
Public Property CellColor() As Color
Public Property SelectedCellColor() As Color
Public Property GridColor() As Color
Public Property GridSize() As Size
Get
Return Me.CurrentGridSize
End Get
Set(value As Size)
Me.CurrentGridSize = value
SetCellSize()
End Set
End Property
Public Property GridColumnsRows() As Size
Get
Return Me.GridColRows
End Get
Set(value As Size)
Me.GridColRows = value
SetCellSize()
End Set
End Property
Private Property RefreshCell() As GridCell
Friend Class GridCell
Public Property Cell() As Rectangle
Public Property CellColor() As Color
End Class
Private Sub SetCellSize()
Me.CellSize = New Size((Me.CurrentGridSize.Width \ Me.GridColRows.Width),
(Me.CurrentGridSize.Height \ Me.GridColRows.Height))
If Me.CellSize.Width < 4 Then Me.CellSize.Width = 4
If Me.CellSize.Height < 4 Then Me.CellSize.Height = 4
End Sub
Public Sub BuildGrid()
If Me.Canvas Is Nothing Then Return
Me.Grid = New List(Of List(Of GridCell))()
For row As Integer = 0 To GridColumnsRows.Height - 1
Dim RowCells As New List(Of GridCell)()
For col As Integer = 0 To GridColumnsRows.Width - 1
RowCells.Add(New GridCell() With {
.Cell = New Rectangle(New Point(Me.GridPosition.X + (col * Me.CellSize.Width),
Me.GridPosition.Y + (row * Me.CellSize.Height)),
Me.CellSize),
.CellColor = Me.CellColor})
Next
Me.Grid.Add(RowCells)
Next
Me.NewGrid = True
Me.Canvas.Invalidate()
End Sub
Private Sub ControlPaint(o As Object, e As PaintEventArgs)
If Me.NewGrid Then
e.Graphics.Clear(Me.Canvas.BackColor)
Me.NewGrid = False
End If
Me.Grid.
SelectMany(Function(rowcells) rowcells).
Select(Function(colcell)
If Me.UpdateCell Then
Using brush As New SolidBrush(Me.RefreshCell.CellColor)
e.Graphics.FillRectangle(brush, Me.RefreshCell.Cell.X + 1, Me.RefreshCell.Cell.Y + 1,
Me.RefreshCell.Cell.Width - 1, Me.RefreshCell.Cell.Height - 1)
End Using
Me.UpdateCell = False
Return Nothing
Else
Using pen As New Pen(Me.GridColor)
e.Graphics.DrawRectangle(pen, colcell.Cell)
End Using
Using brush As New SolidBrush(colcell.CellColor)
e.Graphics.FillRectangle(brush, colcell.Cell.X + 1, colcell.Cell.Y + 1,
colcell.Cell.Width - 1, colcell.Cell.Height - 1)
End Using
End If
Return colcell
End Function).TakeWhile(Function(colcell) colcell IsNot Nothing).ToList()
End Sub
Private Sub MouseHandler(o As Object, e As MouseEventArgs)
Me.RefreshCell = GetUpdateCell(e.Location)
Me.RefreshCell.CellColor = Me.SelectedCellColor
Dim CellColorArea As Rectangle = Me.RefreshCell.Cell
CellColorArea.Inflate(-1, -1)
Me.UpdateCell = True
Me.Canvas.Invalidate(CellColorArea)
End Sub
Private Function GetUpdateCell(CellPosition As Point) As GridCell
Return Me.Grid.
SelectMany(Function(rowcells) rowcells).
Select(Function(gridcell) gridcell).
Where(Function(gridcell) gridcell.Cell.Contains(CellPosition)).
First()
End Function
Public Sub Dispose() Implements IDisposable.Dispose
If Me.Canvas IsNot Nothing Then
RemoveHandler Me.Canvas.Paint, AddressOf Me.ControlPaint
RemoveHandler Me.Canvas.MouseClick, AddressOf Me.MouseHandler
Me.Grid = Nothing
End If
End Sub
End Class

Groupbox - change border colour - RowPosition error

I have this code to change border colour of Groupboxes. It adds custom groupbox to my Toolbox and I can change border colour, but every time I start debugging I get this error: InvalidArgument=Value of "-2147483648" is not valid for 'RowPosition'.. As I read online, this error is produced when there is some bad code in project. Anybody knows how I should deal with this ?
Public Class GroupBox_Color
Inherits GroupBox
Private _borderColor As Color
Public Sub New()
MyBase.New()
Me._borderColor = Color.Blue
End Sub
Public Property BorderColor() As Color
Get
Return Me._borderColor
End Get
Set(ByVal value As Color)
Me._borderColor = value
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim tSize As Size = TextRenderer.MeasureText(Me.Text, Me.Font)
Dim borderRect As Rectangle = Me.DisplayRectangle
borderRect.Y = (borderRect.Y + (tSize.Height / 2))
borderRect.Height = (borderRect.Height - (tSize.Height / 2))
ControlPaint.DrawBorder(e.Graphics, borderRect, Me._borderColor,
ButtonBorderStyle.Solid)
Dim textRect As Rectangle = Me.DisplayRectangle
textRect.X = (textRect.X + 6)
textRect.Width = tSize.Width
textRect.Height = tSize.Height
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), textRect)
e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), textRect)
End Sub
End Class

Error When trying to inherit TabControl

Hello guys i got the following error when trying to inherit tabcontrol: Base class 'System.Windows.Forms.TabControl' Specified for class 'Form1' cannot be different from the base class 'System.Windows.Forms.Form' of one of its other partial types!
Here is a picture: http://prntscr.com/3dqzd6
What im trying to make is a animated tab control. i Found a code but it was only for visual basic(I code in c# but this code was for vb only)
My code:
Public Class Form1
Inherits TabControl//Here i got the error
Dim OldIndex As Integer
Private _Speed As Integer = 9
Property Speed As Integer
Get
Return _Speed
End Get
Set(ByVal value As Integer)
If value > 20 Or value < -20 Then
MsgBox("Speed needs to be in between -20 and 20.")
Else
_Speed = value
End If
End Set
End Property
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw, True)
End Sub
Sub DoAnimationScrollLeft(ByVal Control1 As Control, ByVal Control2 As Control)
Dim G As Graphics = Control1.CreateGraphics()
Dim P1 As New Bitmap(Control1.Width, Control1.Height)
Dim P2 As New Bitmap(Control2.Width, Control2.Height)
Control1.DrawToBitmap(P1, New Rectangle(0, 0, Control1.Width, Control1.Height))
Control2.DrawToBitmap(P2, New Rectangle(0, 0, Control2.Width, Control2.Height))
For Each c As Control In Control1.Controls
c.Hide()
Next
Dim Slide As Integer = Control1.Width - (Control1.Width Mod _Speed)
Dim a As Integer
For a = 0 To Slide Step _Speed
G.DrawImage(P1, New Rectangle(a, 0, Control1.Width, Control1.Height))
G.DrawImage(P2, New Rectangle(a - Control2.Width, 0, Control2.Width, Control2.Height))
Next
a = Control1.Width
G.DrawImage(P1, New Rectangle(a, 0, Control1.Width, Control1.Height))
G.DrawImage(P2, New Rectangle(a - Control2.Width, 0, Control2.Width, Control2.Height))
SelectedTab = Control2
For Each c As Control In Control2.Controls
c.Show()
Next
For Each c As Control In Control1.Controls
c.Show()
Next
End Sub
Protected Overrides Sub OnSelecting(ByVal e As System.Windows.Forms.TabControlCancelEventArgs)
If OldIndex < e.TabPageIndex Then
DoAnimationScrollRight(TabPages(OldIndex), TabPages(e.TabPageIndex))
Else
DoAnimationScrollLeft(TabPages(OldIndex), TabPages(e.TabPageIndex))
End If
End Sub
Protected Overrides Sub OnDeselecting(ByVal e As System.Windows.Forms.TabControlCancelEventArgs)
OldIndex = e.TabPageIndex
End Sub
Sub DoAnimationScrollRight(ByVal Control1 As Control, ByVal Control2 As Control)
Dim G As Graphics = Control1.CreateGraphics()
Dim P1 As New Bitmap(Control1.Width, Control1.Height)
Dim P2 As New Bitmap(Control2.Width, Control2.Height)
Control1.DrawToBitmap(P1, New Rectangle(0, 0, Control1.Width, Control1.Height))
Control2.DrawToBitmap(P2, New Rectangle(0, 0, Control2.Width, Control2.Height))
For Each c As Control In Control1.Controls
c.Hide()
Next
Dim Slide As Integer = Control1.Width - (Control1.Width Mod _Speed)
Dim a As Integer
For a = 0 To -Slide Step -_Speed
G.DrawImage(P1, New Rectangle(a, 0, Control1.Width, Control1.Height))
G.DrawImage(P2, New Rectangle(a + Control2.Width, 0, Control2.Width, Control2.Height))
Next
a = Control1.Width
G.DrawImage(P1, New Rectangle(a, 0, Control1.Width, Control1.Height))
G.DrawImage(P2, New Rectangle(a + Control2.Width, 0, Control2.Width, Control2.Height))
SelectedTab = Control2
For Each c As Control In Control2.Controls
c.Show()
Next
For Each c As Control In Control1.Controls
c.Show()
Next
End Sub
Please help me!
-Christos
When you create a form the designer makes one named Form1 it has a Partial Class by the same name - this is where the generated code is maintained and should not be touched by you. This Form1 Inherits from System.Windows.Forms.Form and hence cannot be made to inherit from a TabControl. If you simply change the name of the class you have above that intends to be a Sub-Classed version of the TabControl then all would be well.
Public Class Form1
...
End Class
Partial Class Form1
'same class as above just allowed to be seperate
'they share the internal code
End Class
Your code should start like:
Public Class myTabControl : Inherits TabControl
'continue with sub classing

How to create a seek slider in vb.net

I found many tutorials on youtube which tell us, how to use AxWindowsMediaPlayer and basic stuff like creating your own volume control using TrackBar1 for Windows Media Player Component. But now I want to ask that how we can create our own movie duration control using trackbar or a seek slider in vb.net for Windows Media Player. I have searched a lot but question still remains a question. I hope that many great developers of vb.net on this site, should tell me logic behind it
THANKS IN ADVANCE
The trick is to subclass the TrackBar control and handle the OnPaintBackground and OnPaint events.
Here's an "extra-lite" version of a control I use on some of my own projects.
This version is quite limited but it should help you get started...
Imports System.Drawing.Drawing2D
Public Class CoolTrackBar
Inherits TrackBar
Private thumbRect As Rectangle = New Rectangle(0, 0, 19, 19)
Private isOverThumb As Boolean
Private cachedValue As Integer
Private rangeRect As Rectangle = Rectangle.Empty
Private mGrooveSize As Integer = 6
Private mGrooveBorderColor As Color = Color.Gray
Private mGrooveColor As Color = Color.LightGray
Private mSelStartColor As Color = Color.Blue
Private mSelEndColor As Color = Color.Red
Public Sub New()
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
Me.SetStyle(ControlStyles.ResizeRedraw, True)
Me.SetStyle(ControlStyles.UserPaint, True)
Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
End Sub
Public Property GrooveSize As Integer
Get
Return mGrooveSize
End Get
Set(value As Integer)
mGrooveSize = value
Me.Invalidate()
End Set
End Property
Public Property GrooveColor As Color
Get
Return mGrooveColor
End Get
Set(value As Color)
mGrooveColor = value
Me.Invalidate()
End Set
End Property
Public Property GrooveBorderColor As Color
Get
Return mGrooveBorderColor
End Get
Set(value As Color)
mGrooveBorderColor = value
Me.Invalidate()
End Set
End Property
Public Overloads Property TickStyle As TickStyle
Get
Return Windows.Forms.TickStyle.Both
End Get
Set(value As TickStyle)
MyBase.TickStyle = Windows.Forms.TickStyle.Both
End Set
End Property
Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
Dim g As Graphics = pevent.Graphics
Dim r As Rectangle = Me.DisplayRectangle
Select Case MyBase.Orientation
Case Orientation.Horizontal
rangeRect = New Rectangle(r.X + 14, r.Top, r.Width - 30, r.Height)
Case Orientation.Vertical
rangeRect = New Rectangle(r.X + 5, r.Y + 14, r.Width, r.Height - 29)
End Select
MyBase.OnPaintBackground(pevent)
DrawGroove(g)
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim g As Graphics = e.Graphics
DrawThumb(g)
End Sub
Private Sub DrawGroove(g As Graphics)
Dim r1 As Rectangle
Dim r2 As Rectangle
Select Case Orientation
Case Windows.Forms.Orientation.Horizontal
r1 = New Rectangle(rangeRect.X, rangeRect.Y + (rangeRect.Height - mGrooveSize) \ 2, rangeRect.Width, mGrooveSize)
r2 = New Rectangle(r1.X, r1.Y, r1.Width * ValueToPercentage(cachedValue), r1.Height)
Case Windows.Forms.Orientation.Vertical
r1 = New Rectangle(rangeRect.X + (rangeRect.Width - mGrooveSize) / 2 - mGrooveSize \ 2, rangeRect.Y, mGrooveSize, rangeRect.Height)
r2 = New Rectangle(r1.X, r1.Y, r1.Width, r1.Height * ValueToPercentage(cachedValue))
End Select
Using b As New SolidBrush(mGrooveColor)
g.FillRectangle(b, r1)
End Using
Using p As New Pen(mGrooveBorderColor)
g.DrawRectangle(p, r1)
End Using
Using lgb As New LinearGradientBrush(r1.Location, New Point(r1.Right, r1.Bottom), mSelStartColor, mSelEndColor)
g.FillRectangle(lgb, r2)
End Using
End Sub
Private Sub DrawThumb(g As Graphics)
Dim thumb As VisualStyles.VisualStyleElement = Nothing
Select Case MyBase.Orientation
Case Orientation.Horizontal
If MyBase.Enabled Then
If isOverThumb Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Hot
Else
If MyBase.Focused Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Focused
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Normal
End If
End If
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Disabled
End If
Case Orientation.Vertical
If MyBase.Enabled Then
If isOverThumb Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Hot
Else
If MyBase.Focused Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Focused
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Normal
End If
End If
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Disabled
End If
End Select
Dim valuePercentage As Single = ValueToPercentage(cachedValue)
Dim vsr = New VisualStyles.VisualStyleRenderer(thumb)
thumbRect.Size = vsr.GetPartSize(g, VisualStyles.ThemeSizeType.Draw)
Dim pos As Integer
Select Case MyBase.Orientation
Case Orientation.Horizontal
pos = valuePercentage * rangeRect.Width
thumbRect.Location = New Point(pos + thumbRect.Width / 2 + 3, rangeRect.Y + thumbRect.Height / 2 + mGrooveSize / 4)
Case Orientation.Vertical
pos = valuePercentage * rangeRect.Height
thumbRect.Location = New Point(rangeRect.X + thumbRect.Width / 2 + mGrooveSize / 4, pos + thumbRect.Height / 2 + 3)
End Select
vsr.DrawBackground(g, thumbRect)
End Sub
Private Function ValueToPercentage(value As Integer) As Single
Dim w As Integer = MyBase.Maximum - MyBase.Minimum
Dim min = MyBase.Minimum
Dim max = MyBase.Maximum
If MyBase.Orientation = Orientation.Horizontal Then
Return (value - min) / (max - min)
Else
Return 1 - (value - min) / (max - min)
End If
End Function
Private Sub CoolTrackBar_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If thumbRect.IntersectsWith(New Rectangle(e.Location, New Size(1, 1))) Then
isOverThumb = True
Me.Invalidate()
ElseIf isOverThumb Then
isOverThumb = False
Me.Invalidate()
End If
End Sub
Private Sub CoolTrackBar_ValueChanged(sender As Object, e As EventArgs) Handles Me.ValueChanged
cachedValue = MyBase.Value
Me.Invalidate()
End Sub
End Class
To use it, simply create a WinForms project, then create a new Class, name it CoolTrackBar and paste the code above.
You'll need to compile the solution for the control to appear on your Toolbox.