yoannmultigaming/CLM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
CLM/Chrome.vb
T
yoannmultigaming fbea6e53ae first commit
2026-06-18 14:03:08 +02:00

2506 lines
87 KiB
VB.net
Raw Permalink Blame History

#Region "ThemeBase"
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
If Not New Rectangle(Width - 22, 5, 15, 15).Contains(e.Location) Then
Capture = False
End If
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
#End Region
Class ChromeThemeContainer
Inherits ThemeContainer154
Sub New()
TransparencyKey = Color.Fuchsia
BackColor = Color.White
Font = New Font("Segoe UI", 9)
SetColor("Title color", Color.Black)
SetColor("X-color", 90, 90, 90)
SetColor("X-ellipse", 114, 114, 114)
End Sub
Dim TitleColor, Xcolor, Xellipse As Color
Protected Overrides Sub ColorHook()
TitleColor = GetColor("Title color")
Xcolor = GetColor("X-color")
Xellipse = GetColor("X-ellipse")
End Sub
Dim X, Y As Integer
Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
X = e.Location.X : Y = e.Location.Y
MyBase.OnMouseMove(e)
Invalidate()
End Sub
Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
If New Rectangle(Width - 22, 5, 15, 15).Contains(New Point(X, Y)) Then
FindForm.Close()
End If
MyBase.OnMouseClick(e)
End Sub
Protected Overrides Sub PaintHook()
G.Clear(BackColor)
DrawCorners(Color.Fuchsia)
DrawCorners(Color.Fuchsia, 1, 0, Width - 2, Height)
DrawCorners(Color.Fuchsia, 0, 1, Width, Height - 2)
DrawCorners(Color.Fuchsia, 2, 0, Width - 4, Height)
DrawCorners(Color.Fuchsia, 0, 2, Width, Height - 4)
G.SmoothingMode = SmoothingMode.HighQuality
If New Rectangle(Width - 22, 5, 15, 15).Contains(New Point(X, Y)) Then
G.FillEllipse(New SolidBrush(Xellipse), New Rectangle(Width - 24, 6, 16, 16))
G.DrawString("r", New Font("Webdings", 8), New SolidBrush(BackColor), New Point(Width - 23, 5))
Else
G.DrawString("r", New Font("Webdings", 8), New SolidBrush(Xcolor), New Point(Width - 23, 5))
End If
DrawText(New SolidBrush(TitleColor), New Point(8, 7))
End Sub
End Class
Class ChromeButton
Inherits ThemeControl154
Sub New()
Font = New Font("Segoe UI", 9)
SetColor("Gradient top normal", 237, 237, 237)
SetColor("Gradient top over", 242, 242, 242)
SetColor("Gradient top down", 235, 235, 235)
SetColor("Gradient bottom normal", 230, 230, 230)
SetColor("Gradient bottom over", 235, 235, 235)
SetColor("Gradient bottom down", 223, 223, 223)
SetColor("Border", 167, 167, 167)
SetColor("Text normal", 60, 60, 60)
SetColor("Text down/over", 20, 20, 20)
SetColor("Text disabled", Color.Gray)
End Sub
Dim GTN, GTO, GTD, GBN, GBO, GBD, Bo, TN, TD, TDO As Color
Protected Overrides Sub ColorHook()
GTN = GetColor("Gradient top normal")
GTO = GetColor("Gradient top over")
GTD = GetColor("Gradient top down")
GBN = GetColor("Gradient bottom normal")
GBO = GetColor("Gradient bottom over")
GBD = GetColor("Gradient bottom down")
Bo = GetColor("Border")
TN = GetColor("Text normal")
TDO = GetColor("Text down/over")
TD = GetColor("Text disabled")
End Sub
Protected Overrides Sub PaintHook()
G.Clear(BackColor)
Dim LGB As LinearGradientBrush
G.SmoothingMode = SmoothingMode.HighQuality
Select Case State
Case MouseState.None
LGB = New LinearGradientBrush(New Rectangle(0, 0, Width - 1, Height - 1), GTN, GBN, 90.0F)
Case MouseState.Over
LGB = New LinearGradientBrush(New Rectangle(0, 0, Width - 1, Height - 1), GTO, GBO, 90.0F)
Case Else
LGB = New LinearGradientBrush(New Rectangle(0, 0, Width - 1, Height - 1), GTD, GBD, 90.0F)
End Select
If Not Enabled Then
LGB = New LinearGradientBrush(New Rectangle(0, 0, Width - 1, Height - 1), GTN, GBN, 90.0F)
End If
Dim buttonpath As GraphicsPath = CreateRound(Rectangle.Round(LGB.Rectangle), 3)
G.FillPath(LGB, CreateRound(Rectangle.Round(LGB.Rectangle), 3))
If Not Enabled Then G.FillPath(New SolidBrush(Color.FromArgb(50, Color.White)), CreateRound(Rectangle.Round(LGB.Rectangle), 3))
G.SetClip(buttonpath)
LGB = New LinearGradientBrush(New Rectangle(0, 0, Width, Height / 6), Color.FromArgb(80, Color.White), Color.Transparent, 90.0F)
G.FillRectangle(LGB, Rectangle.Round(LGB.Rectangle))
G.ResetClip()
G.DrawPath(New Pen(Bo), buttonpath)
If Enabled Then
Select Case State
Case MouseState.None
DrawText(New SolidBrush(TN), HorizontalAlignment.Center, 1, 0)
Case Else
DrawText(New SolidBrush(TDO), HorizontalAlignment.Center, 1, 0)
End Select
Else
DrawText(New SolidBrush(TD), HorizontalAlignment.Center, 1, 0)
End If
End Sub
End Class
Class ChromeCheckbox
Inherits ThemeControl154
Sub New()
LockHeight = 17
Font = New Font("Segoe UI", 9)
SetColor("Gradient top normal", 237, 237, 237)
SetColor("Gradient top over", 242, 242, 242)
SetColor("Gradient top down", 235, 235, 235)
SetColor("Gradient bottom normal", 230, 230, 230)
SetColor("Gradient bottom over", 235, 235, 235)
SetColor("Gradient bottom down", 223, 223, 223)
SetColor("Border", 167, 167, 167)
SetColor("Text", 60, 60, 60)
Width = 160
End Sub
Private X As Integer
Dim GTN, GTO, GTD, GBN, GBO, GBD, Bo, T As Color
Protected Overrides Sub ColorHook()
GTN = GetColor("Gradient top normal")
GTO = GetColor("Gradient top over")
GTD = GetColor("Gradient top down")
GBN = GetColor("Gradient bottom normal")
GBO = GetColor("Gradient bottom over")
GBD = GetColor("Gradient bottom down")
Bo = GetColor("Border")
T = GetColor("Text")
End Sub
Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseMove(e)
X = e.Location.X
Invalidate()
End Sub
Protected Overrides Sub PaintHook()
G.Clear(BackColor)
Dim LGB As LinearGradientBrush
G.SmoothingMode = SmoothingMode.HighQuality
Select Case State
Case MouseState.None
LGB = New LinearGradientBrush(New Rectangle(0, 0, 14, 14), GTN, GBN, 90.0F)
Case MouseState.Over
LGB = New LinearGradientBrush(New Rectangle(0, 0, 14, 14), GTO, GBO, 90.0F)
Case Else
LGB = New LinearGradientBrush(New Rectangle(0, 0, 14, 14), GTD, GBD, 90.0F)
End Select
Dim buttonpath As GraphicsPath = CreateRound(Rectangle.Round(LGB.Rectangle), 5)
G.FillPath(LGB, CreateRound(Rectangle.Round(LGB.Rectangle), 3))
G.SetClip(buttonpath)
LGB = New LinearGradientBrush(New Rectangle(0, 0, 14, 5), Color.FromArgb(150, Color.White), Color.Transparent, 90.0F)
G.FillRectangle(LGB, Rectangle.Round(LGB.Rectangle))
G.ResetClip()
G.DrawPath(New Pen(Bo), buttonpath)
DrawText(New SolidBrush(T), 17, -2)
If Checked Then
Dim check As Image = Image.FromStream(New System.IO.MemoryStream(Convert.FromBase64String("iVBORw0KGgoAAAANSUhEUgAAAAsAAAAJCAYAAADkZNYtAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAACHDwAAjA8AAP1SAACBQAAAfXkAAOmLAAA85QAAGcxzPIV3AAAKOWlDQ1BQaG90b3Nob3AgSUNDIHByb2ZpbGUAAEjHnZZ3VFTXFofPvXd6oc0wAlKG3rvAANJ7k15FYZgZYCgDDjM0sSGiAhFFRJoiSFDEgNFQJFZEsRAUVLAHJAgoMRhFVCxvRtaLrqy89/Ly++Osb+2z97n77L3PWhcAkqcvl5cGSwGQyhPwgzyc6RGRUXTsAIABHmCAKQBMVka6X7B7CBDJy82FniFyAl8EAfB6WLwCcNPQM4BOB/+fpFnpfIHomAARm7M5GSwRF4g4JUuQLrbPipgalyxmGCVmvihBEcuJOWGRDT77LLKjmNmpPLaIxTmns1PZYu4V8bZMIUfEiK+ICzO5nCwR3xKxRoowlSviN+LYVA4zAwAUSWwXcFiJIjYRMYkfEuQi4uUA4EgJX3HcVyzgZAvEl3JJS8/hcxMSBXQdli7d1NqaQffkZKVwBALDACYrmcln013SUtOZvBwAFu/8WTLi2tJFRbY0tba0NDQzMv2qUP91829K3NtFehn4uWcQrf+L7a/80hoAYMyJarPziy2uCoDOLQDI3fti0zgAgKSobx3Xv7oPTTwviQJBuo2xcVZWlhGXwzISF/QP/U+Hv6GvvmckPu6P8tBdOfFMYYqALq4bKy0lTcinZ6QzWRy64Z+H+B8H/nUeBkGceA6fwxNFhImmjMtLELWbx+YKuGk8Opf3n5r4D8P+pMW5FonS+BFQY4yA1HUqQH7tBygKESDR+8Vd/6NvvvgwIH554SqTi3P/7zf9Z8Gl4iWDm/A5ziUohM4S8jMX98TPEqABAUgCKpAHykAd6ABDYAasgC1wBG7AG/iDEBAJVgMWSASpgA+yQB7YBApBMdgJ9oBqUAcaQTNoBcdBJzgFzoNL4Bq4AW6D+2AUTIBnYBa8BgsQBGEhMkSB5CEVSBPSh8wgBmQPuUG+UBAUCcVCCRAPEkJ50GaoGCqDqqF6qBn6HjoJnYeuQIPQXWgMmoZ+h97BCEyCqbASrAUbwwzYCfaBQ+BVcAK8Bs6FC+AdcCXcAB+FO+Dz8DX4NjwKP4PnEIAQERqiihgiDMQF8UeikHiEj6xHipAKpAFpRbqRPuQmMorMIG9RGBQFRUcZomxRnqhQFAu1BrUeVYKqRh1GdaB6UTdRY6hZ1Ec0Ga2I1kfboL3QEegEdBa6EF2BbkK3oy+ib6Mn0K8xGAwNo42xwnhiIjFJmLWYEsw+TBvmHGYQM46Zw2Kx8lh9rB3WH8vECrCF2CrsUexZ7BB2AvsGR8Sp4Mxw7rgoHA+Xj6vAHcGdwQ3hJnELeCm8Jt4G749n43PwpfhGfDf+On4Cv0CQJmgT7AghhCTCJkIloZVwkfCA8JJIJKoRrYmBRC5xI7GSeIx4mThGfEuSIemRXEjRJCFpB+kQ6RzpLuklmUzWIjuSo8gC8g5yM/kC+RH5jQRFwkjCS4ItsUGiRqJDYkjiuSReUlPSSXK1ZK5kheQJyeuSM1J4KS0pFymm1HqpGqmTUiNSc9IUaVNpf+lU6RLpI9JXpKdksDJaMm4ybJkCmYMyF2TGKQhFneJCYVE2UxopFykTVAxVm+pFTaIWU7+jDlBnZWVkl8mGyWbL1sielh2lITQtmhcthVZKO04bpr1borTEaQlnyfYlrUuGlszLLZVzlOPIFcm1yd2WeydPl3eTT5bfJd8p/1ABpaCnEKiQpbBf4aLCzFLqUtulrKVFS48vvacIK+opBimuVTyo2K84p6Ss5KGUrlSldEFpRpmm7KicpFyufEZ5WoWiYq/CVSlXOavylC5Ld6Kn0CvpvfRZVUVVT1Whar3qgOqCmrZaqFq+WpvaQ3WCOkM9Xr1cvUd9VkNFw08jT6NF454mXpOhmai5V7NPc15LWytca6tWp9aUtpy2l3audov2Ax2yjoPOGp0GnVu6GF2GbrLuPt0berCehV6iXo3edX1Y31Kfq79Pf9AAbWBtwDNoMBgxJBk6GWYathiOGdGMfI3yjTqNnhtrGEcZ7zLuM/5oYmGSYtJoct9UxtTbNN+02/R3Mz0zllmN2S1zsrm7+QbzLvMXy/SXcZbtX3bHgmLhZ7HVosfig6WVJd+y1XLaSsMq1qrWaoRBZQQwShiXrdHWztYbrE9Zv7WxtBHYHLf5zdbQNtn2iO3Ucu3lnOWNy8ft1OyYdvV2o/Z0+1j7A/ajDqoOTIcGh8eO6o5sxybHSSddpySno07PnU2c+c7tzvMuNi7rXM65Iq4erkWuA24ybqFu1W6P3NXcE9xb3Gc9LDzWepzzRHv6eO7yHPFS8mJ5NXvNelt5r/Pu9SH5BPtU+zz21fPl+3b7wX7efrv9HqzQXMFb0ekP/L38d/s/DNAOWBPwYyAmMCCwJvBJkGlQXlBfMCU4JvhI8OsQ55DSkPuhOqHC0J4wybDosOaw+XDX8LLw0QjjiHUR1yIVIrmRXVHYqLCopqi5lW4r96yciLaILoweXqW9KnvVldUKq1NWn46RjGHGnIhFx4bHHol9z/RnNjDn4rziauNmWS6svaxnbEd2OXuaY8cp40zG28WXxU8l2CXsTphOdEisSJzhunCruS+SPJPqkuaT/ZMPJX9KCU9pS8Wlxqae5Mnwknm9acpp2WmD6frphemja2zW7Fkzy/fhN2VAGasyugRU0c9Uv1BHuEU4lmmfWZP5Jiss60S2dDYvuz9HL2d7zmSue+63a1FrWWt78lTzNuWNrXNaV78eWh+3vmeD+oaCDRMbPTYe3kTYlLzpp3yT/LL8V5vDN3cXKBVsLBjf4rGlpVCikF84stV2a9021DbutoHt5turtn8sYhddLTYprih+X8IqufqN6TeV33zaEb9joNSydP9OzE7ezuFdDrsOl0mX5ZaN7/bb3VFOLy8qf7UnZs+VimUVdXsJe4V7Ryt9K7uqNKp2Vr2vTqy+XeNc01arWLu9dn4fe9/Qfsf9rXVKdcV17w5wD9yp96jvaNBqqDiIOZh58EljWGPft4xvm5sUmoqbPhziHRo9HHS4t9mqufmI4pHSFrhF2DJ9NProje9cv+tqNWytb6O1FR8Dx4THnn4f+/3wcZ/jPScYJ1p/0Pyhtp3SXtQBdeR0zHYmdo52RXYNnvQ+2dNt293+o9GPh06pnqo5LXu69AzhTMGZT2dzz86dSz83cz7h/HhPTM/9CxEXbvUG9g5c9Ll4+ZL7pQt9Tn1nL9tdPnXF5srJq4yrndcsr3X0W/S3/2TxU/uA5UDHdavrXTesb3QPLh88M+QwdP6m681Lt7xuXbu94vbgcOjwnZHokdE77DtTd1PuvriXeW/h/sYH6AdFD6UeVjxSfNTws+7PbaOWo6fHXMf6Hwc/vj/OGn/2S8Yv7ycKnpCfVEyqTDZPmU2dmnafvvF05dOJZ+nPFmYKf5X+tfa5zvMffnP8rX82YnbiBf/Fp99LXsq/PPRq2aueuYC5R69TXy/MF72Rf3P4LeNt37vwd5MLWe+x7ys/6H7o/ujz8cGn1E+f/gUDmPP8usTo0wAAAAlwSFlzAAALEQAACxEBf2RfkQAAAK1JREFUKFN10D0OhSAQBGAOp2D8u4CNHY0kegFPYaSyM+EQFhY2NsTGcJ3xQbEvxlBMQsg3SxYGgMWitUbbtjiO40fAotBaizzPIYQI8YUo7rqO4DAM78nneYYLH2MMOOchdV3DOffH4zgiyzJM04T7vlFVFeF1XWkI27YNaZpSiqKgs1KKIC0opXwVfLksS1zX9cW+Nc9zeDpJkpBlWV7w83X7vqNpGvR9/4EePztSBhXQfRi8AAAAAElFTkSuQmCC")))
G.DrawImage(check, New Rectangle(2, 3, check.Width, check.Height))
End If
End Sub
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)
End Class
<DefaultEvent("CheckedChanged")>
Class ChromeRadioButton
Inherits ThemeControl154
Sub New()
Font = New Font("Segoe UI", 9)
LockHeight = 17
SetColor("Text", 60, 60, 60)
SetColor("Gradient top", 237, 237, 237)
SetColor("Gradient bottom", 230, 230, 230)
SetColor("Borders", 167, 167, 167)
SetColor("Bullet", 100, 100, 100)
Width = 180
End Sub
Private X As Integer
Private TextColor, G1, G2, Bo, Bb As Color
Protected Overrides Sub ColorHook()
TextColor = GetColor("Text")
G1 = GetColor("Gradient top")
G2 = GetColor("Gradient bottom")
Bb = GetColor("Bullet")
Bo = GetColor("Borders")
End Sub
Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseMove(e)
X = e.Location.X
Invalidate()
End Sub
Protected Overrides Sub PaintHook()
G.Clear(BackColor)
G.SmoothingMode = SmoothingMode.HighQuality
If _Checked Then
Dim LGB As New LinearGradientBrush(New Rectangle(New Point(0, 0), New Size(14, 14)), G1, G2, 90.0F)
G.FillEllipse(LGB, New Rectangle(New Point(0, 0), New Size(14, 14)))
Else
Dim LGB As New LinearGradientBrush(New Rectangle(New Point(0, 0), New Size(14, 16)), G1, G2, 90.0F)
G.FillEllipse(LGB, New Rectangle(New Point(0, 0), New Size(14, 14)))
End If
If State = MouseState.Over And X < 15 Then
Dim SB As New SolidBrush(Color.FromArgb(10, Color.Black))
G.FillEllipse(SB, New Rectangle(New Point(0, 0), New Size(14, 14)))
ElseIf State = MouseState.Down And X < 15 Then
Dim SB As New SolidBrush(Color.FromArgb(20, Color.Black))
G.FillEllipse(SB, New Rectangle(New Point(0, 0), New Size(14, 14)))
End If
Dim P As New GraphicsPath()
P.AddEllipse(New Rectangle(0, 0, 14, 14))
G.SetClip(P)
Dim LLGGBB As New LinearGradientBrush(New Rectangle(0, 0, 14, 5), Color.FromArgb(150, Color.White), Color.Transparent, 90.0F)
G.FillRectangle(LLGGBB, LLGGBB.Rectangle)
G.ResetClip()
G.DrawEllipse(New Pen(Bo), New Rectangle(New Point(0, 0), New Size(14, 14)))
If _Checked Then
Dim LGB As New SolidBrush(Bb)
G.FillEllipse(LGB, New Rectangle(New Point(4, 4), New Size(6, 6)))
End If
DrawText(New SolidBrush(TextColor), HorizontalAlignment.Left, 17, -2)
End Sub
Private _Field As Integer = 16
Property Field() As Integer
Get
Return _Field
End Get
Set(ByVal value As Integer)
If value < 4 Then Return
_Field = value
LockHeight = value
Invalidate()
End Set
End Property
Private _Checked As Boolean
Property Checked() As Boolean
Get
Return _Checked
End Get
Set(ByVal value As Boolean)
_Checked = value
InvalidateControls()
RaiseEvent CheckedChanged(Me)
Invalidate()
End Set
End Property
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
If Not _Checked Then Checked = True
MyBase.OnMouseDown(e)
End Sub
Event CheckedChanged(ByVal sender As Object)
Protected Overrides Sub OnCreation()
InvalidateControls()
End Sub
Private Sub InvalidateControls()
If Not IsHandleCreated OrElse Not _Checked Then Return
For Each C As Control In Parent.Controls
If C IsNot Me AndAlso TypeOf C Is ChromeRadioButton Then
DirectCast(C, ChromeRadioButton).Checked = False
End If
Next
End Sub
End Class
Class ChromeSeparator
Inherits ThemeControl154
Sub New()
LockHeight = 1
BackColor = Color.FromArgb(238, 238, 238)
End Sub
Protected Overrides Sub ColorHook()
End Sub
Protected Overrides Sub PaintHook()
G.Clear(BackColor)
End Sub
End Class
Class ChromeTabcontrol
Inherits TabControl
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint Or ControlStyles.DoubleBuffer, True)
DoubleBuffered = True
SizeMode = TabSizeMode.Fixed
ItemSize = New Size(30, 115)
End Sub
Protected Overrides Sub CreateHandle()
MyBase.CreateHandle()
Alignment = TabAlignment.Left
End Sub
Dim C1 As Color = Color.FromArgb(78, 87, 100)
Property SquareColor As Color
Get
Return C1
End Get
Set(ByVal value As Color)
C1 = value
Invalidate()
End Set
End Property
Dim OB As Boolean = False
Property ShowOuterBorders As Boolean
Get
Return OB
End Get
Set(ByVal value As Boolean)
OB = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim vgtyfyt As Brush
If File.Exists(théme) = True Then
Dim lines1() As String = File.ReadAllLines(théme)
If lines1(0) = 2 Then
testazazazaza = 1
ElseIf lines1(0) = 3 Then
testazazazaza = 3
Else
testazazazaza = 0
End If
End If
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
Dim azazcolor As Color
azazcolor = Color.White
If testazazazaza = 1 Then
azazcolor = Color.FromArgb(64, 64, 64)
vgtyfyt = Brushes.White
Else
vgtyfyt = Brushes.Black
End If
Try : SelectedTab.BackColor = azazcolor : Catch : End Try
G.Clear(azazcolor)
For i = 0 To TabCount - 1
Dim x2 As Rectangle = New Rectangle(New Point(GetTabRect(i).Location.X - 2, GetTabRect(i).Location.Y - 2), New Size(GetTabRect(i).Width + 3, GetTabRect(i).Height - 1))
Dim textrectangle As New Rectangle(x2.Location.X + 20, x2.Location.Y, x2.Width - 20, x2.Height)
If i = SelectedIndex Then
G.FillRectangle(New SolidBrush(C1), New Rectangle(x2.Location, New Size(9, x2.Height)))
If ImageList IsNot Nothing Then
Try
If ImageList.Images(TabPages(i).ImageIndex) IsNot Nothing Then
G.DrawImage(ImageList.Images(TabPages(i).ImageIndex), New Point(textrectangle.Location.X + 8, textrectangle.Location.Y + 6))
G.DrawString(" " & TabPages(i).Text, Font, Brushes.White, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
Else
G.DrawString(TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
End If
Catch ex As Exception
G.DrawString(TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
End Try
Else
G.DrawString(TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
End If
Else
If ImageList IsNot Nothing Then
Try
If ImageList.Images(TabPages(i).ImageIndex) IsNot Nothing Then
G.DrawImage(ImageList.Images(TabPages(i).ImageIndex), New Point(textrectangle.Location.X + 8, textrectangle.Location.Y + 6))
G.DrawString(" " & TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
Else
G.DrawString(TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
End If
Catch ex As Exception
G.DrawString(TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
End Try
Else
G.DrawString(TabPages(i).Text, Font, vgtyfyt, textrectangle, New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Near})
End If
End If
Next
e.Graphics.DrawImage(B.Clone, 0, 0)
G.Dispose() : B.Dispose()
End Sub
End Class
Reference in New Issue View Git Blame Copy Permalink