[VB.NET]Crée un thème

[Membre supprimé 245833]

Bonjour tout le monde, today je vais vous apprendre à faire un thème en VB.NET ! Comme il n'y a pas de tuto la dessus sur CG3 j'ai décidé d'en faire un ! Allez bon tuto.

I.Matériel​

Alors il vous faut:
Theme Base 1.5.4 de An*onH*ck.

Code

Imports System, System.IO, System.Collections.Generic
Imports System.Drawing, System.Drawing.Drawing2D
Imports System.ComponentModel, System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

'------------------
'Creator: aeonhack
'Site: elitevs.net
'Created: 08/02/2011
'Changed: 12/06/2011
'Version: 1.5.4
'------------------

MustInherit Class ThemeContainer154
Inherits ContainerControl

#Region " Initialization "

Protected G As Graphics, B As Bitmap

Sub New()
SetStyle(DirectCast(139270, ControlStyles), True)

_ImageSize = Size.Empty
Font = New Font("Verdana", 8S)

MeasureBitmap = New Bitmap(1, 1)
MeasureGraphics = Graphics.FromImage(MeasureBitmap)

DrawRadialPath = New GraphicsPath

InvalidateCustimization()
End Sub

Protected NotOverridable Overrides Sub OnHandleCreated(ByVal e As EventArgs)
If DoneCreation Then InitializeMessages()

InvalidateCustimization()
ColorHook()

If Not _LockWidth = 0 Then Width = _LockWidth
If Not _LockHeight = 0 Then Height = _LockHeight
If Not _ControlMode Then MyBase.Dock = DockStyle.Fill

Transparent = _Transparent
If _Transparent AndAlso _BackColor Then BackColor = Color.Transparent

MyBase.OnHandleCreated(e)
End Sub

Private DoneCreation As Boolean
Protected NotOverridable Overrides Sub OnParentChanged(ByVal e As EventArgs)
MyBase.OnParentChanged(e)

If Parent Is Nothing Then Return
_IsParentForm = TypeOf Parent Is Form

If Not _ControlMode Then
InitializeMessages()

If _IsParentForm Then
ParentForm.FormBorderStyle = _BorderStyle
ParentForm.TransparencyKey = _TransparencyKey

If Not DesignMode Then
AddHandler ParentForm.Shown, AddressOf FormShown
End If
End If

Parent.BackColor = BackColor
End If

OnCreation()
DoneCreation = True
InvalidateTimer()
End Sub

#End Region

Private Sub DoAnimation(ByVal i As Boolean)
OnAnimation()
If i Then Invalidate()
End Sub

Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
If Width = 0 OrElse Height = 0 Then Return

If _Transparent AndAlso _ControlMode Then
PaintHook()
e.Graphics.DrawImage(B, 0, 0)
Else
G = e.Graphics
PaintHook()
End If
End Sub

Protected Overrides Sub OnHandleDestroyed(ByVal e As EventArgs)
RemoveAnimationCallback(AddressOf DoAnimation)
MyBase.OnHandleDestroyed(e)
End Sub

Private HasShown As Boolean
Private Sub FormShown(ByVal sender As Object, ByVal e As EventArgs)
If _ControlMode OrElse HasShown Then Return

If _StartPosition = FormStartPosition.CenterParent OrElse _StartPosition = FormStartPosition.CenterScreen Then
Dim SB As Rectangle = Screen.PrimaryScreen.Bounds
Dim CB As Rectangle = ParentForm.Bounds
ParentForm.Location = New Point(SB.Width \ 2 - CB.Width \ 2, SB.Height \ 2 - CB.Width \ 2)
End If

HasShown = True
End Sub


#Region " Size Handling "

Private Frame As Rectangle
Protected NotOverridable Overrides Sub OnSizeChanged(ByVal e As EventArgs)
If _Movable AndAlso Not _ControlMode Then
Frame = New Rectangle(7, 7, Width - 14, _Header - 7)
End If

InvalidateBitmap()
Invalidate()

MyBase.OnSizeChanged(e)
End Sub

Protected Overrides Sub SetBoundsCore(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal specified As BoundsSpecified)
If Not _LockWidth = 0 Then width = _LockWidth
If Not _LockHeight = 0 Then height = _LockHeight
MyBase.SetBoundsCore(x, y, width, height, specified)
End Sub

#End Region

#Region " State Handling "

Protected State As MouseState
Private Sub SetState(ByVal current As MouseState)
State = current
Invalidate()
End Sub

Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
If Not (_IsParentForm AndAlso ParentForm.WindowState = FormWindowState.Maximized) Then
If _Sizable AndAlso Not _ControlMode Then InvalidateMouse()
End If

MyBase.OnMouseMove(e)
End Sub

Protected Overrides Sub OnEnabledChanged(ByVal e As EventArgs)
If Enabled Then SetState(MouseState.None) Else SetState(MouseState.Block)
MyBase.OnEnabledChanged(e)
End Sub

Protected Overrides Sub OnMouseEnter(ByVal e As EventArgs)
SetState(MouseState.Over)
MyBase.OnMouseEnter(e)
End Sub

Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
SetState(MouseState.Over)
MyBase.OnMouseUp(e)
End Sub

Protected Overrides Sub OnMouseLeave(ByVal e As EventArgs)
SetState(MouseState.None)

If GetChildAtPoint(PointToClient(MousePosition)) IsNot Nothing Then
If _Sizable AndAlso Not _ControlMode Then
Cursor = Cursors.Default
Previous = 0
End If
End If

MyBase.OnMouseLeave(e)
End Sub

Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Left Then SetState(MouseState.Down)

If Not (_IsParentForm AndAlso ParentForm.WindowState = FormWindowState.Maximized OrElse _ControlMode) Then
If _Movable AndAlso Frame.Contains(e.Location) Then
Capture = False
WM_LMBUTTONDOWN = True
DefWndProc(Messages(0))
ElseIf _Sizable AndAlso Not Previous = 0 Then
Capture = False
WM_LMBUTTONDOWN = True
DefWndProc(Messages(Previous))
End If
End If

MyBase.OnMouseDown(e)
End Sub

Private WM_LMBUTTONDOWN As Boolean
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)

If WM_LMBUTTONDOWN AndAlso m.Msg = 513 Then
WM_LMBUTTONDOWN = False

SetState(MouseState.Over)
If Not _SmartBounds Then Return

If IsParentMdi Then
CorrectBounds(New Rectangle(Point.Empty, Parent.Parent.Size))
Else
CorrectBounds(Screen.FromControl(Parent).WorkingArea)
End If
End If
End Sub

Private GetIndexPoint As Point
Private B1, B2, B3, B4 As Boolean
Private Function GetIndex() As Integer
GetIndexPoint = PointToClient(MousePosition)
B1 = GetIndexPoint.X < 7
B2 = GetIndexPoint.X > Width - 7
B3 = GetIndexPoint.Y < 7
B4 = GetIndexPoint.Y > Height - 7

If B1 AndAlso B3 Then Return 4
If B1 AndAlso B4 Then Return 7
If B2 AndAlso B3 Then Return 5
If B2 AndAlso B4 Then Return 8
If B1 Then Return 1
If B2 Then Return 2
If B3 Then Return 3
If B4 Then Return 6
Return 0
End Function

Private Current, Previous As Integer
Private Sub InvalidateMouse()
Current = GetIndex()
If Current = Previous Then Return

Previous = Current
Select Case Previous
Case 0
Cursor = Cursors.Default
Case 1, 2
Cursor = Cursors.SizeWE
Case 3, 6
Cursor = Cursors.SizeNS
Case 4, 8
Cursor = Cursors.SizeNWSE
Case 5, 7
Cursor = Cursors.SizeNESW
End Select
End Sub

Private Messages(8) As Message
Private Sub InitializeMessages()
Messages(0) = Message.Create(Parent.Handle, 161, New IntPtr(2), IntPtr.Zero)
For I As Integer = 1 To 8
Messages(I) = Message.Create(Parent.Handle, 161, New IntPtr(I + 9), IntPtr.Zero)
Next
End Sub

Private Sub CorrectBounds(ByVal bounds As Rectangle)
If Parent.Width > bounds.Width Then Parent.Width = bounds.Width
If Parent.Height > bounds.Height Then Parent.Height = bounds.Height

Dim X As Integer = Parent.Location.X
Dim Y As Integer = Parent.Location.Y

If X < bounds.X Then X = bounds.X
If Y < bounds.Y Then Y = bounds.Y

Dim Width As Integer = bounds.X + bounds.Width
Dim Height As Integer = bounds.Y + bounds.Height

If X + Parent.Width > Width Then X = Width - Parent.Width
If Y + Parent.Height > Height Then Y = Height - Parent.Height

Parent.Location = New Point(X, Y)
End Sub

#End Region


#Region " Base Properties "

Overrides Property Dock() As DockStyle
Get
Return MyBase.Dock
End Get
Set(ByVal value As DockStyle)
If Not _ControlMode Then Return
MyBase.Dock = value
End Set
End Property

Private _BackColor As Boolean
<Category("Misc")> _
Overrides Property BackColor() As Color
Get
Return MyBase.BackColor
End Get
Set(ByVal value As Color)
If value = MyBase.BackColor Then Return

If Not IsHandleCreated AndAlso _ControlMode AndAlso value = Color.Transparent Then
_BackColor = True
Return
End If

MyBase.BackColor = value
If Parent IsNot Nothing Then
If Not _ControlMode Then Parent.BackColor = value
ColorHook()
End If
End Set
End Property

Overrides Property MinimumSize() As Size
Get
Return MyBase.MinimumSize
End Get
Set(ByVal value As Size)
MyBase.MinimumSize = value
If Parent IsNot Nothing Then Parent.MinimumSize = value
End Set
End Property

Overrides Property MaximumSize() As Size
Get
Return MyBase.MaximumSize
End Get
Set(ByVal value As Size)
MyBase.MaximumSize = value
If Parent IsNot Nothing Then Parent.MaximumSize = value
End Set
End Property

Overrides Property Text() As String
Get
Return MyBase.Text
End Get
Set(ByVal value As String)
MyBase.Text = value
Invalidate()
End Set
End Property

Overrides Property Font() As Font
Get
Return MyBase.Font
End Get
Set(ByVal value As Font)
MyBase.Font = value
Invalidate()
End Set
End Property

<Browsable(False), EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Overrides Property ForeColor() As Color
Get
Return Color.Empty
End Get
Set(ByVal value As Color)
End Set
End Property
<Browsable(False), EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Overrides Property BackgroundImage() As Image
Get
Return Nothing
End Get
Set(ByVal value As Image)
End Set
End Property
<Browsable(False), EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Overrides Property BackgroundImageLayout() As ImageLayout
Get
Return ImageLayout.None
End Get
Set(ByVal value As ImageLayout)
End Set
End Property

#End Region

#Region " Public Properties "

Private _SmartBounds As Boolean = True
Property SmartBounds() As Boolean
Get
Return _SmartBounds
End Get
Set(ByVal value As Boolean)
_SmartBounds = value
End Set
End Property

Private _Movable As Boolean = True
Property Movable() As Boolean
Get
Return _Movable
End Get
Set(ByVal value As Boolean)
_Movable = value
End Set
End Property

Private _Sizable As Boolean = True
Property Sizable() As Boolean
Get
Return _Sizable
End Get
Set(ByVal value As Boolean)
_Sizable = value
End Set
End Property

Private _TransparencyKey As Color
Property TransparencyKey() As Color
Get
If _IsParentForm AndAlso Not _ControlMode Then Return ParentForm.TransparencyKey Else Return _TransparencyKey
End Get
Set(ByVal value As Color)
If value = _TransparencyKey Then Return
_TransparencyKey = value

If _IsParentForm AndAlso Not _ControlMode Then
ParentForm.TransparencyKey = value
ColorHook()
End If
End Set
End Property

Private _BorderStyle As FormBorderStyle
Property BorderStyle() As FormBorderStyle
Get
If _IsParentForm AndAlso Not _ControlMode Then Return ParentForm.FormBorderStyle Else Return _BorderStyle
End Get
Set(ByVal value As FormBorderStyle)
_BorderStyle = value

If _IsParentForm AndAlso Not _ControlMode Then
ParentForm.FormBorderStyle = value

If Not value = FormBorderStyle.None Then
Movable = False
Sizable = False
End If
End If
End Set
End Property

Private _StartPosition As FormStartPosition
Property StartPosition() As FormStartPosition
Get
If _IsParentForm AndAlso Not _ControlMode Then Return ParentForm.StartPosition Else Return _StartPosition
End Get
Set(ByVal value As FormStartPosition)
_StartPosition = value

If _IsParentForm AndAlso Not _ControlMode Then
ParentForm.StartPosition = value
End If
End Set
End Property

Private _NoRounding As Boolean
Property NoRounding() As Boolean
Get
Return _NoRounding
End Get
Set(ByVal v As Boolean)
_NoRounding = v
Invalidate()
End Set
End Property

Private _Image As Image
Property Image() As Image
Get
Return _Image
End Get
Set(ByVal value As Image)
If value Is Nothing Then _ImageSize = Size.Empty Else _ImageSize = value.Size

_Image = value
Invalidate()
End Set
End Property

Private Items As New Dictionary(Of String, Color)
Property Colors() As Bloom()
Get
Dim T As New List(Of Bloom)
Dim E As Dictionary(Of String, Color).Enumerator = Items.GetEnumerator

While E.MoveNext
T.Add(New Bloom(E.Current.Key, E.Current.Value))
End While

Return T.ToArray
End Get
Set(ByVal value As Bloom())
For Each B As Bloom In value
If Items.ContainsKey(B.Name) Then Items(B.Name) = B.Value
Next

InvalidateCustimization()
ColorHook()
Invalidate()
End Set
End Property

Private _Customization As String
Property Customization() As String
Get
Return _Customization
End Get
Set(ByVal value As String)
If value = _Customization Then Return

Dim Data As Byte()
Dim Items As Bloom() = Colors

Try
Data = Convert.FromBase64String(value)
For I As Integer = 0 To Items.Length - 1
Items(I).Value = Color.FromArgb(BitConverter.ToInt32(Data, I * 4))
Next
Catch
Return
End Try

_Customization = value

Colors = Items
ColorHook()
Invalidate()
End Set
End Property

Private _Transparent As Boolean
Property Transparent() As Boolean
Get
Return _Transparent
End Get
Set(ByVal value As Boolean)
_Transparent = value
If Not (IsHandleCreated OrElse _ControlMode) Then Return

If Not value AndAlso Not BackColor.A = 255 Then
Throw New Exception("Unable to change value to false while a transparent BackColor is in use.")
End If

SetStyle(ControlStyles.Opaque, Not value)
SetStyle(ControlStyles.SupportsTransparentBackColor, value)

InvalidateBitmap()
Invalidate()
End Set
End Property

#End Region

#Region " Private Properties "

Private _ImageSize As Size
Protected ReadOnly Property ImageSize() As Size
Get
Return _ImageSize
End Get
End Property

Private _IsParentForm As Boolean
Protected ReadOnly Property IsParentForm() As Boolean
Get
Return _IsParentForm
End Get
End Property

Protected ReadOnly Property IsParentMdi() As Boolean
Get
If Parent Is Nothing Then Return False
Return Parent.Parent IsNot Nothing
End Get
End Property

Private _LockWidth As Integer
Protected Property LockWidth() As Integer
Get
Return _LockWidth
End Get
Set(ByVal value As Integer)
_LockWidth = value
If Not LockWidth = 0 AndAlso IsHandleCreated Then Width = LockWidth
End Set
End Property

Private _LockHeight As Integer
Protected Property LockHeight() As Integer
Get
Return _LockHeight
End Get
Set(ByVal value As Integer)
_LockHeight = value
If Not LockHeight = 0 AndAlso IsHandleCreated Then Height = LockHeight
End Set
End Property

Private _Header As Integer = 24
Protected Property Header() As Integer
Get
Return _Header
End Get
Set(ByVal v As Integer)
_Header = v

If Not _ControlMode Then
Frame = New Rectangle(7, 7, Width - 14, v - 7)
Invalidate()
End If
End Set
End Property

Private _ControlMode As Boolean
Protected Property ControlMode() As Boolean
Get
Return _ControlMode
End Get
Set(ByVal v As Boolean)
_ControlMode = v

Transparent = _Transparent
If _Transparent AndAlso _BackColor Then BackColor = Color.Transparent

InvalidateBitmap()
Invalidate()
End Set
End Property

Private _IsAnimated As Boolean
Protected Property IsAnimated() As Boolean
Get
Return _IsAnimated
End Get
Set(ByVal value As Boolean)
_IsAnimated = value
InvalidateTimer()
End Set
End Property

#End Region


#Region " Property Helpers "

Protected Function GetPen(ByVal name As String) As Pen
Return New Pen(Items(name))
End Function
Protected Function GetPen(ByVal name As String, ByVal width As Single) As Pen
Return New Pen(Items(name), width)
End Function

Protected Function GetBrush(ByVal name As String) As SolidBrush
Return New SolidBrush(Items(name))
End Function

Protected Function GetColor(ByVal name As String) As Color
Return Items(name)
End Function

Protected Sub SetColor(ByVal name As String, ByVal value As Color)
If Items.ContainsKey(name) Then Items(name) = value Else Items.Add(name, value)
End Sub
Protected Sub SetColor(ByVal name As String, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
SetColor(name, Color.FromArgb(r, g, b))
End Sub
Protected Sub SetColor(ByVal name As String, ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
SetColor(name, Color.FromArgb(a, r, g, b))
End Sub
Protected Sub SetColor(ByVal name As String, ByVal a As Byte, ByVal value As Color)
SetColor(name, Color.FromArgb(a, value))
End Sub

Private Sub InvalidateBitmap()
If _Transparent AndAlso _ControlMode Then
If Width = 0 OrElse Height = 0 Then Return
B = New Bitmap(Width, Height, PixelFormat.Format32bppPArgb)
G = Graphics.FromImage(B)
Else
G = Nothing
B = Nothing
End If
End Sub

Private Sub InvalidateCustimization()
Dim M As New MemoryStream(Items.Count * 4)

For Each B As Bloom In Colors
M.Write(BitConverter.GetBytes(B.Value.ToArgb), 0, 4)
Next

M.Close()
_Customization = Convert.ToBase64String(M.ToArray)
End Sub

Private Sub InvalidateTimer()
If DesignMode OrElse Not DoneCreation Then Return

If _IsAnimated Then
AddAnimationCallback(AddressOf DoAnimation)
Else
RemoveAnimationCallback(AddressOf DoAnimation)
End If
End Sub

#End Region


#Region " User Hooks "

Protected MustOverride Sub ColorHook()
Protected MustOverride Sub PaintHook()

Protected Overridable Sub OnCreation()
End Sub

Protected Overridable Sub OnAnimation()
End Sub

#End Region


#Region " Offset "

Private OffsetReturnRectangle As Rectangle
Protected Function Offset(ByVal r As Rectangle, ByVal amount As Integer) As Rectangle
OffsetReturnRectangle = New Rectangle(r.X + amount, r.Y + amount, r.Width - (amount * 2), r.Height - (amount * 2))
Return OffsetReturnRectangle
End Function

Private OffsetReturnSize As Size
Protected Function Offset(ByVal s As Size, ByVal amount As Integer) As Size
OffsetReturnSize = New Size(s.Width + amount, s.Height + amount)
Return OffsetReturnSize
End Function

Private OffsetReturnPoint As Point
Protected Function Offset(ByVal p As Point, ByVal amount As Integer) As Point
OffsetReturnPoint = New Point(p.X + amount, p.Y + amount)
Return OffsetReturnPoint
End Function

#End Region

#Region " Center "

Private CenterReturn As Point

Protected Function Center(ByVal p As Rectangle, ByVal c As Rectangle) As Point
CenterReturn = New Point((p.Width \ 2 - c.Width \ 2) + p.X + c.X, (p.Height \ 2 - c.Height \ 2) + p.Y + c.Y)
Return CenterReturn
End Function
Protected Function Center(ByVal p As Rectangle, ByVal c As Size) As Point
CenterReturn = New Point((p.Width \ 2 - c.Width \ 2) + p.X, (p.Height \ 2 - c.Height \ 2) + p.Y)
Return CenterReturn
End Function

Protected Function Center(ByVal child As Rectangle) As Point
Return Center(Width, Height, child.Width, child.Height)
End Function
Protected Function Center(ByVal child As Size) As Point
Return Center(Width, Height, child.Width, child.Height)
End Function
Protected Function Center(ByVal childWidth As Integer, ByVal childHeight As Integer) As Point
Return Center(Width, Height, childWidth, childHeight)
End Function

Protected Function Center(ByVal p As Size, ByVal c As Size) As Point
Return Center(p.Width, p.Height, c.Width, c.Height)
End Function

Protected Function Center(ByVal pWidth As Integer, ByVal pHeight As Integer, ByVal cWidth As Integer, ByVal cHeight As Integer) As Point
CenterReturn = New Point(pWidth \ 2 - cWidth \ 2, pHeight \ 2 - cHeight \ 2)
Return CenterReturn
End Function

#End Region

#Region " Measure "

Private MeasureBitmap As Bitmap
Private MeasureGraphics As Graphics

Protected Function Measure() As Size
SyncLock MeasureGraphics
Return MeasureGraphics.MeasureString(Text, Font, Width).ToSize
End SyncLock
End Function
Protected Function Measure(ByVal text As String) As Size
SyncLock MeasureGraphics
Return MeasureGraphics.MeasureString(text, Font, Width).ToSize
End SyncLock
End Function

#End Region


#Region " DrawPixel "

Private DrawPixelBrush As SolidBrush

Protected Sub DrawPixel(ByVal c1 As Color, ByVal x As Integer, ByVal y As Integer)
If _Transparent Then
B.SetPixel(x, y, c1)
Else
DrawPixelBrush = New SolidBrush(c1)
G.FillRectangle(DrawPixelBrush, x, y, 1, 1)
End If
End Sub

#End Region

#Region " DrawCorners "

Private DrawCornersBrush As SolidBrush

Protected Sub DrawCorners(ByVal c1 As Color, ByVal offset As Integer)
DrawCorners(c1, 0, 0, Width, Height, offset)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal r1 As Rectangle, ByVal offset As Integer)
DrawCorners(c1, r1.X, r1.Y, r1.Width, r1.Height, offset)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal offset As Integer)
DrawCorners(c1, x + offset, y + offset, width - (offset * 2), height - (offset * 2))
End Sub

Protected Sub DrawCorners(ByVal c1 As Color)
DrawCorners(c1, 0, 0, Width, Height)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal r1 As Rectangle)
DrawCorners(c1, r1.X, r1.Y, r1.Width, r1.Height)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
If _NoRounding Then Return

If _Transparent Then
B.SetPixel(x, y, c1)
B.SetPixel(x + (width - 1), y, c1)
B.SetPixel(x, y + (height - 1), c1)
B.SetPixel(x + (width - 1), y + (height - 1), c1)
Else
DrawCornersBrush = New SolidBrush(c1)
G.FillRectangle(DrawCornersBrush, x, y, 1, 1)
G.FillRectangle(DrawCornersBrush, x + (width - 1), y, 1, 1)
G.FillRectangle(DrawCornersBrush, x, y + (height - 1), 1, 1)
G.FillRectangle(DrawCornersBrush, x + (width - 1), y + (height - 1), 1, 1)
End If
End Sub

#End Region

#Region " DrawBorders "

Protected Sub DrawBorders(ByVal p1 As Pen, ByVal offset As Integer)
DrawBorders(p1, 0, 0, Width, Height, offset)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal r As Rectangle, ByVal offset As Integer)
DrawBorders(p1, r.X, r.Y, r.Width, r.Height, offset)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal offset As Integer)
DrawBorders(p1, x + offset, y + offset, width - (offset * 2), height - (offset * 2))
End Sub

Protected Sub DrawBorders(ByVal p1 As Pen)
DrawBorders(p1, 0, 0, Width, Height)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal r As Rectangle)
DrawBorders(p1, r.X, r.Y, r.Width, r.Height)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
G.DrawRectangle(p1, x, y, width - 1, height - 1)
End Sub

#End Region

#Region " DrawText "

Private DrawTextPoint As Point
Private DrawTextSize As Size

Protected Sub DrawText(ByVal b1 As Brush, ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
DrawText(b1, Text, a, x, y)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal text As String, ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
If text.Length = 0 Then Return

DrawTextSize = Measure(text)
DrawTextPoint = New Point(Width \ 2 - DrawTextSize.Width \ 2, Header \ 2 - DrawTextSize.Height \ 2)

Select Case a
Case HorizontalAlignment.Left
G.DrawString(text, Font, b1, x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Center
G.DrawString(text, Font, b1, DrawTextPoint.X + x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Right
G.DrawString(text, Font, b1, Width - DrawTextSize.Width - x, DrawTextPoint.Y + y)
End Select
End Sub

Protected Sub DrawText(ByVal b1 As Brush, ByVal p1 As Point)
If Text.Length = 0 Then Return
G.DrawString(Text, Font, b1, p1)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal x As Integer, ByVal y As Integer)
If Text.Length = 0 Then Return
G.DrawString(Text, Font, b1, x, y)
End Sub

#End Region

#Region " DrawImage "

Private DrawImagePoint As Point

Protected Sub DrawImage(ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
DrawImage(_Image, a, x, y)
End Sub
Protected Sub DrawImage(ByVal image As Image, ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
If image Is Nothing Then Return
DrawImagePoint = New Point(Width \ 2 - image.Width \ 2, Header \ 2 - image.Height \ 2)

Select Case a
Case HorizontalAlignment.Left
G.DrawImage(image, x, DrawImagePoint.Y + y, image.Width, image.Height)
Case HorizontalAlignment.Center
G.DrawImage(image, DrawImagePoint.X + x, DrawImagePoint.Y + y, image.Width, image.Height)
Case HorizontalAlignment.Right
G.DrawImage(image, Width - image.Width - x, DrawImagePoint.Y + y, image.Width, image.Height)
End Select
End Sub

Protected Sub DrawImage(ByVal p1 As Point)
DrawImage(_Image, p1.X, p1.Y)
End Sub
Protected Sub DrawImage(ByVal x As Integer, ByVal y As Integer)
DrawImage(_Image, x, y)
End Sub

Protected Sub DrawImage(ByVal image As Image, ByVal p1 As Point)
DrawImage(image, p1.X, p1.Y)
End Sub
Protected Sub DrawImage(ByVal image As Image, ByVal x As Integer, ByVal y As Integer)
If image Is Nothing Then Return
G.DrawImage(image, x, y, image.Width, image.Height)
End Sub

#End Region

#Region " DrawGradient "

Private DrawGradientBrush As LinearGradientBrush
Private DrawGradientRectangle As Rectangle

Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(blend, DrawGradientRectangle)
End Sub
Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal angle As Single)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(blend, DrawGradientRectangle, angle)
End Sub

Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal r As Rectangle)
DrawGradientBrush = New LinearGradientBrush(r, Color.Empty, Color.Empty, 90.0F)
DrawGradientBrush.InterpolationColors = blend
G.FillRectangle(DrawGradientBrush, r)
End Sub
Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal r As Rectangle, ByVal angle As Single)
DrawGradientBrush = New LinearGradientBrush(r, Color.Empty, Color.Empty, angle)
DrawGradientBrush.InterpolationColors = blend
G.FillRectangle(DrawGradientBrush, r)
End Sub


Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(c1, c2, DrawGradientRectangle)
End Sub
Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal angle As Single)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(c1, c2, DrawGradientRectangle, angle)
End Sub

Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle)
DrawGradientBrush = New LinearGradientBrush(r, c1, c2, 90.0F)
G.FillRectangle(DrawGradientBrush, r)
End Sub
Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle, ByVal angle As Single)
DrawGradientBrush = New LinearGradientBrush(r, c1, c2, angle)
G.FillRectangle(DrawGradientBrush, r)
End Sub

#End Region

#Region " DrawRadial "

Private DrawRadialPath As GraphicsPath
Private DrawRadialBrush1 As PathGradientBrush
Private DrawRadialBrush2 As LinearGradientBrush
Private DrawRadialRectangle As Rectangle

Sub DrawRadial(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(blend, DrawRadialRectangle, width \ 2, height \ 2)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal center As Point)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(blend, DrawRadialRectangle, center.X, center.Y)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal cx As Integer, ByVal cy As Integer)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(blend, DrawRadialRectangle, cx, cy)
End Sub

Sub DrawRadial(ByVal blend As ColorBlend, ByVal r As Rectangle)
DrawRadial(blend, r, r.Width \ 2, r.Height \ 2)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal r As Rectangle, ByVal center As Point)
DrawRadial(blend, r, center.X, center.Y)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal r As Rectangle, ByVal cx As Integer, ByVal cy As Integer)
DrawRadialPath.Reset()
DrawRadialPath.AddEllipse(r.X, r.Y, r.Width - 1, r.Height - 1)

DrawRadialBrush1 = New PathGradientBrush(DrawRadialPath)
DrawRadialBrush1.CenterPoint = New Point(r.X + cx, r.Y + cy)
DrawRadialBrush1.InterpolationColors = blend

If G.SmoothingMode = SmoothingMode.AntiAlias Then
G.FillEllipse(DrawRadialBrush1, r.X + 1, r.Y + 1, r.Width - 3, r.Height - 3)
Else
G.FillEllipse(DrawRadialBrush1, r)
End If
End Sub


Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(c1, c2, DrawGradientRectangle)
End Sub
Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal angle As Single)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(c1, c2, DrawGradientRectangle, angle)
End Sub

Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle)
DrawRadialBrush2 = New LinearGradientBrush(r, c1, c2, 90.0F)
G.FillRectangle(DrawGradientBrush, r)
End Sub
Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle, ByVal angle As Single)
DrawRadialBrush2 = New LinearGradientBrush(r, c1, c2, angle)
G.FillEllipse(DrawGradientBrush, r)
End Sub

#End Region

#Region " CreateRound "

Private CreateRoundPath As GraphicsPath
Private CreateRoundRectangle As Rectangle

Function CreateRound(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal slope As Integer) As GraphicsPath
CreateRoundRectangle = New Rectangle(x, y, width, height)
Return CreateRound(CreateRoundRectangle, slope)
End Function

Function CreateRound(ByVal r As Rectangle, ByVal slope As Integer) As GraphicsPath
CreateRoundPath = New GraphicsPath(FillMode.Winding)
CreateRoundPath.AddArc(r.X, r.Y, slope, slope, 180.0F, 90.0F)
CreateRoundPath.AddArc(r.Right - slope, r.Y, slope, slope, 270.0F, 90.0F)
CreateRoundPath.AddArc(r.Right - slope, r.Bottom - slope, slope, slope, 0.0F, 90.0F)
CreateRoundPath.AddArc(r.X, r.Bottom - slope, slope, slope, 90.0F, 90.0F)
CreateRoundPath.CloseFigure()
Return CreateRoundPath
End Function

#End Region

End Class

MustInherit Class ThemeControl154
Inherits Control


#Region " Initialization "

Protected G As Graphics, B As Bitmap

Sub New()
SetStyle(DirectCast(139270, ControlStyles), True)

_ImageSize = Size.Empty
Font = New Font("Verdana", 8S)

MeasureBitmap = New Bitmap(1, 1)
MeasureGraphics = Graphics.FromImage(MeasureBitmap)

DrawRadialPath = New GraphicsPath

InvalidateCustimization() 'Remove?
End Sub

Protected NotOverridable Overrides Sub OnHandleCreated(ByVal e As EventArgs)
InvalidateCustimization()
ColorHook()

If Not _LockWidth = 0 Then Width = _LockWidth
If Not _LockHeight = 0 Then Height = _LockHeight

Transparent = _Transparent
If _Transparent AndAlso _BackColor Then BackColor = Color.Transparent

MyBase.OnHandleCreated(e)
End Sub

Private DoneCreation As Boolean
Protected NotOverridable Overrides Sub OnParentChanged(ByVal e As EventArgs)
If Parent IsNot Nothing Then
OnCreation()
DoneCreation = True
InvalidateTimer()
End If

MyBase.OnParentChanged(e)
End Sub

#End Region

Private Sub DoAnimation(ByVal i As Boolean)
OnAnimation()
If i Then Invalidate()
End Sub

Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
If Width = 0 OrElse Height = 0 Then Return

If _Transparent Then
PaintHook()
e.Graphics.DrawImage(B, 0, 0)
Else
G = e.Graphics
PaintHook()
End If
End Sub

Protected Overrides Sub OnHandleDestroyed(ByVal e As EventArgs)
RemoveAnimationCallback(AddressOf DoAnimation)
MyBase.OnHandleDestroyed(e)
End Sub

#Region " Size Handling "

Protected NotOverridable Overrides Sub OnSizeChanged(ByVal e As EventArgs)
If _Transparent Then
InvalidateBitmap()
End If

Invalidate()
MyBase.OnSizeChanged(e)
End Sub

Protected Overrides Sub SetBoundsCore(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal specified As BoundsSpecified)
If Not _LockWidth = 0 Then width = _LockWidth
If Not _LockHeight = 0 Then height = _LockHeight
MyBase.SetBoundsCore(x, y, width, height, specified)
End Sub

#End Region

#Region " State Handling "

Private InPosition As Boolean
Protected Overrides Sub OnMouseEnter(ByVal e As EventArgs)
InPosition = True
SetState(MouseState.Over)
MyBase.OnMouseEnter(e)
End Sub

Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
If InPosition Then SetState(MouseState.Over)
MyBase.OnMouseUp(e)
End Sub

Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Left Then SetState(MouseState.Down)
MyBase.OnMouseDown(e)
End Sub

Protected Overrides Sub OnMouseLeave(ByVal e As EventArgs)
InPosition = False
SetState(MouseState.None)
MyBase.OnMouseLeave(e)
End Sub

Protected Overrides Sub OnEnabledChanged(ByVal e As EventArgs)
If Enabled Then SetState(MouseState.None) Else SetState(MouseState.Block)
MyBase.OnEnabledChanged(e)
End Sub

Protected State As MouseState
Private Sub SetState(ByVal current As MouseState)
State = current
Invalidate()
End Sub

#End Region


#Region " Base Properties "

<Browsable(False), EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Overrides Property ForeColor() As Color
Get
Return Color.Empty
End Get
Set(ByVal value As Color)
End Set
End Property
<Browsable(False), EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Overrides Property BackgroundImage() As Image
Get
Return Nothing
End Get
Set(ByVal value As Image)
End Set
End Property
<Browsable(False), EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Overrides Property BackgroundImageLayout() As ImageLayout
Get
Return ImageLayout.None
End Get
Set(ByVal value As ImageLayout)
End Set
End Property

Overrides Property Text() As String
Get
Return MyBase.Text
End Get
Set(ByVal value As String)
MyBase.Text = value
Invalidate()
End Set
End Property
Overrides Property Font() As Font
Get
Return MyBase.Font
End Get
Set(ByVal value As Font)
MyBase.Font = value
Invalidate()
End Set
End Property

Private _BackColor As Boolean
<Category("Misc")> _
Overrides Property BackColor() As Color
Get
Return MyBase.BackColor
End Get
Set(ByVal value As Color)
If Not IsHandleCreated AndAlso value = Color.Transparent Then
_BackColor = True
Return
End If

MyBase.BackColor = value
If Parent IsNot Nothing Then ColorHook()
End Set
End Property

#End Region

#Region " Public Properties "

Private _NoRounding As Boolean
Property NoRounding() As Boolean
Get
Return _NoRounding
End Get
Set(ByVal v As Boolean)
_NoRounding = v
Invalidate()
End Set
End Property

Private _Image As Image
Property Image() As Image
Get
Return _Image
End Get
Set(ByVal value As Image)
If value Is Nothing Then
_ImageSize = Size.Empty
Else
_ImageSize = value.Size
End If

_Image = value
Invalidate()
End Set
End Property

Private _Transparent As Boolean
Property Transparent() As Boolean
Get
Return _Transparent
End Get
Set(ByVal value As Boolean)
_Transparent = value
If Not IsHandleCreated Then Return

If Not value AndAlso Not BackColor.A = 255 Then
Throw New Exception("Unable to change value to false while a transparent BackColor is in use.")
End If

SetStyle(ControlStyles.Opaque, Not value)
SetStyle(ControlStyles.SupportsTransparentBackColor, value)

If value Then InvalidateBitmap() Else B = Nothing
Invalidate()
End Set
End Property

Private Items As New Dictionary(Of String, Color)
Property Colors() As Bloom()
Get
Dim T As New List(Of Bloom)
Dim E As Dictionary(Of String, Color).Enumerator = Items.GetEnumerator

While E.MoveNext
T.Add(New Bloom(E.Current.Key, E.Current.Value))
End While

Return T.ToArray
End Get
Set(ByVal value As Bloom())
For Each B As Bloom In value
If Items.ContainsKey(B.Name) Then Items(B.Name) = B.Value
Next

InvalidateCustimization()
ColorHook()
Invalidate()
End Set
End Property

Private _Customization As String
Property Customization() As String
Get
Return _Customization
End Get
Set(ByVal value As String)
If value = _Customization Then Return

Dim Data As Byte()
Dim Items As Bloom() = Colors

Try
Data = Convert.FromBase64String(value)
For I As Integer = 0 To Items.Length - 1
Items(I).Value = Color.FromArgb(BitConverter.ToInt32(Data, I * 4))
Next
Catch
Return
End Try

_Customization = value

Colors = Items
ColorHook()
Invalidate()
End Set
End Property

#End Region

#Region " Private Properties "

Private _ImageSize As Size
Protected ReadOnly Property ImageSize() As Size
Get
Return _ImageSize
End Get
End Property

Private _LockWidth As Integer
Protected Property LockWidth() As Integer
Get
Return _LockWidth
End Get
Set(ByVal value As Integer)
_LockWidth = value
If Not LockWidth = 0 AndAlso IsHandleCreated Then Width = LockWidth
End Set
End Property

Private _LockHeight As Integer
Protected Property LockHeight() As Integer
Get
Return _LockHeight
End Get
Set(ByVal value As Integer)
_LockHeight = value
If Not LockHeight = 0 AndAlso IsHandleCreated Then Height = LockHeight
End Set
End Property

Private _IsAnimated As Boolean
Protected Property IsAnimated() As Boolean
Get
Return _IsAnimated
End Get
Set(ByVal value As Boolean)
_IsAnimated = value
InvalidateTimer()
End Set
End Property

#End Region


#Region " Property Helpers "

Protected Function GetPen(ByVal name As String) As Pen
Return New Pen(Items(name))
End Function
Protected Function GetPen(ByVal name As String, ByVal width As Single) As Pen
Return New Pen(Items(name), width)
End Function

Protected Function GetBrush(ByVal name As String) As SolidBrush
Return New SolidBrush(Items(name))
End Function

Protected Function GetColor(ByVal name As String) As Color
Return Items(name)
End Function

Protected Sub SetColor(ByVal name As String, ByVal value As Color)
If Items.ContainsKey(name) Then Items(name) = value Else Items.Add(name, value)
End Sub
Protected Sub SetColor(ByVal name As String, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
SetColor(name, Color.FromArgb(r, g, b))
End Sub
Protected Sub SetColor(ByVal name As String, ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
SetColor(name, Color.FromArgb(a, r, g, b))
End Sub
Protected Sub SetColor(ByVal name As String, ByVal a As Byte, ByVal value As Color)
SetColor(name, Color.FromArgb(a, value))
End Sub

Private Sub InvalidateBitmap()
If Width = 0 OrElse Height = 0 Then Return
B = New Bitmap(Width, Height, PixelFormat.Format32bppPArgb)
G = Graphics.FromImage(B)
End Sub

Private Sub InvalidateCustimization()
Dim M As New MemoryStream(Items.Count * 4)

For Each B As Bloom In Colors
M.Write(BitConverter.GetBytes(B.Value.ToArgb), 0, 4)
Next

M.Close()
_Customization = Convert.ToBase64String(M.ToArray)
End Sub

Private Sub InvalidateTimer()
If DesignMode OrElse Not DoneCreation Then Return

If _IsAnimated Then
AddAnimationCallback(AddressOf DoAnimation)
Else
RemoveAnimationCallback(AddressOf DoAnimation)
End If
End Sub
#End Region


#Region " User Hooks "

Protected MustOverride Sub ColorHook()
Protected MustOverride Sub PaintHook()

Protected Overridable Sub OnCreation()
End Sub

Protected Overridable Sub OnAnimation()
End Sub

#End Region


#Region " Offset "

Private OffsetReturnRectangle As Rectangle
Protected Function Offset(ByVal r As Rectangle, ByVal amount As Integer) As Rectangle
OffsetReturnRectangle = New Rectangle(r.X + amount, r.Y + amount, r.Width - (amount * 2), r.Height - (amount * 2))
Return OffsetReturnRectangle
End Function

Private OffsetReturnSize As Size
Protected Function Offset(ByVal s As Size, ByVal amount As Integer) As Size
OffsetReturnSize = New Size(s.Width + amount, s.Height + amount)
Return OffsetReturnSize
End Function

Private OffsetReturnPoint As Point
Protected Function Offset(ByVal p As Point, ByVal amount As Integer) As Point
OffsetReturnPoint = New Point(p.X + amount, p.Y + amount)
Return OffsetReturnPoint
End Function

#End Region

#Region " Center "

Private CenterReturn As Point

Protected Function Center(ByVal p As Rectangle, ByVal c As Rectangle) As Point
CenterReturn = New Point((p.Width \ 2 - c.Width \ 2) + p.X + c.X, (p.Height \ 2 - c.Height \ 2) + p.Y + c.Y)
Return CenterReturn
End Function
Protected Function Center(ByVal p As Rectangle, ByVal c As Size) As Point
CenterReturn = New Point((p.Width \ 2 - c.Width \ 2) + p.X, (p.Height \ 2 - c.Height \ 2) + p.Y)
Return CenterReturn
End Function

Protected Function Center(ByVal child As Rectangle) As Point
Return Center(Width, Height, child.Width, child.Height)
End Function
Protected Function Center(ByVal child As Size) As Point
Return Center(Width, Height, child.Width, child.Height)
End Function
Protected Function Center(ByVal childWidth As Integer, ByVal childHeight As Integer) As Point
Return Center(Width, Height, childWidth, childHeight)
End Function

Protected Function Center(ByVal p As Size, ByVal c As Size) As Point
Return Center(p.Width, p.Height, c.Width, c.Height)
End Function

Protected Function Center(ByVal pWidth As Integer, ByVal pHeight As Integer, ByVal cWidth As Integer, ByVal cHeight As Integer) As Point
CenterReturn = New Point(pWidth \ 2 - cWidth \ 2, pHeight \ 2 - cHeight \ 2)
Return CenterReturn
End Function

#End Region

#Region " Measure "

Private MeasureBitmap As Bitmap
Private MeasureGraphics As Graphics 'TODO: Potential issues during multi-threading.

Protected Function Measure() As Size
Return MeasureGraphics.MeasureString(Text, Font, Width).ToSize
End Function
Protected Function Measure(ByVal text As String) As Size
Return MeasureGraphics.MeasureString(text, Font, Width).ToSize
End Function

#End Region


#Region " DrawPixel "

Private DrawPixelBrush As SolidBrush

Protected Sub DrawPixel(ByVal c1 As Color, ByVal x As Integer, ByVal y As Integer)
If _Transparent Then
B.SetPixel(x, y, c1)
Else
DrawPixelBrush = New SolidBrush(c1)
G.FillRectangle(DrawPixelBrush, x, y, 1, 1)
End If
End Sub

#End Region

#Region " DrawCorners "

Private DrawCornersBrush As SolidBrush

Protected Sub DrawCorners(ByVal c1 As Color, ByVal offset As Integer)
DrawCorners(c1, 0, 0, Width, Height, offset)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal r1 As Rectangle, ByVal offset As Integer)
DrawCorners(c1, r1.X, r1.Y, r1.Width, r1.Height, offset)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal offset As Integer)
DrawCorners(c1, x + offset, y + offset, width - (offset * 2), height - (offset * 2))
End Sub

Protected Sub DrawCorners(ByVal c1 As Color)
DrawCorners(c1, 0, 0, Width, Height)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal r1 As Rectangle)
DrawCorners(c1, r1.X, r1.Y, r1.Width, r1.Height)
End Sub
Protected Sub DrawCorners(ByVal c1 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
If _NoRounding Then Return

If _Transparent Then
B.SetPixel(x, y, c1)
B.SetPixel(x + (width - 1), y, c1)
B.SetPixel(x, y + (height - 1), c1)
B.SetPixel(x + (width - 1), y + (height - 1), c1)
Else
DrawCornersBrush = New SolidBrush(c1)
G.FillRectangle(DrawCornersBrush, x, y, 1, 1)
G.FillRectangle(DrawCornersBrush, x + (width - 1), y, 1, 1)
G.FillRectangle(DrawCornersBrush, x, y + (height - 1), 1, 1)
G.FillRectangle(DrawCornersBrush, x + (width - 1), y + (height - 1), 1, 1)
End If
End Sub

#End Region

#Region " DrawBorders "

Protected Sub DrawBorders(ByVal p1 As Pen, ByVal offset As Integer)
DrawBorders(p1, 0, 0, Width, Height, offset)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal r As Rectangle, ByVal offset As Integer)
DrawBorders(p1, r.X, r.Y, r.Width, r.Height, offset)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal offset As Integer)
DrawBorders(p1, x + offset, y + offset, width - (offset * 2), height - (offset * 2))
End Sub

Protected Sub DrawBorders(ByVal p1 As Pen)
DrawBorders(p1, 0, 0, Width, Height)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal r As Rectangle)
DrawBorders(p1, r.X, r.Y, r.Width, r.Height)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
G.DrawRectangle(p1, x, y, width - 1, height - 1)
End Sub

#End Region

#Region " DrawText "

Private DrawTextPoint As Point
Private DrawTextSize As Size

Protected Sub DrawText(ByVal b1 As Brush, ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
DrawText(b1, Text, a, x, y)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal text As String, ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
If text.Length = 0 Then Return

DrawTextSize = Measure(text)
DrawTextPoint = Center(DrawTextSize)

Select Case a
Case HorizontalAlignment.Left
G.DrawString(text, Font, b1, x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Center
G.DrawString(text, Font, b1, DrawTextPoint.X + x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Right
G.DrawString(text, Font, b1, Width - DrawTextSize.Width - x, DrawTextPoint.Y + y)
End Select
End Sub

Protected Sub DrawText(ByVal b1 As Brush, ByVal p1 As Point)
If Text.Length = 0 Then Return
G.DrawString(Text, Font, b1, p1)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal x As Integer, ByVal y As Integer)
If Text.Length = 0 Then Return
G.DrawString(Text, Font, b1, x, y)
End Sub

#End Region

#Region " DrawImage "

Private DrawImagePoint As Point

Protected Sub DrawImage(ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
DrawImage(_Image, a, x, y)
End Sub
Protected Sub DrawImage(ByVal image As Image, ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
If image Is Nothing Then Return
DrawImagePoint = Center(image.Size)

Select Case a
Case HorizontalAlignment.Left
G.DrawImage(image, x, DrawImagePoint.Y + y, image.Width, image.Height)
Case HorizontalAlignment.Center
G.DrawImage(image, DrawImagePoint.X + x, DrawImagePoint.Y + y, image.Width, image.Height)
Case HorizontalAlignment.Right
G.DrawImage(image, Width - image.Width - x, DrawImagePoint.Y + y, image.Width, image.Height)
End Select
End Sub

Protected Sub DrawImage(ByVal p1 As Point)
DrawImage(_Image, p1.X, p1.Y)
End Sub
Protected Sub DrawImage(ByVal x As Integer, ByVal y As Integer)
DrawImage(_Image, x, y)
End Sub

Protected Sub DrawImage(ByVal image As Image, ByVal p1 As Point)
DrawImage(image, p1.X, p1.Y)
End Sub
Protected Sub DrawImage(ByVal image As Image, ByVal x As Integer, ByVal y As Integer)
If image Is Nothing Then Return
G.DrawImage(image, x, y, image.Width, image.Height)
End Sub

#End Region

#Region " DrawGradient "

Private DrawGradientBrush As LinearGradientBrush
Private DrawGradientRectangle As Rectangle

Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(blend, DrawGradientRectangle)
End Sub
Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal angle As Single)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(blend, DrawGradientRectangle, angle)
End Sub

Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal r As Rectangle)
DrawGradientBrush = New LinearGradientBrush(r, Color.Empty, Color.Empty, 90.0F)
DrawGradientBrush.InterpolationColors = blend
G.FillRectangle(DrawGradientBrush, r)
End Sub
Protected Sub DrawGradient(ByVal blend As ColorBlend, ByVal r As Rectangle, ByVal angle As Single)
DrawGradientBrush = New LinearGradientBrush(r, Color.Empty, Color.Empty, angle)
DrawGradientBrush.InterpolationColors = blend
G.FillRectangle(DrawGradientBrush, r)
End Sub


Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(c1, c2, DrawGradientRectangle)
End Sub
Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal angle As Single)
DrawGradientRectangle = New Rectangle(x, y, width, height)
DrawGradient(c1, c2, DrawGradientRectangle, angle)
End Sub

Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle)
DrawGradientBrush = New LinearGradientBrush(r, c1, c2, 90.0F)
G.FillRectangle(DrawGradientBrush, r)
End Sub
Protected Sub DrawGradient(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle, ByVal angle As Single)
DrawGradientBrush = New LinearGradientBrush(r, c1, c2, angle)
G.FillRectangle(DrawGradientBrush, r)
End Sub

#End Region

#Region " DrawRadial "

Private DrawRadialPath As GraphicsPath
Private DrawRadialBrush1 As PathGradientBrush
Private DrawRadialBrush2 As LinearGradientBrush
Private DrawRadialRectangle As Rectangle

Sub DrawRadial(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(blend, DrawRadialRectangle, width \ 2, height \ 2)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal center As Point)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(blend, DrawRadialRectangle, center.X, center.Y)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal cx As Integer, ByVal cy As Integer)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(blend, DrawRadialRectangle, cx, cy)
End Sub

Sub DrawRadial(ByVal blend As ColorBlend, ByVal r As Rectangle)
DrawRadial(blend, r, r.Width \ 2, r.Height \ 2)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal r As Rectangle, ByVal center As Point)
DrawRadial(blend, r, center.X, center.Y)
End Sub
Sub DrawRadial(ByVal blend As ColorBlend, ByVal r As Rectangle, ByVal cx As Integer, ByVal cy As Integer)
DrawRadialPath.Reset()
DrawRadialPath.AddEllipse(r.X, r.Y, r.Width - 1, r.Height - 1)

DrawRadialBrush1 = New PathGradientBrush(DrawRadialPath)
DrawRadialBrush1.CenterPoint = New Point(r.X + cx, r.Y + cy)
DrawRadialBrush1.InterpolationColors = blend

If G.SmoothingMode = SmoothingMode.AntiAlias Then
G.FillEllipse(DrawRadialBrush1, r.X + 1, r.Y + 1, r.Width - 3, r.Height - 3)
Else
G.FillEllipse(DrawRadialBrush1, r)
End If
End Sub


Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(c1, c2, DrawRadialRectangle)
End Sub
Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal angle As Single)
DrawRadialRectangle = New Rectangle(x, y, width, height)
DrawRadial(c1, c2, DrawRadialRectangle, angle)
End Sub

Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle)
DrawRadialBrush2 = New LinearGradientBrush(r, c1, c2, 90.0F)
G.FillEllipse(DrawRadialBrush2, r)
End Sub
Protected Sub DrawRadial(ByVal c1 As Color, ByVal c2 As Color, ByVal r As Rectangle, ByVal angle As Single)
DrawRadialBrush2 = New LinearGradientBrush(r, c1, c2, angle)
G.FillEllipse(DrawRadialBrush2, r)
End Sub

#End Region

#Region " CreateRound "

Private CreateRoundPath As GraphicsPath
Private CreateRoundRectangle As Rectangle

Function CreateRound(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal slope As Integer) As GraphicsPath
CreateRoundRectangle = New Rectangle(x, y, width, height)
Return CreateRound(CreateRoundRectangle, slope)
End Function

Function CreateRound(ByVal r As Rectangle, ByVal slope As Integer) As GraphicsPath
CreateRoundPath = New GraphicsPath(FillMode.Winding)
CreateRoundPath.AddArc(r.X, r.Y, slope, slope, 180.0F, 90.0F)
CreateRoundPath.AddArc(r.Right - slope, r.Y, slope, slope, 270.0F, 90.0F)
CreateRoundPath.AddArc(r.Right - slope, r.Bottom - slope, slope, slope, 0.0F, 90.0F)
CreateRoundPath.AddArc(r.X, r.Bottom - slope, slope, slope, 90.0F, 90.0F)
CreateRoundPath.CloseFigure()
Return CreateRoundPath
End Function

#End Region

End Class

Module ThemeShare

#Region " Animation "

Private Frames As Integer
Private Invalidate As Boolean
Public ThemeTimer As New PrecisionTimer

Private Const FPS As Integer = 50 '1000 / 50 = 20 FPS
Private Const Rate As Integer = 10

Public Delegate Sub AnimationDelegate(ByVal invalidate As Boolean)

Private Callbacks As New List(Of AnimationDelegate)

Private Sub HandleCallbacks(ByVal state As IntPtr, ByVal reserve As Boolean)
Invalidate = (Frames >= FPS)
If Invalidate Then Frames = 0

SyncLock Callbacks
For I As Integer = 0 To Callbacks.Count - 1
Callbacks(I).Invoke(Invalidate)
Next
End SyncLock

Frames += Rate
End Sub

Private Sub InvalidateThemeTimer()
If Callbacks.Count = 0 Then
ThemeTimer.Delete()
Else
ThemeTimer.Create(0, Rate, AddressOf HandleCallbacks)
End If
End Sub

Sub AddAnimationCallback(ByVal callback As AnimationDelegate)
SyncLock Callbacks
If Callbacks.Contains(callback) Then Return

Callbacks.Add(callback)
InvalidateThemeTimer()
End SyncLock
End Sub

Sub RemoveAnimationCallback(ByVal callback As AnimationDelegate)
SyncLock Callbacks
If Not Callbacks.Contains(callback) Then Return

Callbacks.Remove(callback)
InvalidateThemeTimer()
End SyncLock
End Sub

#End Region

End Module

Enum MouseState As Byte
None = 0
Over = 1
Down = 2
Block = 3
End Enum

Structure Bloom

Public _Name As String
ReadOnly Property Name() As String
Get
Return _Name
End Get
End Property

Private _Value As Color
Property Value() As Color
Get
Return _Value
End Get
Set(ByVal value As Color)
_Value = value
End Set
End Property

Property ValueHex() As String
Get
Return String.Concat("#", _
_Value.R.ToString("X2", Nothing), _
_Value.G.ToString("X2", Nothing), _
_Value.B.ToString("X2", Nothing))
End Get
Set(ByVal value As String)
Try
_Value = ColorTranslator.FromHtml(value)
Catch
Return
End Try
End Set
End Property


Sub New(ByVal name As String, ByVal value As Color)
_Name = name
_Value = value
End Sub
End Structure

'------------------
'Creator: aeonhack
'Site: elitevs.net
'Created: 11/30/2011
'Changed: 11/30/2011
'Version: 1.0.0
'------------------
Class PrecisionTimer
Implements IDisposable

Private _Enabled As Boolean
ReadOnly Property Enabled() As Boolean
Get
Return _Enabled
End Get
End Property

Private Handle As IntPtr
Private TimerCallback As TimerDelegate

<DllImport("kernel32.dll", EntryPoint:="CreateTimerQueueTimer")> _
Private Shared Function CreateTimerQueueTimer( _
ByRef handle As IntPtr, _
ByVal queue As IntPtr, _
ByVal callback As TimerDelegate, _
ByVal state As IntPtr, _
ByVal dueTime As UInteger, _
ByVal period As UInteger, _
ByVal flags As UInteger) As Boolean
End Function

<DllImport("kernel32.dll", EntryPoint:="DeleteTimerQueueTimer")> _
Private Shared Function DeleteTimerQueueTimer( _
ByVal queue As IntPtr, _
ByVal handle As IntPtr, _
ByVal callback As IntPtr) As Boolean
End Function

Delegate Sub TimerDelegate(ByVal r1 As IntPtr, ByVal r2 As Boolean)

Sub Create(ByVal dueTime As UInteger, ByVal period As UInteger, ByVal callback As TimerDelegate)
If _Enabled Then Return

TimerCallback = callback
Dim Success As Boolean = CreateTimerQueueTimer(Handle, IntPtr.Zero, TimerCallback, IntPtr.Zero, dueTime, period, 0)

If Not Success Then ThrowNewException("CreateTimerQueueTimer")
_Enabled = Success
End Sub

Sub Delete()
If Not _Enabled Then Return
Dim Success As Boolean = DeleteTimerQueueTimer(IntPtr.Zero, Handle, IntPtr.Zero)

If Not Success AndAlso Not Marshal.GetLastWin32Error = 997 Then
ThrowNewException("DeleteTimerQueueTimer")
End If

_Enabled = Not Success
End Sub

Private Sub ThrowNewException(ByVal name As String)
Throw New Exception(String.Format("{0} failed. Win32Error: {1}", name, Marshal.GetLastWin32Error))
End Sub

Public Sub Dispose() Implements IDisposable.Dispose
Delete()
End Sub
End Class

Ensuite il vous faut Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris! ou autre version.

II.Tutoriel​

Commencez par crée un nouveau projet.
Ensuite: Ajoutez une nouvelle classe avec le nom de votre thème.
Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris!
Ensuite on va allez un peu plus de haut que "Public Class1"
Et on va mettre #Region "ThemeBase" et un EndRegion pour éviter qu'il nous gène.
Ensuite on colle le theme base 1.5.4 dans le #Region "ThemeBase"

Après on va mettre "Class lenomdevotrethème" ainsi que Inherits ThemeContainer154 en dessous, ça va nous servir à crée le thème de la form. Vous faites entrez et vous avez:

Protected Overrides Sub ColorHook()

End Sub

Protected Overrides Sub PaintHook()

End Sub

Qui s'ajoute, vous allez une ligne en dessous de Inherits ThemeContainer154 et vous mettez Sub New() et End Sub
Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris!
On va mettre dans Sub New()

TransparencyKey = Color.Fuchsia
BackColor = Color.Gray
Font = New Font("Verdana", 10)
SetColor("Border", Color.Black)
SetColor("Text", Color.White)

BackColor = le fond de la form.
Font = L'écriture.
SetColor("Border") = On dit la couleur des bordure.
SetColor("Text") = On dit la couleur de texte.
Ensuite après le EndSub on met:

Dim Border As Color
Dim TextBrush As Brush

Border = On dit que border est une couleur
TextBrush = On dit que textbrush est Brush

Dans Protected Overrides Sub ColorHook() On va mettre:

Border = GetColor("Border")
TextBrush = GetBrush("Text")

Border = GetColor("Border") = on dit que Border va avoir la même couleur que = SetColor("Border")
TextBrush = GetBrush("Text") = on dit que textbrush va avoir la même couleur que = SetColor("Text")

Ensuite dans Protected Overrides Sub PaintHook() on va mettre:

G.Clear(BackColor)
G.FillRectangle(New SolidBrush(BackColor), New Rectangle(0, 0, Width - 1, Height - 1))
G.FillRectangle(New SolidBrush(BackColor), New Rectangle(6, 36, Width - 13, Height - 43))
G.DrawString(FindForm.Text, Font, TextBrush, New Point(30, 10))
G.DrawIcon(FindForm.Icon, New Rectangle(10, 10, 16, 16))
DrawCorners(Color.Fuchsia)

G.Clear = On enleve la couleur de fond
G.FillRectangle = On fait un rectangle avec les dimensions et les couleurs.
G.DrawString = Ici on va avoir le texte de la Form
G.DrawIcon = On va mettre l'icon de la Form à la location (10, 10, 16, 16)
DrawCorners = On fait des coins arrondis.
Maintenant on génére et comme par hasard ! Dans votre boite à outils il va y avoir le nom de votre thème.
Petit screen du thème qu'on a fait:
Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris!
Et voilà ! Le thème de la form est fini. Passons au Button.

Button​

Pareil: Class tutoButton et Inherits ThemeContainer154. Pareil que thème mais les codes vont changer !
En dessous de Inherits ThemeContainer154, on va mettre:

Dim ButtonColorTop, ButtonColorBottom As Color
Dim TextColor As Brush
Dim Border As Pen

Pas la peine d'expliquer, il vous suffit de connaitre un peu l'anglais.
On va mettre un Sub New()
Et:

SetColor("Button Top", Color.Orange)
SetColor("Button Bottom", Color.Gray)
SetColor("Text", Color.WhiteSmoke)
SetColor("Border", Color.WhiteSmoke)

Dedans.

Dans Protected Overrides Sub ColorHook() on va mettre:

ButtonColorTop = GetColor("Button Top")
ButtonColorBottom = GetColor("Button Bottom")
TextColor = GetBrush("Text")
Border = GetPen("Border")

Bon, ensuite dans Protected Overrides Sub PaintHook() on va mettre:

G.Clear(ButtonColorTop)
Select Case State
Case MouseState.None
Dim LGB As New LinearGradientBrush(New Rectangle(0, 0, Width - 1, Height - 1), Color.DarkOrange, ButtonColorTop, 90.0F)
G.FillRectangle(LGB, New Rectangle(0, 0, Width - 1, Height - 1))
G.DrawRectangle(Border, New Rectangle(0, 0, Width - 1, Height - 1))
DrawText(TextColor, HorizontalAlignment.Center, 0, 0)
DrawCorners(Color.Gray)
Case MouseState.Over
G.FillRectangle(New SolidBrush(Color.FromArgb(50, Color.LightGray)), New Rectangle(0, 0, Width - 1, Height - 1))
G.DrawRectangle(Border, New Rectangle(0, 0, Width - 1, Height - 1))
DrawText(TextColor, HorizontalAlignment.Center, 0, 0)
DrawCorners(Color.Gray)
Case MouseState.Down
G.FillRectangle(New SolidBrush(Color.FromArgb(50, Color.Black)), New Rectangle(0, 0, Width - 1, Height - 1))
G.DrawRectangle(Border, New Rectangle(0, 0, Width - 1, Height - 1))
DrawText(TextColor, HorizontalAlignment.Center, 0, 0)
DrawCorners(Color.Gray)
End Select

Je pense pas que vous allez pas tout comprendre donc je vais expliquer.
G.Clear = On enleve la couleur ButtonColorTop
Mousestate.none = si la souris n'est pas sur le button
MousteState.over = Si la souris passe dessus
MousteState.down = Si la souris clique dessus
Dim LGB As New LinearGradientBrush(New Rectangle(0, 0, Width - 1, Height - 1), Color.DarkOrange, ButtonColorTop, 90.0F) = On dit que LGB est un nouveau LinearGradientBrush avec un nouveau rectangle avec les dimensions et les couleurs.
G.FillRectangle(LGB, New Rectangle(0, 0, Width - 1, Height - 1)) = On dit qu'on remplile rectangle LinearGradientBrush(LGB).
G.Drawrectangle = on dit qu'on dessine un nouveau rectangle
DrawText = on écrit un nouveau text
DrawCorners = on fait des bouts arrondis.
Et voilà le button est finis ! Courage c'est pas fini :lol:. Il nous reste donc: La GroupBox, le RadioButton, la CheckBox, la ProgressBar, la TextBox
Petit screen du button:
Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris!

GroupBox​

HyperSimple :lol:
Bon bah, vous connaissez le poème. Class tutoGroupBox
Et Inherits ThemeContainer154. Ainsi que Sub New()
Dans Sub New() on va mettre:

ControlMode = True
SetColor("Border", Color.Black)
SetColor("Header", Color.Orange)
SetColor("Text", Color.White)

Et en dessous de EndSub on va mettre:

Dim border As Pen
Dim HeaderColor, textcolor As Brush

Très simple à comprendre.
Dans Protected Overrides Sub ColorHook() on va mettre:

border = GetPen("Border")
HeaderColor = GetBrush("Header")
textcolor = GetBrush("Text")

head = la couleur du haut de la GB
Dans Protected Overrides Sub PaintHook() on va mettre:

G.Clear(BackColor)
G.FillRectangle(HeaderColor, New Rectangle(0, 0, Width - 1, 25))
G.DrawRectangle(border, New Rectangle(0, 0, Width - 1, 25))
G.DrawRectangle(border, New Rectangle(0, 0, Width - 1, Height - 1))
G.DrawString(Text, Font, textcolor, New Point(7, 5))

On dessine le rectangle de la GroupBox.
Bon bah il nous reste pas mal de chose !
Petit screen de la GroupBox:
Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris!

RadioButton​

Et encors le même poème...
Class tutoRadioButton et Inherits ThemeControl154.
On va mettre:

Private _Checked As Boolean
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(ByVal V As Boolean)
_Checked = V
Invalidate()
End Set
End Property

On va mettre la function Checked.
On va mettre aussi:

Protected Overrides Sub OnClick(ByVal e As System.EventArgs)
MyBase.OnClick(e)
For Each C As Control In Parent.Controls
If C.GetType.ToString = Replace(My.Application.Info.ProductName, " ", "_") & ".cg3RadioButton" Then
Dim CC As cg3RadioButton
CC = C
CC.Checked = False
Else

End If
Next
_Checked = True
End Sub

La function quand on clique sur le radiobutton.
Dans Protected Overrides Sub ColorHook() on met rien mais en dessous on va mettre:

Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
MyBase.OnTextChanged(e)
Dim textSize As Integer
textSize = Me.CreateGraphics.MeasureString(Text, Font).Width
Me.Width = 20 + textSize
End Sub

Ici OnTextChanged, quand le texte a changé.
Dans Protected Overrides Sub PaintHook() on va mettre:

G.Clear(BackColor)
Dim LGB As New LinearGradientBrush(New Rectangle(1, 1, 16, 16), Color.FromArgb(50, Color.White), Color.FromArgb(50, Color.White), 90.0F)
G.SmoothingMode = SmoothingMode.AntiAlias
G.FillEllipse(LGB, 1, 1, 15, 15)
G.DrawEllipse(New Pen(Color.Gray), 0, 0, 16, 16)

If (_Checked) Then
G.FillEllipse(LGB, 4, 4, 8, 8)
G.FillEllipse(New SolidBrush(Color.Orange), 4, 4, 8, 8)
End If

G.DrawString(Text, Font, Brushes.Orange, 18, 2)

Rien à expliquer, simple à comprendre.
Ensuite en dessous de sa, on va mettre:

Public Sub New()
Me.Size = New Point(100, 17)
End Sub

CheckBox​

Bon, la ça va changer !
on va mettre:

<DefaultEvent("CheckedChanged")> _

et en dessous Class tutoCheckBox
et Inherits ThemeControl154.
Un Sub New()
Ainsi que:

LockHeight = 20
Width = 120
SetColor("Text", Color.Orange)
SetColor("Backcolor", Color.Gray)
Font = New Font("Verdana", 8)

En dessous on va mettre 2 private.

Private X As Integer
Private TextColor, BG As Color

Dans Protected Overrides Sub ColorHook() on va insérer:

TextColor = GetColor("Text")
BG = GetColor("Backcolor")

En dessous on va mettre:

Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseMove(e)
X = e.Location.X
Invalidate()
End Sub

Dans Protected Overrides Sub PaintHook() on va mettre le design:

G.Clear(BG)
If _Checked Then
G.FillRectangle(New SolidBrush(Color.FromArgb(153, 153, 153)), New Rectangle(0, 0, 16, 16))
G.FillRectangle(New SolidBrush(Color.FromArgb(153, 153, 153)), New Rectangle(0, 0, 20 - 2, 20 - 2))
Else
G.FillRectangle(New SolidBrush(Color.FromArgb(153, 153, 153)), New Rectangle(0, 0, 16, 16))
G.FillRectangle(New SolidBrush(Color.FromArgb(153, 153, 153)), New Rectangle(0, 0, 20 - 2, 20 - 2))
End If

If State = MouseState.Over And X < 15 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(153, 153, 153)), New Rectangle(0, 0, 16, 16))
G.FillRectangle(New SolidBrush(Color.LightGray), New Rectangle(0, 0, 20 - 2, 20 - 2))
ElseIf State = MouseState.Down And X < 15 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(153, 153, 153)), New Rectangle(0, 0, 16, 16))
G.FillRectangle(New SolidBrush(Color.LightGray), New Rectangle(0, 0, 20 - 2, 20 - 2))
End If

If _Checked Then G.DrawString("a", New Font("Marlett", 20), New SolidBrush(Color.Orange), New Point(-7, -5))
DrawText(New SolidBrush(TextColor), HorizontalAlignment.Left, 25, 0)

Ainsi que les checkeds:

Private _Checked As Boolean
Property Checked() As Boolean
Get
Return _Checked
End Get
Set(ByVal value As Boolean)
_Checked = value
Invalidate()
End Set
End Property

Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
_Checked = Not _Checked
RaiseEvent CheckedChanged(Me)
MyBase.OnMouseDown(e)
End Sub

Event CheckedChanged(ByVal sender As Object)

ControlBox​

On est déjà rendu là ? oO
Bon alors la ControlBox sere à quoi ?
Elle a un button Minimize, Un button Maximize, un button close.
Bon alors, Class tutoControlBox
Ainsi que Inherits ThemeControl154.
En dessous on va mettre:

Private X As Integer
Dim BG, Edge As Color
Dim BEdge As Pen

Dans Protected Overrides Sub ColorHook() on va mettre:

BG = GetColor("Background")
Edge = GetColor("Edge color")
BEdge = New Pen(GetColor("Button edge color"))

Ainsi qu'un petit Sub New():

Sub New()
SetColor("Background", Color.Gray)
SetColor("Edge color", Color.Gray)
SetColor("Button edge color", Color.Gray)
Me.Size = New Size(71, 19)
Me.Anchor = AnchorStyles.Top Or AnchorStyles.Right
End Sub

On va mettre un autre Protected Overrides:

Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseMove(e)
X = e.X
Invalidate()
End Sub

On va mettre un Protected Overrides OnClick:

Protected Overrides Sub OnClick(e As System.EventArgs)
MyBase.OnClick(e)
If X <= 22 Then
FindForm.WindowState = FormWindowState.Minimized
ElseIf X > 22 And X <= 44 Then
If FindForm.WindowState <> FormWindowState.Maximized Then FindForm.WindowState = FormWindowState.Maximized Else FindForm.WindowState = FormWindowState.Normal
ElseIf X > 44 Then
FindForm.Close()
End If
End Sub

Ensuite dans Protected Overrides Sub PaintHook() On va rajouter ce code:

G.Clear(BackColor)
G.FillRectangle(New SolidBrush(BackColor), New Rectangle(0, 0, Width - 1, Height - 1))
G.DrawString("0", New Font("Marlett", 8.25), Brushes.Orange, New Point(5, 5))
If FindForm.WindowState <> FormWindowState.Maximized Then G.DrawString("1", New Font("Marlett", 8.25), Brushes.Orange, New Point(27, 4)) Else G.DrawString("2", New Font("Marlett", 8.25), Brushes.Orange, New Point(27, 4))
G.DrawString("r", New Font("Marlett", 10), Brushes.Orange, New Point(49, 3))
G.DrawRectangle(BEdge, New Rectangle(New Point(1, 1), New Size(20, 16)))
G.DrawRectangle(BEdge, New Rectangle(New Point(23, 1), New Size(20, 16)))
G.DrawRectangle(BEdge, New Rectangle(New Point(45, 1), New Size(24, 16)))

'Mouse states
Select Case State
Case MouseState.Over
If X <= 22 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(40, Color.White)), New Rectangle(New Point(1, 1), New Size(21, Height - 2)))
ElseIf X > 22 And X <= 44 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(40, Color.White)), New Rectangle(New Point(23, 1), New Size(21, Height - 2)))
ElseIf X > 44 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(40, Color.White)), New Rectangle(New Point(45, 1), New Size(25, Height - 2)))
End If
Case MouseState.Down
If X <= 22 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(20, Color.Black)), New Rectangle(New Point(1, 1), New Size(21, Height - 2)))
ElseIf X > 22 And X <= 44 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(20, Color.Black)), New Rectangle(New Point(23, 1), New Size(21, Height - 2)))
ElseIf X > 44 Then
G.FillRectangle(New SolidBrush(Color.FromArgb(20, Color.Black)), New Rectangle(New Point(45, 1), New Size(25, Height - 2)))
End If
End Select

Et voilà ! La ControlBox est finis ! Passons à la progressbar... Courage il reste La progressbar et La TextBox.

ProgressBar​

Bon vous connaissez ! Class tutoProgressBar ainsi que Inherits ThemeControl154
On va mettre un Private Maximum pour dire la maximum value de la progressbar.

Private _Maximum As Integer = 100

Ensuite on va mettre la property maximum:

Public Property Maximum() As Integer
Get
Return _Maximum
End Get
Set(ByVal value As Integer)
If value < 1 Then value = 0
If value < _Value Then _Value = value
_Maximum = value
Invalidate()
End Set
End Property

Maintenant on va mettre la property de value de la ProgressBar:

Private _Value As Integer = 0
Public Property Value() As Integer
Get
Return _Value
End Get
Set(ByVal value As Integer)
If value > _Maximum Then value = _Maximum
If value < 1 Then value = 0
_Value = value
Invalidate()
End Set
End Property

Dans Protected Overrides Sub ColorHook() On met rien par contre ! Dans Protected Overrides Sub PaintHook() on va mettre:

G.Clear(Color.Gray)
If (_Value > 0) Then
DrawGradient(Color.Orange, Color.Gray, 0, 0, CInt((_Value / _Maximum) * Width), Height, 90S)
End If
G.DrawRectangle(Pens.LightGray, 0, 0, Width - 1, Height - 1)
DrawBorders(Pens.White)
DrawCorners(BackColor, ClientRectangle)

:OMG: on a déjà finis la ProgressBar ! Et oui on a déjà fini.
Passons à la TextBox. :eek:

TextBox​

Bon, bah Class tutoTextbox ainsi que Inherits ThemeControl154
Maintenant on va mettre la property TextAlign:

Private _TextAlign As HorizontalAlignment = HorizontalAlignment.Left
Property TextAlign() As HorizontalAlignment
Get
Return _TextAlign
End Get
Set(ByVal value As HorizontalAlignment)
_TextAlign = value
If Base IsNot Nothing Then
Base.TextAlign = value
End If
End Set
End Property

On met ainsi la property de MaxLength:

Private _MaxLength As Integer = 32767
Property MaxLength() As Integer
Get
Return _MaxLength
End Get
Set(ByVal value As Integer)
_MaxLength = value
If Base IsNot Nothing Then
Base.MaxLength = value
End If
End Set
End Property

On met aussi la property de ReadOnly(Cette property sere à ce que quand le ReadOnly est true, on ne pas écrire dedans):

Private _ReadOnly As Boolean
Property [ReadOnly]() As Boolean
Get
Return _ReadOnly
End Get
Set(ByVal value As Boolean)
_ReadOnly = value
If Base IsNot Nothing Then
Base.ReadOnly = value
End If
End Set
End Property

On met après le UseSystemPasswordChar(•):

Private _UseSystemPasswordChar As Boolean
Property UseSystemPasswordChar() As Boolean
Get
Return _UseSystemPasswordChar
End Get
Set(ByVal value As Boolean)
_UseSystemPasswordChar = value
If Base IsNot Nothing Then
Base.UseSystemPasswordChar = value
End If
End Set
End Property

Un qui est très important ! Le multiline:

Private _Multiline As Boolean
Property Multiline() As Boolean
Get
Return _Multiline
End Get
Set(ByVal value As Boolean)
_Multiline = value
If Base IsNot Nothing Then
Base.Multiline = value

If value Then
LockHeight = 0
Base.Height = Height - 11
Else
LockHeight = Base.Height + 11
End If
End If
End Set
End Property

On va mettre un Overrides Property Text:

Overrides Property Text() As String
Get
Return MyBase.Text
End Get
Set(ByVal value As String)
MyBase.Text = value
If Base IsNot Nothing Then
Base.Text = value
End If
End Set
End Property

Ainsi que le Font:

Overrides Property Font() As Font
Get
Return MyBase.Font
End Get
Set(ByVal value As Font)
MyBase.Font = value
If Base IsNot Nothing Then
Base.Font = value
Base.Location = New Point(3, 5)
Base.Width = Width - 6

If Not _Multiline Then
LockHeight = Base.Height + 11
End If
End If
End Set
End Property

Le OnCreation:

Protected Overrides Sub OnCreation()
If Not Controls.Contains(Base) Then
Controls.Add(Base)
End If
End Sub

On met un private base as textbox:

Private Base As TextBox

Après on a besoin d'un Sub New() avec ces codes:

Base = New TextBox

Base.Font = Font
Base.Text = Text
Base.MaxLength = _MaxLength
Base.Multiline = _Multiline
Base.ReadOnly = _ReadOnly
Base.UseSystemPasswordChar = _UseSystemPasswordChar

Base.BorderStyle = BorderStyle.None

Base.Location = New Point(5, 5)
Base.Width = Width - 10

If _Multiline Then
Base.Height = Height - 11
Else
LockHeight = Base.Height + 11
End If

AddHandler Base.TextChanged, AddressOf OnBaseTextChanged
AddHandler Base.KeyDown, AddressOf OnBaseKeyDown


SetColor("Text", Color.White)
SetColor("Back", 123, 123, 123)
SetColor("Border1", Color.White)
SetColor("Border2", Color.Transparent)

Après on met encore des privates:

Private C1 As Color
Private P1, P2 As Pen

Dans Protected Overrides Sub ColorHook() on aura besoin de sa:

C1 = GetColor("Back")

P1 = GetPen("Border1")
P2 = GetPen("Border2")

Base.ForeColor = GetColor("Text")
Base.BackColor = C1

Ensuite dans Protected Overrides Sub PaintHook() on va mettre:

G.Clear(C1)

DrawBorders(P1, 1)
DrawBorders(P2)
End Sub
Private Sub OnBaseTextChanged(ByVal s As Object, ByVal e As EventArgs)
Text = Base.Text
End Sub
Private Sub OnBaseKeyDown(ByVal s As Object, ByVal e As KeyEventArgs)
If e.Control AndAlso e.KeyCode = Keys.A Then
Base.SelectAll()
e.SuppressKeyPress = True
End If
End Sub
Protected Overrides Sub OnResize(ByVal e As EventArgs)
Base.Location = New Point(5, 5)
Base.Width = Width - 10

If _Multiline Then
Base.Height = Height - 11
End If


MyBase.OnResize(e)

Et puis le tutoriel est terminé !!!

Code Final

Lis le tutoriel.

Le tutoriel de ce thème est le thème que j'ai crée dans converter+pumper: Ici
:bye:
J'ai mis beaucoup de temps à faire ce tuto(1heure/1heure30).
Désolé si vous trouvez que c'est mal expliqué ! Mais bon, aumoin j'ai fais un tuto sur comment créer un thème en VB.NET, c'est déjà sa !
:bye::bye::bye::bye::bye::bye::bye::bye::bye:
Un petit screen du thème: Ce lien n'est pas visible, veuillez vous connecter pour l'afficher. Je m'inscris!

 

[Evaelis]

Tu devrais mettre le code dans un pastebin car c'est assez long de le copier

 

[Membre supprimé 245833]

Tu devrais mettre le code dans un pastebin car c'est assez long de le copier

C'est mieux comme j'ai fais car j'explique un peu chaque bout de code. Tu parlais ptet de Theme Base v1.5.4 ?

 

[Evaelis]

Oué je parlais de Theme base (D'ailleurs au passage, moi mes thèmes je les ais jamais fait avec theme base, faudrait que je jette un oeil pour voir ce qu'il contient)

 

[Membre supprimé 245833]

Oué je parlais de Theme base (D'ailleurs au passage, moi mes thèmes je les ais jamais fait avec theme base, faudrait que je jette un oeil pour voir ce qu'il contient)

Ah ? Tu as jamais fais avec Theme Base ? J'ai déjà vu des thèmes sans ThemeBase, et la plupart on des erreurs :lol:

 

[Evaelis]

Ah ? Tu as jamais fais avec Theme Base ? J'ai déjà vu des thèmes sans ThemeBase, et la plupart on des erreurs :lol:

On ne dois pas avoir les mêmes sources ^^