Advertisement
benito

Untitled

Sep 7th, 2011
87
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 16.85 KB | None | 0 0
  1. Imports System.Drawing.Drawing2D
  2. Imports System.ComponentModel
  3. Imports System.Runtime.InteropServices
  4.  
  5. MustInherit Class Theme
  6.     Inherits ContainerControl
  7.  
  8. #Region " Initialization "
  9.  
  10.     Protected G As Graphics
  11.     Sub New()
  12.         SetStyle(DirectCast(139270, ControlStyles), True)
  13.     End Sub
  14.  
  15.     Private ParentIsForm As Boolean
  16.     Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
  17.         Dock = DockStyle.Fill
  18.         ParentIsForm = TypeOf Parent Is Form
  19.         If ParentIsForm Then
  20.             If Not _TransparencyKey = Color.Empty Then ParentForm.TransparencyKey = _TransparencyKey
  21.             ParentForm.FormBorderStyle = FormBorderStyle.None
  22.         End If
  23.         MyBase.OnHandleCreated(e)
  24.     End Sub
  25.  
  26.     Overrides Property Text As String
  27.         Get
  28.             Return MyBase.Text
  29.         End Get
  30.         Set(ByVal v As String)
  31.             MyBase.Text = v
  32.             Invalidate()
  33.         End Set
  34.     End Property
  35. #End Region
  36.  
  37. #Region " Sizing and Movement "
  38.  
  39.     Private _Resizable As Boolean = True
  40.     Property Resizable() As Boolean
  41.         Get
  42.             Return _Resizable
  43.         End Get
  44.         Set(ByVal value As Boolean)
  45.             _Resizable = value
  46.         End Set
  47.     End Property
  48.  
  49.     Private _MoveHeight As Integer = 24
  50.     Property MoveHeight() As Integer
  51.         Get
  52.             Return _MoveHeight
  53.         End Get
  54.         Set(ByVal v As Integer)
  55.             _MoveHeight = v
  56.             Header = New Rectangle(7, 7, Width - 14, _MoveHeight - 7)
  57.         End Set
  58.     End Property
  59.  
  60.     Private Flag As IntPtr
  61.     Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
  62.         If Not e.Button = MouseButtons.Left Then Return
  63.         If ParentIsForm Then If ParentForm.WindowState = FormWindowState.Maximized Then Return
  64.  
  65.         If Header.Contains(e.Location) Then
  66.             Flag = New IntPtr(2)
  67.         ElseIf Current.Position = 0 Or Not _Resizable Then
  68.             Return
  69.         Else
  70.             Flag = New IntPtr(Current.Position)
  71.         End If
  72.  
  73.         Capture = False
  74.         DefWndProc(Message.Create(Parent.Handle, 161, Flag, Nothing))
  75.  
  76.         MyBase.OnMouseDown(e)
  77.     End Sub
  78.  
  79.     Private Structure Pointer
  80.         ReadOnly Cursor As Cursor, Position As Byte
  81.         Sub New(ByVal c As Cursor, ByVal p As Byte)
  82.             Cursor = c
  83.             Position = p
  84.         End Sub
  85.     End Structure
  86.  
  87.     Private F1, F2, F3, F4 As Boolean, PTC As Point
  88.     Private Function GetPointer() As Pointer
  89.         PTC = PointToClient(MousePosition)
  90.         F1 = PTC.X < 7
  91.         F2 = PTC.X > Width - 7
  92.         F3 = PTC.Y < 7
  93.         F4 = PTC.Y > Height - 7
  94.  
  95.         If F1 And F3 Then Return New Pointer(Cursors.SizeNWSE, 13)
  96.         If F1 And F4 Then Return New Pointer(Cursors.SizeNESW, 16)
  97.         If F2 And F3 Then Return New Pointer(Cursors.SizeNESW, 14)
  98.         If F2 And F4 Then Return New Pointer(Cursors.SizeNWSE, 17)
  99.         If F1 Then Return New Pointer(Cursors.SizeWE, 10)
  100.         If F2 Then Return New Pointer(Cursors.SizeWE, 11)
  101.         If F3 Then Return New Pointer(Cursors.SizeNS, 12)
  102.         If F4 Then Return New Pointer(Cursors.SizeNS, 15)
  103.         Return New Pointer(Cursors.Default, 0)
  104.     End Function
  105.  
  106.     Private Current, Pending As Pointer
  107.     Private Sub SetCurrent()
  108.         Pending = GetPointer()
  109.         If Current.Position = Pending.Position Then Return
  110.         Current = GetPointer()
  111.         Cursor = Current.Cursor
  112.     End Sub
  113.  
  114.     Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
  115.         If _Resizable Then SetCurrent()
  116.         MyBase.OnMouseMove(e)
  117.     End Sub
  118.  
  119.     Protected Header As Rectangle
  120.     Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
  121.         If Width = 0 OrElse Height = 0 Then Return
  122.         Header = New Rectangle(7, 7, Width - 14, _MoveHeight - 7)
  123.         Invalidate()
  124.         MyBase.OnSizeChanged(e)
  125.     End Sub
  126.  
  127. #End Region
  128.  
  129. #Region " Convienence "
  130.  
  131.     MustOverride Sub PaintHook()
  132.     Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
  133.         If Width = 0 OrElse Height = 0 Then Return
  134.         G = e.Graphics
  135.         PaintHook()
  136.     End Sub
  137.  
  138.     Private _TransparencyKey As Color
  139.     Property TransparencyKey() As Color
  140.         Get
  141.             Return _TransparencyKey
  142.         End Get
  143.         Set(ByVal v As Color)
  144.             _TransparencyKey = v
  145.             Invalidate()
  146.         End Set
  147.     End Property
  148.  
  149.     Private _Image As Image
  150.     Property Image() As Image
  151.         Get
  152.             Return _Image
  153.         End Get
  154.         Set(ByVal value As Image)
  155.             _Image = value
  156.             Invalidate()
  157.         End Set
  158.     End Property
  159.     ReadOnly Property ImageWidth() As Integer
  160.         Get
  161.             If _Image Is Nothing Then Return 0
  162.             Return _Image.Width
  163.         End Get
  164.     End Property
  165.  
  166.     Private _Size As Size
  167.     Private _Rectangle As Rectangle
  168.     Private _Gradient As LinearGradientBrush
  169.     Private _Brush As SolidBrush
  170.  
  171.     Protected Sub DrawCorners(ByVal c As Color, ByVal rect As Rectangle)
  172.         _Brush = New SolidBrush(c)
  173.         G.FillRectangle(_Brush, rect.X, rect.Y, 1, 1)
  174.         G.FillRectangle(_Brush, rect.X + (rect.Width - 1), rect.Y, 1, 1)
  175.         G.FillRectangle(_Brush, rect.X, rect.Y + (rect.Height - 1), 1, 1)
  176.         G.FillRectangle(_Brush, rect.X + (rect.Width - 1), rect.Y + (rect.Height - 1), 1, 1)
  177.     End Sub
  178.  
  179.     Protected Sub DrawBorders(ByVal p1 As Pen, ByVal p2 As Pen, ByVal rect As Rectangle)
  180.         G.DrawRectangle(p1, rect.X, rect.Y, rect.Width - 1, rect.Height - 1)
  181.         G.DrawRectangle(p2, rect.X + 1, rect.Y + 1, rect.Width - 3, rect.Height - 3)
  182.     End Sub
  183.  
  184.     Protected Sub DrawText(ByVal a As HorizontalAlignment, ByVal c As Color, ByVal x As Integer)
  185.         DrawText(a, c, x, 0)
  186.     End Sub
  187.     Protected Sub DrawText(ByVal a As HorizontalAlignment, ByVal c As Color, ByVal x As Integer, ByVal y As Integer)
  188.         If String.IsNullOrEmpty(Text) Then Return
  189.         _Size = G.MeasureString(Text, Font).ToSize
  190.         _Brush = New SolidBrush(c)
  191.  
  192.         Select Case a
  193.             Case HorizontalAlignment.Left
  194.                 G.DrawString(Text, Font, _Brush, x, _MoveHeight \ 2 - _Size.Height \ 2 + y)
  195.             Case HorizontalAlignment.Right
  196.                 G.DrawString(Text, Font, _Brush, Width - _Size.Width - x, _MoveHeight \ 2 - _Size.Height \ 2 + y)
  197.             Case HorizontalAlignment.Center
  198.                 G.DrawString(Text, Font, _Brush, Width \ 2 - _Size.Width \ 2 + x, _MoveHeight \ 2 - _Size.Height \ 2 + y)
  199.         End Select
  200.     End Sub
  201.  
  202.     Protected Sub DrawIcon(ByVal a As HorizontalAlignment, ByVal x As Integer)
  203.         DrawIcon(a, x, 0)
  204.     End Sub
  205.     Protected Sub DrawIcon(ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
  206.         If _Image Is Nothing Then Return
  207.         Select Case a
  208.             Case HorizontalAlignment.Left
  209.                 G.DrawImage(_Image, x, _MoveHeight \ 2 - _Image.Height \ 2 + y)
  210.             Case HorizontalAlignment.Right
  211.                 G.DrawImage(_Image, Width - _Image.Width - x, _MoveHeight \ 2 - _Image.Height \ 2 + y)
  212.             Case HorizontalAlignment.Center
  213.                 G.DrawImage(_Image, Width \ 2 - _Image.Width \ 2, _MoveHeight \ 2 - _Image.Height \ 2)
  214.         End Select
  215.     End Sub
  216.  
  217.     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)
  218.         _Rectangle = New Rectangle(x, y, width, height)
  219.         _Gradient = New LinearGradientBrush(_Rectangle, c1, c2, angle)
  220.         G.FillRectangle(_Gradient, _Rectangle)
  221.     End Sub
  222.  
  223. #End Region
  224.  
  225. End Class
  226.  
  227. MustInherit Class ThemeControl
  228.     Inherits Control
  229.  
  230. #Region " Initialization "
  231.  
  232.     Protected G As Graphics, B As Bitmap
  233.     Sub New()
  234.         SetStyle(DirectCast(139270, ControlStyles), True)
  235.         B = New Bitmap(1, 1)
  236.         G = Graphics.FromImage(B)
  237.     End Sub
  238.  
  239.     Sub AllowTransparent()
  240.         SetStyle(ControlStyles.Opaque, False)
  241.         SetStyle(ControlStyles.SupportsTransparentBackColor, True)
  242.     End Sub
  243.  
  244.     Overrides Property Text As String
  245.         Get
  246.             Return MyBase.Text
  247.         End Get
  248.         Set(ByVal v As String)
  249.             MyBase.Text = v
  250.             Invalidate()
  251.         End Set
  252.     End Property
  253. #End Region
  254.  
  255. #Region " Mouse Handling "
  256.  
  257.     Protected Enum State As Byte
  258.         MouseNone = 0
  259.         MouseOver = 1
  260.         MouseDown = 2
  261.     End Enum
  262.  
  263.     Protected MouseState As State
  264.     Protected Overrides Sub OnMouseLeave(ByVal e As EventArgs)
  265.         ChangeMouseState(State.MouseNone)
  266.         MyBase.OnMouseLeave(e)
  267.     End Sub
  268.     Protected Overrides Sub OnMouseEnter(ByVal e As EventArgs)
  269.         ChangeMouseState(State.MouseOver)
  270.         MyBase.OnMouseEnter(e)
  271.     End Sub
  272.     Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
  273.         ChangeMouseState(State.MouseOver)
  274.         MyBase.OnMouseUp(e)
  275.     End Sub
  276.     Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
  277.         If e.Button = MouseButtons.Left Then ChangeMouseState(State.MouseDown)
  278.         MyBase.OnMouseDown(e)
  279.     End Sub
  280.  
  281.     Private Sub ChangeMouseState(ByVal e As State)
  282.         MouseState = e
  283.         Invalidate()
  284.     End Sub
  285.  
  286. #End Region
  287.  
  288. #Region " Convienence "
  289.  
  290.     MustOverride Sub PaintHook()
  291.     Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
  292.         If Width = 0 OrElse Height = 0 Then Return
  293.         PaintHook()
  294.         e.Graphics.DrawImage(B, 0, 0)
  295.     End Sub
  296.  
  297.     Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
  298.         If Not Width = 0 AndAlso Not Height = 0 Then
  299.             B = New Bitmap(Width, Height)
  300.             G = Graphics.FromImage(B)
  301.             Invalidate()
  302.         End If
  303.         MyBase.OnSizeChanged(e)
  304.     End Sub
  305.  
  306.     Private _NoRounding As Boolean
  307.     Property NoRounding() As Boolean
  308.         Get
  309.             Return _NoRounding
  310.         End Get
  311.         Set(ByVal v As Boolean)
  312.             _NoRounding = v
  313.             Invalidate()
  314.         End Set
  315.     End Property
  316.  
  317.     Private _Image As Image
  318.     Property Image() As Image
  319.         Get
  320.             Return _Image
  321.         End Get
  322.         Set(ByVal value As Image)
  323.             _Image = value
  324.             Invalidate()
  325.         End Set
  326.     End Property
  327.     ReadOnly Property ImageWidth() As Integer
  328.         Get
  329.             If _Image Is Nothing Then Return 0
  330.             Return _Image.Width
  331.         End Get
  332.     End Property
  333.     ReadOnly Property ImageTop() As Integer
  334.         Get
  335.             If _Image Is Nothing Then Return 0
  336.             Return Height \ 2 - _Image.Height \ 2
  337.         End Get
  338.     End Property
  339.  
  340.     Private _Size As Size
  341.     Private _Rectangle As Rectangle
  342.     Private _Gradient As LinearGradientBrush
  343.     Private _Brush As SolidBrush
  344.  
  345.     Protected Sub DrawCorners(ByVal c As Color, ByVal rect As Rectangle)
  346.         If _NoRounding Then Return
  347.  
  348.         B.SetPixel(rect.X, rect.Y, c)
  349.         B.SetPixel(rect.X + (rect.Width - 1), rect.Y, c)
  350.         B.SetPixel(rect.X, rect.Y + (rect.Height - 1), c)
  351.         B.SetPixel(rect.X + (rect.Width - 1), rect.Y + (rect.Height - 1), c)
  352.     End Sub
  353.  
  354.     Protected Sub DrawBorders(ByVal p1 As Pen, ByVal p2 As Pen, ByVal rect As Rectangle)
  355.         G.DrawRectangle(p1, rect.X, rect.Y, rect.Width - 1, rect.Height - 1)
  356.         G.DrawRectangle(p2, rect.X + 1, rect.Y + 1, rect.Width - 3, rect.Height - 3)
  357.     End Sub
  358.  
  359.     Protected Sub DrawText(ByVal a As HorizontalAlignment, ByVal c As Color, ByVal x As Integer)
  360.         DrawText(a, c, x, 0)
  361.     End Sub
  362.     Protected Sub DrawText(ByVal a As HorizontalAlignment, ByVal c As Color, ByVal x As Integer, ByVal y As Integer)
  363.         If String.IsNullOrEmpty(Text) Then Return
  364.         _Size = G.MeasureString(Text, Font).ToSize
  365.         _Brush = New SolidBrush(c)
  366.  
  367.         Select Case a
  368.             Case HorizontalAlignment.Left
  369.                 G.DrawString(Text, Font, _Brush, x, Height \ 2 - _Size.Height \ 2 + y)
  370.             Case HorizontalAlignment.Right
  371.                 G.DrawString(Text, Font, _Brush, Width - _Size.Width - x, Height \ 2 - _Size.Height \ 2 + y)
  372.             Case HorizontalAlignment.Center
  373.                 G.DrawString(Text, Font, _Brush, Width \ 2 - _Size.Width \ 2 + x, Height \ 2 - _Size.Height \ 2 + y)
  374.         End Select
  375.     End Sub
  376.  
  377.     Protected Sub DrawIcon(ByVal a As HorizontalAlignment, ByVal x As Integer)
  378.         DrawIcon(a, x, 0)
  379.     End Sub
  380.     Protected Sub DrawIcon(ByVal a As HorizontalAlignment, ByVal x As Integer, ByVal y As Integer)
  381.         If _Image Is Nothing Then Return
  382.         Select Case a
  383.             Case HorizontalAlignment.Left
  384.                 G.DrawImage(_Image, x, Height \ 2 - _Image.Height \ 2 + y)
  385.             Case HorizontalAlignment.Right
  386.                 G.DrawImage(_Image, Width - _Image.Width - x, Height \ 2 - _Image.Height \ 2 + y)
  387.             Case HorizontalAlignment.Center
  388.                 G.DrawImage(_Image, Width \ 2 - _Image.Width \ 2, Height \ 2 - _Image.Height \ 2)
  389.         End Select
  390.     End Sub
  391.  
  392.     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)
  393.         _Rectangle = New Rectangle(x, y, width, height)
  394.         _Gradient = New LinearGradientBrush(_Rectangle, c1, c2, angle)
  395.         G.FillRectangle(_Gradient, _Rectangle)
  396.     End Sub
  397. #End Region
  398.  
  399. End Class
  400. MustInherit Class ThemeContainerControl
  401.     Inherits ContainerControl
  402.  
  403. #Region " Initialization "
  404.  
  405.     Protected G As Graphics, B As Bitmap
  406.     Sub New()
  407.         SetStyle(DirectCast(139270, ControlStyles), True)
  408.         B = New Bitmap(1, 1)
  409.         G = Graphics.FromImage(B)
  410.     End Sub
  411.  
  412.     Sub AllowTransparent()
  413.         SetStyle(ControlStyles.Opaque, False)
  414.         SetStyle(ControlStyles.SupportsTransparentBackColor, True)
  415.     End Sub
  416.  
  417. #End Region
  418.  
  419. #Region " Convienence "
  420.  
  421.     MustOverride Sub PaintHook()
  422.     Protected NotOverridable Overrides Sub OnPaint(ByVal e As PaintEventArgs)
  423.         If Width = 0 OrElse Height = 0 Then Return
  424.         PaintHook()
  425.         e.Graphics.DrawImage(B, 0, 0)
  426.     End Sub
  427.  
  428.     Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
  429.         If Not Width = 0 AndAlso Not Height = 0 Then
  430.             B = New Bitmap(Width, Height)
  431.             G = Graphics.FromImage(B)
  432.             Invalidate()
  433.         End If
  434.         MyBase.OnSizeChanged(e)
  435.     End Sub
  436.  
  437.     Private _NoRounding As Boolean
  438.     Property NoRounding() As Boolean
  439.         Get
  440.             Return _NoRounding
  441.         End Get
  442.         Set(ByVal v As Boolean)
  443.             _NoRounding = v
  444.             Invalidate()
  445.         End Set
  446.     End Property
  447.  
  448.     Private _Rectangle As Rectangle
  449.     Private _Gradient As LinearGradientBrush
  450.  
  451.     Protected Sub DrawCorners(ByVal c As Color, ByVal rect As Rectangle)
  452.         If _NoRounding Then Return
  453.         B.SetPixel(rect.X, rect.Y, c)
  454.         B.SetPixel(rect.X + (rect.Width - 1), rect.Y, c)
  455.         B.SetPixel(rect.X, rect.Y + (rect.Height - 1), c)
  456.         B.SetPixel(rect.X + (rect.Width - 1), rect.Y + (rect.Height - 1), c)
  457.     End Sub
  458.  
  459.     Protected Sub DrawBorders(ByVal p1 As Pen, ByVal p2 As Pen, ByVal rect As Rectangle)
  460.         G.DrawRectangle(p1, rect.X, rect.Y, rect.Width - 1, rect.Height - 1)
  461.         G.DrawRectangle(p2, rect.X + 1, rect.Y + 1, rect.Width - 3, rect.Height - 3)
  462.     End Sub
  463.  
  464.     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)
  465.         _Rectangle = New Rectangle(x, y, width, height)
  466.         _Gradient = New LinearGradientBrush(_Rectangle, c1, c2, angle)
  467.         G.FillRectangle(_Gradient, _Rectangle)
  468.     End Sub
  469. #End Region
  470.  
  471. End Class
  472.  
  473. Class STheme
  474.     Inherits Theme
  475.  
  476.     Sub New()
  477.         MoveHeight = 16
  478.         TransparencyKey = Color.Fuchsia
  479.     End Sub
  480.  
  481.     Public Overrides Sub PaintHook()
  482.         G.Clear(Color.SteelBlue)
  483.  
  484.         DrawGradient(Color.DodgerBlue, Color.SteelBlue, 0, 0, Width, 24, 180S)
  485.         G.DrawLine(Pens.Black, 0, 24, Width, 24)
  486.  
  487.         DrawText(HorizontalAlignment.Left, Color.Black, 4)
  488.         DrawBorders(Pens.Black, Pens.LightGray, ClientRectangle)
  489.         DrawCorners(Color.Fuchsia, ClientRectangle)
  490.     End Sub
  491. End Class
  492.  
  493. Class SButton
  494.     Inherits ThemeControl
  495.  
  496.     Sub New()
  497.  
  498.     End Sub
  499.  
  500.     Public Overrides Sub PaintHook()
  501.  
  502.         Select Case MouseState
  503.             Case State.MouseNone
  504.                 G.Clear(Color.SteelBlue)
  505.             Case State.MouseDown
  506.                 G.Clear(Color.DodgerBlue)
  507.         End Select
  508.  
  509.         DrawText(HorizontalAlignment.Center, Color.Black, 0)
  510.         DrawBorders(Pens.Black, Pens.LightGray, ClientRectangle)
  511.         DrawCorners(BackColor, ClientRectangle)
  512.     End Sub
  513. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement