31 декабря 2017г. 0:56 Начал статью... Fuck.... не спится.
Думаю сделать подарок новичкам. В первую очередь от Нашего прекрасного борда и в последнюю от себя. Да-да дядя Ondrik8 не забыл про Вас как видите, не спится ему спокойно)) ведь сам же когда то был начинающим и хотелось все, и сразу. Ну что же, Вам повезло что Вы с нами и Ты мой юный временно не опытный друг ее читаешь. Когда ты ее прочитаешь и освоишь, поверь ты сможешь заразить любую машину подключенную к интернету нашего земного шарика и при этом не спалится антивирусами (почти)) Тебе не придется изучать линукс, терминалы, шелы и прочее так как все будет происходить на твоей еще пока любимой ОС-и windows, заманчиво правда?
Вылазим на ружу. Спросишь зачем, отвечу, что бы ты смог принимать множественные сигналы своих троянов из интернета, по ясняю не важно где обитает твоя будущая жертва (компьютер) сигналы для управления ею по любому к тебе придут.
Первое что нам нужно сделать это отключить наши фаерволы, брандмауэры и назначить порт для подключения смотрим ниже как пака на "любимой" ОС-и ради Вас исполняет
даем имя правилу которое как видите мы создали, для принятия сигналов из вне и закрываем все окна)
Далее идем на нашумевший сервис No-Ip и параллельно открываем временный почтовый ящик, прошу заметить что наши которые в топе поисковиках не прокатят для регистрации на этом сервисе по этому мне пришлось не много по извращаться и в итоге мне удалось к моему удивлению зарегатся на этот ящик f2a716ba@mozej.com
и скачиваем софт для подключения и можно подключится. Еще мы же тру хацкеры нам еще и VPN нужен для принятия соединения идем сюда.
почта как видите не подводит)) на нее кстати придет логин и пасс от этого же сайта заходим на него и смотрим инструкцию для подключения к VPN
Осталось нам еще сделать самое основное скачать и установить DArkComet или какой нить njrat я возьму именно его)) брал
запускаем и указываем порт тот который мы с Вами открыли в начале статьи.
по желанию можно сходить и проверить открыт ли Ваш указаный порт на сервис 2ip.ru
Затем собираем нашего коня назовем его "Пегас"
указывая наш DNS.... собрали? отлично далее нам нужно его криптануть для этого вазмем легендарную машину для криптовки (шутка) и не только
добавляем TextBox в форму окна
Далее Ребятки Вам нужно будет найти на просторах интернета HEX converter и перевести то что сгенерил njRAT в hex-код
и заменить "1" например на сабаку ) "@"
что бы получилось так, как в низу изображено.
И пишем код как указано ниже, специально его не выкладываю да бы Вы мои юные друзья нашего хлеба откушали.. и да поможет Вам кнопка "TAB" Гы))
Если дописали, а я в этом уверен, ТАБ помогает быстро кодить) добавляем в наше приложение class
И ладно уже, Вас мучать не буду вставляем этот код )
1510 строк, как никак, хех.. сохраняемся жмакаем по дискеткам и собираем наше творение!
Смотрим на сработку вот на этих ресурсах!
фух... закончил в 5 утра!))) Зато Вам опыт.. Удачи Вам всем, в Новом Году!
Думаю сделать подарок новичкам. В первую очередь от Нашего прекрасного борда и в последнюю от себя. Да-да дядя Ondrik8 не забыл про Вас как видите, не спится ему спокойно)) ведь сам же когда то был начинающим и хотелось все, и сразу. Ну что же, Вам повезло что Вы с нами и Ты мой юный временно не опытный друг ее читаешь. Когда ты ее прочитаешь и освоишь, поверь ты сможешь заразить любую машину подключенную к интернету нашего земного шарика и при этом не спалится антивирусами (почти)) Тебе не придется изучать линукс, терминалы, шелы и прочее так как все будет происходить на твоей еще пока любимой ОС-и windows, заманчиво правда?
Вылазим на ружу. Спросишь зачем, отвечу, что бы ты смог принимать множественные сигналы своих троянов из интернета, по ясняю не важно где обитает твоя будущая жертва (компьютер) сигналы для управления ею по любому к тебе придут.
Первое что нам нужно сделать это отключить наши фаерволы, брандмауэры и назначить порт для подключения смотрим ниже как пака на "любимой" ОС-и ради Вас исполняет
даем имя правилу которое как видите мы создали, для принятия сигналов из вне и закрываем все окна)
Далее идем на нашумевший сервис No-Ip и параллельно открываем временный почтовый ящик, прошу заметить что наши которые в топе поисковиках не прокатят для регистрации на этом сервисе по этому мне пришлось не много по извращаться и в итоге мне удалось к моему удивлению зарегатся на этот ящик f2a716ba@mozej.com
и скачиваем софт для подключения и можно подключится. Еще мы же тру хацкеры нам еще и VPN нужен для принятия соединения идем сюда.
почта как видите не подводит)) на нее кстати придет логин и пасс от этого же сайта заходим на него и смотрим инструкцию для подключения к VPN
Осталось нам еще сделать самое основное скачать и установить DArkComet или какой нить njrat я возьму именно его)) брал
Ссылка скрыта от гостей
скачиваете на свой страх и риск!! Пасс от архива, указан в архиве)запускаем и указываем порт тот который мы с Вами открыли в начале статьи.
по желанию можно сходить и проверить открыт ли Ваш указаный порт на сервис 2ip.ru
Затем собираем нашего коня назовем его "Пегас"
указывая наш DNS.... собрали? отлично далее нам нужно его криптануть для этого вазмем легендарную машину для криптовки (шутка) и не только
Ссылка скрыта от гостей
Free версию.. c Visual Basic пакетом, будем кодить! Ведь мы же на форуме кодеров)
добавляем TextBox в форму окна
Далее Ребятки Вам нужно будет найти на просторах интернета HEX converter и перевести то что сгенерил njRAT в hex-код
и заменить "1" например на сабаку ) "@"
что бы получилось так, как в низу изображено.
И пишем код как указано ниже, специально его не выкладываю да бы Вы мои юные друзья нашего хлеба откушали.. и да поможет Вам кнопка "TAB" Гы))
Если дописали, а я в этом уверен, ТАБ помогает быстро кодить) добавляем в наше приложение class
И ладно уже, Вас мучать не буду вставляем этот код )
Код:
Imports System, System.IO, System.Collections.Generic
Imports System.Drawing, System.Drawing.Drawing2D
Imports System.ComponentModel, System.Windows.Forms
'------------------
'Creator: codeby.net
'Theme By: REDTEAM
'Created: 8/2/2017
'Changed: 8/31/2017
'Version: 1.5.1
'Released: 9/18/2017
'------------------
Enum MouseState As Byte
None = 0
Over = 1
Down = 2
Block = 3
End Enum
Class Bloom
Private _Name As String
Property Name() As String
Get
Return _Name
End Get
Set(ByVal value As String)
_Name = value
End Set
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
Private _Pen As Pen
Public Property Pen() As Pen
Get
Return _Pen
End Get
Set(ByVal value As Pen)
_Pen = value
End Set
End Property
Private _Brush As Brush
Public Property Brush() As Brush
Get
Return _Brush
End Get
Set(ByVal value As Brush)
_Brush = value
End Set
End Property
Sub New(ByVal name As String, ByVal value As Color)
_Name = name
_Value = value
_Pen = New Pen(value)
_Brush = New SolidBrush(value)
End Sub
End Class
MustInherit Class ThemeContainer151
Inherits ContainerControl
Protected G As Graphics
Sub New()
SetStyle(DirectCast(139270, ControlStyles), True)
_ImageSize = Size.Empty
MeasureBitmap = New Bitmap(1, 1)
MeasureGraphics = Graphics.FromImage(MeasureBitmap)
Font = New Font("Verdana", 8S)
InvalidateCustimization()
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
Private Header As Rectangle
Protected NotOverridable Overrides Sub OnSizeChanged(ByVal e As EventArgs)
MyBase.OnSizeChanged(e)
If _Movable AndAlso Not _ControlMode Then Header = New Rectangle(7, 7, Width - 14, _MoveHeight - 7)
Invalidate()
End Sub
Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
If Width = 0 OrElse Height = 0 Then Return
G = e.Graphics
PaintHook()
End Sub
Protected NotOverridable Overrides Sub OnHandleCreated(ByVal e As EventArgs)
InitializeMessages()
InvalidateCustimization()
ColorHook()
_IsParentForm = TypeOf Parent Is Form
If Not _ControlMode Then Dock = DockStyle.Fill
If Not _LockWidth = 0 Then Width = _LockWidth
If Not _LockHeight = 0 Then Height = _LockHeight
If Not BackColorWait = Nothing Then BackColor = BackColorWait
If _IsParentForm AndAlso Not _ControlMode Then
ParentForm.FormBorderStyle = _BorderStyle
ParentForm.TransparencyKey = _TransparencyKey
End If
OnCreation()
MyBase.OnHandleCreated(e)
End Sub
Protected Overridable Sub OnCreation()
End Sub
#Region " Sizing and Movement "
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 _Sizable AndAlso Not _ControlMode Then InvalidateMouse()
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 _Sizable AndAlso Not _ControlMode AndAlso GetChildAtPoint(PointToClient(MousePosition)) IsNot Nothing Then
Cursor = Cursors.Default
Previous = 0
End If
MyBase.OnMouseLeave(e)
End Sub
Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
MyBase.OnMouseDown(e)
If Not e.Button = Windows.Forms.MouseButtons.Left Then Return
SetState(MouseState.Down)
If _IsParentForm AndAlso ParentForm.WindowState = FormWindowState.Maximized OrElse _ControlMode Then Return
If _Movable AndAlso Header.Contains(e.Location) Then
Capture = False
DefWndProc(Messages(0))
ElseIf _Sizable AndAlso Not Previous = 0 Then
Capture = False
DefWndProc(Messages(Previous))
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
#End Region
#Region " Property Overrides "
Private BackColorWait As Color
Overrides Property BackColor() As Color
Get
Return MyBase.BackColor
End Get
Set(ByVal value As Color)
If IsHandleCreated Then
If Not _ControlMode Then Parent.BackColor = value
MyBase.BackColor = value
Else
BackColorWait = value
End If
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
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
#End Region
#Region " Properties "
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 _MoveHeight As Integer = 24
Protected Property MoveHeight() As Integer
Get
Return _MoveHeight
End Get
Set(ByVal v As Integer)
If v < 8 Then Return
Header = New Rectangle(7, 7, Width - 14, v - 7)
_MoveHeight = v
Invalidate()
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
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 _IsParentForm AndAlso Not _ControlMode Then ParentForm.TransparencyKey = value
_TransparencyKey = value
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)
If _IsParentForm AndAlso Not _ControlMode Then ParentForm.FormBorderStyle = value
_BorderStyle = value
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
End If
_Image = value
Invalidate()
End Set
End Property
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
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 Items As New Dictionary(Of String, Color)
<DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
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 " Property Helpers "
Protected Function GetColor(ByVal name As String) As Color
Return Items(name)
End Function
Protected Sub SetColor(ByVal name As String, ByVal color As Color)
If Items.ContainsKey(name) Then Items(name) = color Else Items.Add(name, color)
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 color As Color)
SetColor(name, color.FromArgb(a, color))
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
#End Region
#Region " User Hooks "
Protected MustOverride Sub ColorHook()
Protected MustOverride Sub PaintHook()
#End Region
#Region " Center Overloads "
Private CenterReturn As Point
Protected Function Center(ByVal r1 As Rectangle, ByVal s1 As Size) As Point
CenterReturn = New Point((r1.Width \ 2 - s1.Width \ 2) + r1.X, (r1.Height \ 2 - s1.Height \ 2) + r1.Y)
Return CenterReturn
End Function
Protected Function Center(ByVal r1 As Rectangle, ByVal r2 As Rectangle) As Point
Return Center(r1, r2.Size)
End Function
Protected Function Center(ByVal w1 As Integer, ByVal h1 As Integer, ByVal w2 As Integer, ByVal h2 As Integer) As Point
CenterReturn = New Point(w1 \ 2 - w2 \ 2, h1 \ 2 - h2 \ 2)
Return CenterReturn
End Function
Protected Function Center(ByVal s1 As Size, ByVal s2 As Size) As Point
Return Center(s1.Width, s1.Height, s2.Width, s2.Height)
End Function
Protected Function Center(ByVal r1 As Rectangle) As Point
Return Center(ClientRectangle.Width, ClientRectangle.Height, r1.Width, r1.Height)
End Function
Protected Function Center(ByVal s1 As Size) As Point
Return Center(Width, Height, s1.Width, s1.Height)
End Function
Protected Function Center(ByVal w1 As Integer, ByVal h1 As Integer) As Point
Return Center(Width, Height, w1, h1)
End Function
#End Region
#Region " Measure Overloads "
Private MeasureBitmap As Bitmap
Private MeasureGraphics As Graphics
Protected Function Measure(ByVal text As String) As Size
Return MeasureGraphics.MeasureString(text, Font, Width).ToSize
End Function
Protected Function Measure() As Size
Return MeasureGraphics.MeasureString(Text, Font).ToSize
End Function
#End Region
#Region " DrawCorners Overloads "
'TODO: Optimize by checking brush color
Private DrawCornersBrush As SolidBrush
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
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 Sub
#End Region
#Region " DrawBorders Overloads "
'TODO: Remove triple overload?
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, 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)
G.DrawRectangle(p1, x, y, width - 1, height - 1)
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
#End Region
#Region " DrawText Overloads "
'TODO: Remove triple overloads?
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 p1 As Point)
DrawText(b1, Text, p1.X, p1.Y)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal x As Integer, ByVal y As Integer)
DrawText(b1, Text, 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, MoveHeight \ 2 - DrawTextSize.Height \ 2)
Select Case a
Case HorizontalAlignment.Left
DrawText(b1, text, x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Center
DrawText(b1, text, DrawTextPoint.X + x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Right
DrawText(b1, text, Width - DrawTextSize.Width - x, DrawTextPoint.Y + y)
End Select
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal text As String, ByVal p1 As Point)
DrawText(b1, text, p1.X, p1.Y)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal text As String, 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 Overloads "
'TODO: Remove triple overloads?
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 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 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, MoveHeight \ 2 - image.Height \ 2)
Select Case a
Case HorizontalAlignment.Left
DrawImage(image, x, DrawImagePoint.Y + y)
Case HorizontalAlignment.Center
DrawImage(image, DrawImagePoint.X + x, DrawImagePoint.Y + y)
Case HorizontalAlignment.Right
DrawImage(image, Width - image.Width - x, DrawImagePoint.Y + y)
End Select
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 Overloads "
'TODO: Remove triple overload?
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)
DrawGradient(blend, x, y, width, height, 90S)
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)
DrawGradient(c1, c2, x, y, width, height, 90S)
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 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 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 r As Rectangle, ByVal angle As Single)
DrawGradientBrush = New LinearGradientBrush(r, c1, c2, angle)
G.FillRectangle(DrawGradientBrush, r)
End Sub
#End Region
End Class
MustInherit Class ThemeControl151
Inherits Control
Protected G As Graphics, B As Bitmap
Sub New()
SetStyle(DirectCast(139270, ControlStyles), True)
_ImageSize = Size.Empty
MeasureBitmap = New Bitmap(1, 1)
MeasureGraphics = Graphics.FromImage(MeasureBitmap)
Font = New Font("Verdana", 8S)
InvalidateCustimization()
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
Protected NotOverridable Overrides Sub OnSizeChanged(ByVal e As EventArgs)
If _Transparent AndAlso Not (Width = 0 OrElse Height = 0) Then
B = New Bitmap(Width, Height)
G = Graphics.FromImage(B)
End If
Invalidate()
MyBase.OnSizeChanged(e)
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 OnHandleCreated(ByVal e As EventArgs)
InvalidateCustimization()
ColorHook()
If Not _LockWidth = 0 Then Width = _LockWidth
If Not _LockHeight = 0 Then Height = _LockHeight
If Not BackColorWait = Nothing Then BackColor = BackColorWait
OnCreation()
MyBase.OnHandleCreated(e)
End Sub
Protected Overridable Sub OnCreation()
End Sub
#Region " State Handling "
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 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)
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 " Property Overrides "
Private BackColorWait As Color
Overrides Property BackColor() As Color
Get
Return MyBase.BackColor
End Get
Set(ByVal value As Color)
If IsHandleCreated Then
MyBase.BackColor = value
Else
BackColorWait = value
End If
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
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
#End Region
#Region " 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 _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 _Transparent As Boolean
Property Transparent() As Boolean
Get
Return _Transparent
End Get
Set(ByVal value As Boolean)
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
_Transparent = value
Invalidate()
End Set
End Property
Private Items As New Dictionary(Of String, Color)
<DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
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 " Property Helpers "
Private Sub InvalidateBitmap()
If Width = 0 OrElse Height = 0 Then Return
B = New Bitmap(Width, Height)
G = Graphics.FromImage(B)
End Sub
Protected Function GetColor(ByVal name As String) As Color
Return Items(name)
End Function
Protected Sub SetColor(ByVal name As String, ByVal color As Color)
If Items.ContainsKey(name) Then Items(name) = color Else Items.Add(name, color)
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 color As Color)
SetColor(name, color.FromArgb(a, color))
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
#End Region
#Region " User Hooks "
Protected MustOverride Sub ColorHook()
Protected MustOverride Sub PaintHook()
#End Region
#Region " Center Overloads "
Private CenterReturn As Point
Protected Function Center(ByVal r1 As Rectangle, ByVal s1 As Size) As Point
CenterReturn = New Point((r1.Width \ 2 - s1.Width \ 2) + r1.X, (r1.Height \ 2 - s1.Height \ 2) + r1.Y)
Return CenterReturn
End Function
Protected Function Center(ByVal r1 As Rectangle, ByVal r2 As Rectangle) As Point
Return Center(r1, r2.Size)
End Function
Protected Function Center(ByVal w1 As Integer, ByVal h1 As Integer, ByVal w2 As Integer, ByVal h2 As Integer) As Point
CenterReturn = New Point(w1 \ 2 - w2 \ 2, h1 \ 2 - h2 \ 2)
Return CenterReturn
End Function
Protected Function Center(ByVal s1 As Size, ByVal s2 As Size) As Point
Return Center(s1.Width, s1.Height, s2.Width, s2.Height)
End Function
Protected Function Center(ByVal r1 As Rectangle) As Point
Return Center(ClientRectangle.Width, ClientRectangle.Height, r1.Width, r1.Height)
End Function
Protected Function Center(ByVal s1 As Size) As Point
Return Center(Width, Height, s1.Width, s1.Height)
End Function
Protected Function Center(ByVal w1 As Integer, ByVal h1 As Integer) As Point
Return Center(Width, Height, w1, h1)
End Function
#End Region
#Region " Measure Overloads "
Private MeasureBitmap As Bitmap
Private MeasureGraphics As Graphics
Protected Function Measure(ByVal text As String) As Size
Return MeasureGraphics.MeasureString(text, Font, Width).ToSize
End Function
Protected Function Measure() As Size
Return MeasureGraphics.MeasureString(Text, Font, Width).ToSize
End Function
#End Region
#Region " DrawCorners Overloads "
'TODO: Optimize by checking brush color
Private DrawCornersBrush As SolidBrush
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 Overloads "
'TODO: Remove triple overload?
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, 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)
G.DrawRectangle(p1, x, y, width - 1, height - 1)
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
#End Region
#Region " DrawText Overloads "
'TODO: Remove triple overloads?
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 p1 As Point)
DrawText(b1, Text, p1.X, p1.Y)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal x As Integer, ByVal y As Integer)
DrawText(b1, Text, 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
DrawText(b1, text, x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Center
DrawText(b1, text, DrawTextPoint.X + x, DrawTextPoint.Y + y)
Case HorizontalAlignment.Right
DrawText(b1, text, Width - DrawTextSize.Width - x, DrawTextPoint.Y + y)
End Select
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal text As String, ByVal p1 As Point)
DrawText(b1, text, p1.X, p1.Y)
End Sub
Protected Sub DrawText(ByVal b1 As Brush, ByVal text As String, 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 Overloads "
'TODO: Remove triple overloads?
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 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 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
DrawImage(image, x, DrawImagePoint.Y + y)
Case HorizontalAlignment.Center
DrawImage(image, DrawImagePoint.X + x, DrawImagePoint.Y + y)
Case HorizontalAlignment.Right
DrawImage(image, Width - image.Width - x, DrawImagePoint.Y + y)
End Select
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 Overloads "
'TODO: Remove triple overload?
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)
DrawGradient(blend, x, y, width, height, 90S)
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)
DrawGradient(c1, c2, x, y, width, height, 90S)
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 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 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 r As Rectangle, ByVal angle As Single)
DrawGradientBrush = New LinearGradientBrush(r, c1, c2, angle)
G.FillRectangle(DrawGradientBrush, r)
End Sub
#End Region
End Class
MustInherit Class ThemeContainerControl
Inherits ContainerControl
#Region " Initialization "
Protected G As Graphics, B As Bitmap
Sub New()
SetStyle(DirectCast(139270, ControlStyles), True)
B = New Bitmap(1, 1)
G = Graphics.FromImage(B)
End Sub
Sub AllowTransparent()
SetStyle(ControlStyles.Opaque, False)
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
End Sub
#End Region
#Region " Convienence "
Protected MustOverride Sub PaintHook()
Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
If Width = 0 OrElse Height = 0 Then Return
G = e.Graphics
PaintHook()
End Sub
Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
If Not Width = 0 AndAlso Not Height = 0 Then
B = New Bitmap(Width, Height)
G = Graphics.FromImage(B)
Invalidate()
End If
MyBase.OnSizeChanged(e)
End Sub
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 _Rectangle As Rectangle
Private _Gradient As LinearGradientBrush
Protected Sub DrawCorners(ByVal c As Color, ByVal rect As Rectangle)
If _NoRounding Then Return
B.SetPixel(rect.X, rect.Y, c)
B.SetPixel(rect.X + (rect.Width - 1), rect.Y, c)
B.SetPixel(rect.X, rect.Y + (rect.Height - 1), c)
B.SetPixel(rect.X + (rect.Width - 1), rect.Y + (rect.Height - 1), c)
End Sub
Protected Sub DrawBorders(ByVal p1 As Pen, ByVal p2 As Pen, ByVal rect As Rectangle)
G.DrawRectangle(p1, rect.X, rect.Y, rect.Width - 1, rect.Height - 1)
G.DrawRectangle(p2, rect.X + 1, rect.Y + 1, rect.Width - 3, rect.Height - 3)
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)
_Rectangle = New Rectangle(x, y, width, height)
_Gradient = New LinearGradientBrush(_Rectangle, c1, c2, angle)
G.FillRectangle(_Gradient, _Rectangle)
End Sub
#End Region
End Class
Class Classic
Inherits ThemeContainer151
Private Bloom As Bloom()
Private R1 As Rectangle
Private L1 As LinearGradientBrush
Private H As HatchBrush
Sub New()
Bloom = {New Bloom("Border", Color.Black), New Bloom("Highlight Border", Color.FromArgb(87, 87, 87)), _
New Bloom("BackColor", Color.FromArgb(51, 51, 51)), New Bloom("Text Color", Color.FromArgb(128, Color.White)), _
New Bloom("Background", Color.FromArgb(73, 73, 73)), New Bloom("Grid Color", Color.FromArgb(128, 31, 31, 31)), _
New Bloom("Gradient #1", Color.FromArgb(128, Color.Black)), New Bloom("Highlight", Color.FromArgb(26, Color.White)), _
New Bloom("Shadow", Color.FromArgb(10, Color.Black)), New Bloom("Trasparency", Color.Fuchsia) With {.Pen = New Pen(.Value, 2)}}
TransparencyKey = Color.Fuchsia
MoveHeight = 22
Font = New Font("Verdana", 7.0F)
End Sub
Protected Overrides Sub ColorHook()
End Sub
Protected Overrides Sub PaintHook()
G.Clear(Bloom(0).Value)
DrawBorders(Bloom(1).Pen, 1, 1, Width - 2, Height - 2)
G.FillRectangle(Bloom(2).Brush, 2, 2, Width - 4, 18)
G.FillRectangle(Bloom(2).Brush, 2, Height - 20, Width - 4, 18)
G.DrawLine(Bloom(1).Pen, 2, 21, Width - 2, 21)
G.FillRectangle(Bloom(4).Brush, 2, 22, Width - 4, Height - 44)
G.DrawLine(Bloom(1).Pen, 2, Height - 21, Width - 2, Height - 21)
H = New HatchBrush(HatchStyle.SmallCheckerBoard, Bloom(5).Value, Color.Transparent)
R1 = New Rectangle(2, 2, Width - 4, Height)
L1 = New LinearGradientBrush(R1, Color.Transparent, Bloom(6).Value, 270S)
G.FillRectangle(L1, ClientRectangle)
G.FillRectangle(H, 2, 22, Width - 4, Height - 44)
G.FillRectangle(Bloom(7).Brush, 0, 0, Width, 5)
G.FillRectangle(Bloom(8).Brush, 0, 4, Width, Height - 10)
If _Round Then
G.DrawArc(Bloom(9).Pen, -1, -1, 9, 9, 180, 90)
G.DrawArc(Bloom(9).Pen, Width - 9, -1, 9, 9, 270, 90)
G.DrawArc(Bloom(9).Pen, Width - 9, Height - 9, 9, 9, 360, 90)
G.DrawArc(Bloom(9).Pen, -1, Height - 9, 9, 9, 90, 90)
G.DrawArc(Bloom(0).Pen, 0, 0, 9, 9, 180, 90)
G.DrawArc(Bloom(0).Pen, Width - 10, 0, 9, 9, 270, 90)
G.DrawArc(Bloom(0).Pen, Width - 10, Height - 10, 9, 9, 360, 90)
G.DrawArc(Bloom(0).Pen, 0, Height - 10, 9, 9, 90, 90)
Else
DrawCorners(Color.Fuchsia)
End If
DrawText(Bloom(3).Brush, 5, 5)
End Sub
Private _Round As Boolean = False
Public Property NewProperty() As Boolean
Get
Return _Round
End Get
Set(ByVal value As Boolean)
_Round = value
Invalidate()
End Set
End Property
End Class
Class ClassicButton
Inherits ThemeControl151
Private Bloom As Bloom()
Private L1 As LinearGradientBrush
Private R1 As Rectangle
Sub New()
Bloom = {New Bloom("Border", Color.Black), New Bloom("Highlight", Color.FromArgb(35, 35, 35)), _
New Bloom("Background", Color.FromArgb(24, 24, 24)), New Bloom("Shadow", Color.FromArgb(100, Color.Black)), _
New Bloom("Text Color", Color.FromArgb(128, Color.White))}
Font = New Font("Verdana", 7.0F)
Size = New Size(97, 23)
End Sub
Protected Overrides Sub ColorHook()
End Sub
Protected Overrides Sub PaintHook()
G.FillRectangle(Bloom(2).Brush, ClientRectangle)
DrawBorders(Bloom(0).Pen, ClientRectangle)
DrawBorders(Bloom(1).Pen, 1, 1, Width - 2, Height - 2)
R1 = New Rectangle(2, 2, Width - 4, Height - 4)
Select Case State
Case MouseState.Over
L1 = New LinearGradientBrush(ClientRectangle, Color.FromArgb(100, 0, 156, 255), Color.Transparent, 270S)
G.FillRectangle(L1, R1)
G.FillRectangle(Bloom(3).Brush, 1, 7, Width - 2, Height - 7)
Case MouseState.Down
L1 = New LinearGradientBrush(ClientRectangle, Color.FromArgb(50, 0, 156, 255), Color.Transparent, 90S)
G.FillRectangle(L1, R1)
G.FillRectangle(Bloom(3).Brush, 1, 7, Width - 2, Height - 7)
Case MouseState.None
G.FillRectangle(Bloom(3).Brush, 1, 8, Width - 2, Height - 8)
End Select
DrawText(Bloom(4).Brush, HorizontalAlignment.Center, 0, 0)
End Sub
End Class
Class ClassicPanel
Inherits ThemeContainerControl
Private Bloom As Bloom()
Private L1, L2, L3 As LinearGradientBrush
Private R1, R2, R3 As Rectangle
Sub New()
Bloom = {New Bloom("Border", Color.FromArgb(87, 87, 87)), New Bloom("Border #2", Color.Black), _
New Bloom("Color #1", Color.FromArgb(49, 49, 49)), New Bloom("Color #2", Color.FromArgb(35, 35, 35)), _
New Bloom("Shadow", Color.FromArgb(31, 31, 31))}
End Sub
Protected Overrides Sub PaintHook()
G.Clear(Color.White)
DrawBorders(Bloom(0).Pen, Bloom(1).Pen, ClientRectangle)
DrawCorners(BackColor, ClientRectangle)
R1 = New Rectangle(2, 2, Width - 4, Height - 4)
R2 = New Rectangle(2, 2, 15, Height - 4)
R3 = New Rectangle(2, 2, Width - 4, 15)
L1 = New LinearGradientBrush(R1, Bloom(2).Value, Bloom(3).Value, 90S)
L2 = New LinearGradientBrush(R2, Bloom(4).Value, Color.Transparent, 0S)
L3 = New LinearGradientBrush(R3, Bloom(4).Value, Color.Transparent, 90S)
G.FillRectangle(L1, R1)
G.FillRectangle(L2, R2)
G.FillRectangle(L3, R3)
End Sub
End Class1510 строк, как никак, хех.. сохраняемся жмакаем по дискеткам и собираем наше творение!
Смотрим на сработку вот на этих ресурсах!
Ссылка скрыта от гостей
Ссылка скрыта от гостей
Ссылка скрыта от гостей
фух... закончил в 5 утра!))) Зато Вам опыт.. Удачи Вам всем, в Новом Году!
Последнее редактирование:
