Hallo alle zusammen,
ich dachte ich stelle hier mal meine BinärUhr rein, damit sie jeder bei bedarf benutzen kann.
Die Uhr ist ein eigenes Control, was nur in die Form gezogen werden muss, den Rest erledigt sich dann schon von selber.
Hier noch den Code dazu, ansonsten befinden sich alle Datein im Anhang
Spoiler anzeigen
//EDIT: Code Aktualisiert, Bild Aktualisiert, Dateianhang Aktualisiert
Vielen dank an @us4711 ohne dich wäre das Control nie so gut geworden
ich dachte ich stelle hier mal meine BinärUhr rein, damit sie jeder bei bedarf benutzen kann.
Die Uhr ist ein eigenes Control, was nur in die Form gezogen werden muss, den Rest erledigt sich dann schon von selber.
Hier noch den Code dazu, ansonsten befinden sich alle Datein im Anhang
VB.NET-Quellcode
- Option Strict On
- Option Explicit On
- Imports System.Drawing
- Imports System.Windows.Forms
- Imports System.Drawing.Drawing2D
- Imports System.ComponentModel
- Public Class BinaryClockControl
- Inherits Control
- #Region " Instance variables "
- Protected m_BorderRadius As Single = 3
- Protected m_BorderColor As Color = SystemColors.ControlDarkDark
- Protected m_ColorTop As Color = SystemColors.ControlDark
- Protected m_ColorBottom As Color = SystemColors.ControlLight
- Protected m_Activated As Boolean = False
- Protected m_AllowDesignTimeAction As Boolean = False
- Protected m_TrueCenterColor As Color = Color.White
- Protected m_TrueSurroundColor As Color() = {Color.Green}
- Protected m_FalseCenterColor As Color = Color.White
- Protected m_FalseSurroundColor As Color() = {Color.Red}
- Public WithEvents m_Timer As New Timers.Timer With {.Interval = 1000}
- Protected m_OriginalWidth As Int32 = 152
- Protected m_OriginalHeight As Int32 = 76
- Protected m_Padding As Padding = New Padding(7)
- Protected m_FactorX As Single = 1.0
- Protected m_FactorY As Single = 1.0
- #End Region
- #Region " Initializing "
- Public Sub New()
- MyBase.New()
- MyBase.SetStyle(ControlStyles.CacheText Or ControlStyles.DoubleBuffer Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.SupportsTransparentBackColor, True)
- MyBase.UpdateStyles()
- With Me
- .Size = New Size(m_OriginalWidth, m_OriginalHeight)
- .MinimumSize = .Size
- End With
- End Sub
- #End Region
- #Region " Properties "
- <Category("BinaryClock")>
- <Description("Setzt den Linken und oberen Abstand der Zeitzeichen.")>
- Public Overloads Property Padding As Padding
- Get
- Return m_Padding
- End Get
- Set(ByVal value As Padding)
- m_Padding = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Startet oder stoppt die Animation.")>
- Public Property Activated As Boolean
- Get
- Return m_Activated
- End Get
- Set(ByVal value As Boolean)
- m_Activated = value
- If m_Activated AndAlso ((Me.DesignMode AndAlso Me.AllowDesignTimeAction) OrElse Not Me.DesignMode) Then
- m_Timer.Start()
- Else
- m_Timer.Stop()
- End If
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Gibt an, ob die Animation auch zur Designzeit aktiviert ist.")>
- Public Property AllowDesignTimeAction As Boolean
- Get
- Return m_AllowDesignTimeAction
- End Get
- Set(ByVal value As Boolean)
- m_AllowDesignTimeAction = value
- Me.Activated = Me.Activated
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Anfangsfarbe des Hintergrundfarbverlaufs.")>
- Public Property ColorTop As Color
- Get
- Return m_ColorTop
- End Get
- Set(ByVal value As Color)
- m_ColorTop = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Endfarbe des Hintergrundfarbverlaufs.")>
- Public Property ColorBottom As Color
- Get
- Return m_ColorBottom
- End Get
- Set(ByVal value As Color)
- m_ColorBottom = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Farbe des Rahmens.")>
- Public Property BorderColor As Color
- Get
- Return m_BorderColor
- End Get
- Set(ByVal value As Color)
- m_BorderColor = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Centerfarbe vom True Image")>
- Public Property TrueCenterColor As Color
- Get
- Return m_TrueCenterColor
- End Get
- Set(ByVal value As Color)
- m_TrueCenterColor = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Surroundfarbe vom True Image")>
- Public Property TrueSurroundColor As Color()
- Get
- Return m_TrueSurroundColor
- End Get
- Set(ByVal value As Color())
- m_TrueSurroundColor = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Centerfarbe vom False Image")>
- Public Property FalseCenterColor As Color
- Get
- Return m_FalseCenterColor
- End Get
- Set(ByVal value As Color)
- m_FalseCenterColor = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Surroundfarbe vom False Image")>
- Public Property FalseSurroundColor As Color()
- Get
- Return m_FalseSurroundColor
- End Get
- Set(ByVal value As Color())
- m_FalseSurroundColor = value
- Me.Invalidate()
- End Set
- End Property
- <Category("BinaryClock")>
- <Description("Radius der Abrundung des Rahmens in Pixel.")>
- Public Property BorderRadius As Single
- Get
- Return m_BorderRadius
- End Get
- Set(ByVal value As Single)
- m_BorderRadius = value
- Me.Invalidate()
- End Set
- End Property
- #End Region
- #Region " Eventhandler "
- Protected Overrides Sub OnResize(ByVal e As EventArgs)
- MyBase.OnResize(e)
- Me.m_FactorX = CSng(Me.Width / m_OriginalWidth)
- Me.m_FactorY = CSng(Me.Height / m_OriginalHeight)
- End Sub
- Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
- MyBase.OnPaint(e)
- With e.Graphics
- .SmoothingMode = SmoothingMode.HighQuality
- End With
- Dim m_r As Rectangle
- With e.ClipRectangle
- m_r = New Rectangle(0, 0, .Width - 1, .Height - 1)
- End With
- If m_r.Width = 0 OrElse m_r.Height = 0 Then
- Return
- End If
- Dim m_BoolList = GetBinaryValues(Now.Hour, Now.Minute, Now.Second)
- DrawFillRoundedRectangle(e.Graphics, m_r, Me.BorderRadius, Me.BorderColor, New LinearGradientBrush(m_r, Me.ColorTop, Me.ColorBottom, LinearGradientMode.Vertical))
- Dim m_temp As Integer = 0
- Dim m_CenterColor As Color = Nothing
- Dim m_SurroundColors() As Color = Nothing
- For Zeile As Integer = 0 To 2 Step 1
- For Spalte As Integer = 0 To 5 Step 1
- Select Case m_BoolList(m_temp)
- Case True
- m_CenterColor = Me.TrueCenterColor
- m_SurroundColors = Me.TrueSurroundColor
- Case False
- m_CenterColor = Me.FalseCenterColor
- m_SurroundColors = Me.FalseSurroundColor
- End Select
- CreateColorImage(e.Graphics, New Rectangle(New Point(CInt(Me.Padding.Left * m_FactorX + Spalte * 24 * m_FactorX + Spalte * m_FactorX),
- CInt(Me.Padding.Top * m_FactorY + Zeile * 24 * m_FactorY + Zeile * m_FactorY)), New Size(CInt(10 * m_FactorX), CInt(10 * m_FactorY))), m_CenterColor, m_SurroundColors)
- m_temp += 1
- Next
- Next
- End Sub
- Protected Sub m_Timer_Elapsed(ByVal sender As Object, ByVal e As EventArgs) Handles m_Timer.Elapsed
- Me.Invalidate()
- End Sub
- #End Region
- #Region " Supporting methods "
- Protected Sub DrawFillRoundedRectangle(ByVal _g As Graphics, ByVal _r As Rectangle, ByVal _radius As Single, ByVal _borderColor As Color, ByVal _fillBrush As Brush)
- Using m_path As GraphicsPath = FillRoundedRectanglePath(_r, _radius)
- With _g
- .FillPath(_fillBrush, m_path)
- .DrawPath(New Pen(_borderColor), m_path)
- End With
- End Using
- End Sub
- Protected Function FillRoundedRectanglePath(ByVal _Rect As RectangleF, ByVal _Radius As Single) As GraphicsPath
- Dim m_GraphicsPath As New GraphicsPath
- Dim m_DiaMeter As Single = 2 * _Radius
- With m_GraphicsPath
- If _Radius < 1 Then
- .AddRectangle(_Rect)
- Else
- .AddLine(_Rect.X + _Radius, _Rect.Y, _Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y)
- .AddArc(_Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y, m_DiaMeter, m_DiaMeter, 270, 90)
- .AddLine(_Rect.X + _Rect.Width, _Rect.Y + _Radius, _Rect.X + _Rect.Width, _Rect.Y + _Rect.Height - m_DiaMeter)
- .AddArc(_Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y + _Rect.Height - m_DiaMeter, m_DiaMeter, m_DiaMeter, 0, 90)
- .AddLine(_Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y + _Rect.Height, _Rect.X + _Radius, _Rect.Y + _Rect.Height)
- .AddArc(_Rect.X, _Rect.Y + _Rect.Height - m_DiaMeter, m_DiaMeter, m_DiaMeter, 90, 90)
- .AddLine(_Rect.X, _Rect.Y + _Rect.Height - m_DiaMeter, _Rect.X, _Rect.Y + _Radius)
- .AddArc(_Rect.X, _Rect.Y, m_DiaMeter, m_DiaMeter, 180, 90)
- End If
- .CloseFigure()
- End With
- Return m_GraphicsPath
- End Function
- Protected Function GetBinaryValues(ByVal _Hours As Integer, ByVal _Minutes As Integer, ByVal _Seconds As Integer) As List(Of Boolean)
- Dim m_Value As New List(Of Boolean)
- If _Hours < 12 And _Hours > 0 Then
- m_Value.Add(True)
- Else
- m_Value.Add(False)
- End If
- For i As Int32 = 0 To 2
- Dim m_temp As String = String.Empty
- Select Case i
- Case 0
- m_temp = Convert.ToString(_Hours, 2)
- For j As Integer = (4 - m_temp.Length) To 0 Step -1
- m_Value.Add(False)
- Next
- For j As Integer = 0 To m_temp.Length - 1 Step 1
- m_Value.Add(m_temp.Substring(j, 1) = "1")
- Next
- Case 1
- m_temp = Convert.ToString(_Minutes, 2)
- For j As Integer = (5 - m_temp.Length) To 0 Step -1
- m_Value.Add(False)
- Next
- For j As Integer = 0 To m_temp.Length - 1 Step 1
- m_Value.Add(m_temp.Substring(j, 1) = "1")
- Next
- Case 2
- m_temp = Convert.ToString(_Seconds, 2)
- For j As Integer = (5 - m_temp.Length) To 0 Step -1
- m_Value.Add(False)
- Next
- For j As Integer = 0 To m_temp.Length - 1 Step 1
- m_Value.Add(m_temp.Substring(j, 1) = "1")
- Next
- End Select
- Next
- Return m_Value
- End Function
- Protected Sub CreateColorImage(ByVal _G As Graphics, ByVal _Rect As Rectangle, ByVal _CenterColor As Color, ByVal _SurroundColor As Color())
- Dim m_GraphicsPath As New GraphicsPath
- m_GraphicsPath.AddEllipse(_Rect)
- Dim m_PGB As PathGradientBrush = New PathGradientBrush(m_GraphicsPath)
- m_PGB.CenterColor = _CenterColor
- m_PGB.SurroundColors = _SurroundColor
- m_PGB.CenterPoint = New Point(_Rect.X + CInt(_Rect.Width / 2), _Rect.Y + CInt(_Rect.Height / 3))
- _G.FillEllipse(m_PGB, _Rect)
- m_GraphicsPath.Dispose()
- End Sub
- #End Region
- End Class
//EDIT: Code Aktualisiert, Bild Aktualisiert, Dateianhang Aktualisiert
Vielen dank an @us4711 ohne dich wäre das Control nie so gut geworden
Keep Calm And Color Your Life
Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „Cypress“ ()