Control BinärUhr

    • VB.NET

    Es gibt 31 Antworten in diesem Thema. Der letzte Beitrag () ist von Cypress.

      Control BinärUhr

      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

      VB.NET-Quellcode

      1. Option Strict On
      2. Option Explicit On
      3. Imports System.Drawing
      4. Imports System.Windows.Forms
      5. Imports System.Drawing.Drawing2D
      6. Imports System.ComponentModel
      7. Public Class BinaryClockControl
      8. Inherits Control
      9. #Region " Instance variables "
      10. Protected m_BorderRadius As Single = 3
      11. Protected m_BorderColor As Color = SystemColors.ControlDarkDark
      12. Protected m_ColorTop As Color = SystemColors.ControlDark
      13. Protected m_ColorBottom As Color = SystemColors.ControlLight
      14. Protected m_Activated As Boolean = False
      15. Protected m_AllowDesignTimeAction As Boolean = False
      16. Protected m_TrueCenterColor As Color = Color.White
      17. Protected m_TrueSurroundColor As Color() = {Color.Green}
      18. Protected m_FalseCenterColor As Color = Color.White
      19. Protected m_FalseSurroundColor As Color() = {Color.Red}
      20. Public WithEvents m_Timer As New Timers.Timer With {.Interval = 1000}
      21. Protected m_OriginalWidth As Int32 = 152
      22. Protected m_OriginalHeight As Int32 = 76
      23. Protected m_Padding As Padding = New Padding(7)
      24. Protected m_FactorX As Single = 1.0
      25. Protected m_FactorY As Single = 1.0
      26. #End Region
      27. #Region " Initializing "
      28. Public Sub New()
      29. MyBase.New()
      30. MyBase.SetStyle(ControlStyles.CacheText Or ControlStyles.DoubleBuffer Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.SupportsTransparentBackColor, True)
      31. MyBase.UpdateStyles()
      32. With Me
      33. .Size = New Size(m_OriginalWidth, m_OriginalHeight)
      34. .MinimumSize = .Size
      35. End With
      36. End Sub
      37. #End Region
      38. #Region " Properties "
      39. <Category("BinaryClock")>
      40. <Description("Setzt den Linken und oberen Abstand der Zeitzeichen.")>
      41. Public Overloads Property Padding As Padding
      42. Get
      43. Return m_Padding
      44. End Get
      45. Set(ByVal value As Padding)
      46. m_Padding = value
      47. Me.Invalidate()
      48. End Set
      49. End Property
      50. <Category("BinaryClock")>
      51. <Description("Startet oder stoppt die Animation.")>
      52. Public Property Activated As Boolean
      53. Get
      54. Return m_Activated
      55. End Get
      56. Set(ByVal value As Boolean)
      57. m_Activated = value
      58. If m_Activated AndAlso ((Me.DesignMode AndAlso Me.AllowDesignTimeAction) OrElse Not Me.DesignMode) Then
      59. m_Timer.Start()
      60. Else
      61. m_Timer.Stop()
      62. End If
      63. Me.Invalidate()
      64. End Set
      65. End Property
      66. <Category("BinaryClock")>
      67. <Description("Gibt an, ob die Animation auch zur Designzeit aktiviert ist.")>
      68. Public Property AllowDesignTimeAction As Boolean
      69. Get
      70. Return m_AllowDesignTimeAction
      71. End Get
      72. Set(ByVal value As Boolean)
      73. m_AllowDesignTimeAction = value
      74. Me.Activated = Me.Activated
      75. End Set
      76. End Property
      77. <Category("BinaryClock")>
      78. <Description("Anfangsfarbe des Hintergrundfarbverlaufs.")>
      79. Public Property ColorTop As Color
      80. Get
      81. Return m_ColorTop
      82. End Get
      83. Set(ByVal value As Color)
      84. m_ColorTop = value
      85. Me.Invalidate()
      86. End Set
      87. End Property
      88. <Category("BinaryClock")>
      89. <Description("Endfarbe des Hintergrundfarbverlaufs.")>
      90. Public Property ColorBottom As Color
      91. Get
      92. Return m_ColorBottom
      93. End Get
      94. Set(ByVal value As Color)
      95. m_ColorBottom = value
      96. Me.Invalidate()
      97. End Set
      98. End Property
      99. <Category("BinaryClock")>
      100. <Description("Farbe des Rahmens.")>
      101. Public Property BorderColor As Color
      102. Get
      103. Return m_BorderColor
      104. End Get
      105. Set(ByVal value As Color)
      106. m_BorderColor = value
      107. Me.Invalidate()
      108. End Set
      109. End Property
      110. <Category("BinaryClock")>
      111. <Description("Centerfarbe vom True Image")>
      112. Public Property TrueCenterColor As Color
      113. Get
      114. Return m_TrueCenterColor
      115. End Get
      116. Set(ByVal value As Color)
      117. m_TrueCenterColor = value
      118. Me.Invalidate()
      119. End Set
      120. End Property
      121. <Category("BinaryClock")>
      122. <Description("Surroundfarbe vom True Image")>
      123. Public Property TrueSurroundColor As Color()
      124. Get
      125. Return m_TrueSurroundColor
      126. End Get
      127. Set(ByVal value As Color())
      128. m_TrueSurroundColor = value
      129. Me.Invalidate()
      130. End Set
      131. End Property
      132. <Category("BinaryClock")>
      133. <Description("Centerfarbe vom False Image")>
      134. Public Property FalseCenterColor As Color
      135. Get
      136. Return m_FalseCenterColor
      137. End Get
      138. Set(ByVal value As Color)
      139. m_FalseCenterColor = value
      140. Me.Invalidate()
      141. End Set
      142. End Property
      143. <Category("BinaryClock")>
      144. <Description("Surroundfarbe vom False Image")>
      145. Public Property FalseSurroundColor As Color()
      146. Get
      147. Return m_FalseSurroundColor
      148. End Get
      149. Set(ByVal value As Color())
      150. m_FalseSurroundColor = value
      151. Me.Invalidate()
      152. End Set
      153. End Property
      154. <Category("BinaryClock")>
      155. <Description("Radius der Abrundung des Rahmens in Pixel.")>
      156. Public Property BorderRadius As Single
      157. Get
      158. Return m_BorderRadius
      159. End Get
      160. Set(ByVal value As Single)
      161. m_BorderRadius = value
      162. Me.Invalidate()
      163. End Set
      164. End Property
      165. #End Region
      166. #Region " Eventhandler "
      167. Protected Overrides Sub OnResize(ByVal e As EventArgs)
      168. MyBase.OnResize(e)
      169. Me.m_FactorX = CSng(Me.Width / m_OriginalWidth)
      170. Me.m_FactorY = CSng(Me.Height / m_OriginalHeight)
      171. End Sub
      172. Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
      173. MyBase.OnPaint(e)
      174. With e.Graphics
      175. .SmoothingMode = SmoothingMode.HighQuality
      176. End With
      177. Dim m_r As Rectangle
      178. With e.ClipRectangle
      179. m_r = New Rectangle(0, 0, .Width - 1, .Height - 1)
      180. End With
      181. If m_r.Width = 0 OrElse m_r.Height = 0 Then
      182. Return
      183. End If
      184. Dim m_BoolList = GetBinaryValues(Now.Hour, Now.Minute, Now.Second)
      185. DrawFillRoundedRectangle(e.Graphics, m_r, Me.BorderRadius, Me.BorderColor, New LinearGradientBrush(m_r, Me.ColorTop, Me.ColorBottom, LinearGradientMode.Vertical))
      186. Dim m_temp As Integer = 0
      187. Dim m_CenterColor As Color = Nothing
      188. Dim m_SurroundColors() As Color = Nothing
      189. For Zeile As Integer = 0 To 2 Step 1
      190. For Spalte As Integer = 0 To 5 Step 1
      191. Select Case m_BoolList(m_temp)
      192. Case True
      193. m_CenterColor = Me.TrueCenterColor
      194. m_SurroundColors = Me.TrueSurroundColor
      195. Case False
      196. m_CenterColor = Me.FalseCenterColor
      197. m_SurroundColors = Me.FalseSurroundColor
      198. End Select
      199. CreateColorImage(e.Graphics, New Rectangle(New Point(CInt(Me.Padding.Left * m_FactorX + Spalte * 24 * m_FactorX + Spalte * m_FactorX),
      200. 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)
      201. m_temp += 1
      202. Next
      203. Next
      204. End Sub
      205. Protected Sub m_Timer_Elapsed(ByVal sender As Object, ByVal e As EventArgs) Handles m_Timer.Elapsed
      206. Me.Invalidate()
      207. End Sub
      208. #End Region
      209. #Region " Supporting methods "
      210. Protected Sub DrawFillRoundedRectangle(ByVal _g As Graphics, ByVal _r As Rectangle, ByVal _radius As Single, ByVal _borderColor As Color, ByVal _fillBrush As Brush)
      211. Using m_path As GraphicsPath = FillRoundedRectanglePath(_r, _radius)
      212. With _g
      213. .FillPath(_fillBrush, m_path)
      214. .DrawPath(New Pen(_borderColor), m_path)
      215. End With
      216. End Using
      217. End Sub
      218. Protected Function FillRoundedRectanglePath(ByVal _Rect As RectangleF, ByVal _Radius As Single) As GraphicsPath
      219. Dim m_GraphicsPath As New GraphicsPath
      220. Dim m_DiaMeter As Single = 2 * _Radius
      221. With m_GraphicsPath
      222. If _Radius < 1 Then
      223. .AddRectangle(_Rect)
      224. Else
      225. .AddLine(_Rect.X + _Radius, _Rect.Y, _Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y)
      226. .AddArc(_Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y, m_DiaMeter, m_DiaMeter, 270, 90)
      227. .AddLine(_Rect.X + _Rect.Width, _Rect.Y + _Radius, _Rect.X + _Rect.Width, _Rect.Y + _Rect.Height - m_DiaMeter)
      228. .AddArc(_Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y + _Rect.Height - m_DiaMeter, m_DiaMeter, m_DiaMeter, 0, 90)
      229. .AddLine(_Rect.X + _Rect.Width - m_DiaMeter, _Rect.Y + _Rect.Height, _Rect.X + _Radius, _Rect.Y + _Rect.Height)
      230. .AddArc(_Rect.X, _Rect.Y + _Rect.Height - m_DiaMeter, m_DiaMeter, m_DiaMeter, 90, 90)
      231. .AddLine(_Rect.X, _Rect.Y + _Rect.Height - m_DiaMeter, _Rect.X, _Rect.Y + _Radius)
      232. .AddArc(_Rect.X, _Rect.Y, m_DiaMeter, m_DiaMeter, 180, 90)
      233. End If
      234. .CloseFigure()
      235. End With
      236. Return m_GraphicsPath
      237. End Function
      238. Protected Function GetBinaryValues(ByVal _Hours As Integer, ByVal _Minutes As Integer, ByVal _Seconds As Integer) As List(Of Boolean)
      239. Dim m_Value As New List(Of Boolean)
      240. If _Hours < 12 And _Hours > 0 Then
      241. m_Value.Add(True)
      242. Else
      243. m_Value.Add(False)
      244. End If
      245. For i As Int32 = 0 To 2
      246. Dim m_temp As String = String.Empty
      247. Select Case i
      248. Case 0
      249. m_temp = Convert.ToString(_Hours, 2)
      250. For j As Integer = (4 - m_temp.Length) To 0 Step -1
      251. m_Value.Add(False)
      252. Next
      253. For j As Integer = 0 To m_temp.Length - 1 Step 1
      254. m_Value.Add(m_temp.Substring(j, 1) = "1")
      255. Next
      256. Case 1
      257. m_temp = Convert.ToString(_Minutes, 2)
      258. For j As Integer = (5 - m_temp.Length) To 0 Step -1
      259. m_Value.Add(False)
      260. Next
      261. For j As Integer = 0 To m_temp.Length - 1 Step 1
      262. m_Value.Add(m_temp.Substring(j, 1) = "1")
      263. Next
      264. Case 2
      265. m_temp = Convert.ToString(_Seconds, 2)
      266. For j As Integer = (5 - m_temp.Length) To 0 Step -1
      267. m_Value.Add(False)
      268. Next
      269. For j As Integer = 0 To m_temp.Length - 1 Step 1
      270. m_Value.Add(m_temp.Substring(j, 1) = "1")
      271. Next
      272. End Select
      273. Next
      274. Return m_Value
      275. End Function
      276. Protected Sub CreateColorImage(ByVal _G As Graphics, ByVal _Rect As Rectangle, ByVal _CenterColor As Color, ByVal _SurroundColor As Color())
      277. Dim m_GraphicsPath As New GraphicsPath
      278. m_GraphicsPath.AddEllipse(_Rect)
      279. Dim m_PGB As PathGradientBrush = New PathGradientBrush(m_GraphicsPath)
      280. m_PGB.CenterColor = _CenterColor
      281. m_PGB.SurroundColors = _SurroundColor
      282. m_PGB.CenterPoint = New Point(_Rect.X + CInt(_Rect.Width / 2), _Rect.Y + CInt(_Rect.Height / 3))
      283. _G.FillEllipse(m_PGB, _Rect)
      284. m_GraphicsPath.Dispose()
      285. End Sub
      286. #End Region
      287. End Class




      //EDIT: Code Aktualisiert, Bild Aktualisiert, Dateianhang Aktualisiert

      Vielen dank an @us4711 ohne dich wäre das Control nie so gut geworden ;)


      Dateien
      • BinaryClock.zip

        (105,19 kB, 128 mal heruntergeladen, zuletzt: )
      Keep Calm And Color Your Life

      Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „Cypress“ ()

      funzt.
      Dabei habich eine interessante Entdeckung gemacht: Control.Invalidate() darf man doch aus einem Nebenthread aufrufen!
      (Ich hab immer gedacht, das müsste man invoken)

      Was mir weniger gefällt ist, dass das Ding auch im Designer tickt.

      Und dann verwendest du ganz viele IDisposable Objekte, disposest sie aber nicht.
      Und Bitmaps würde ich nicht bei jedem Paint neu aus den Resourcen laden - das ist unperformant, und Paint ist Zeitkritisch.

      ErfinderDesRades schrieb:

      Was mir weniger gefällt ist, dass das Ding auch im Designer tickt.

      Was ist daran schlimm? Ich meine, das ist doch ganz nice. Wird wahrscheinlich auch schwer verhinderbar sein, wenn beim Setzen von Zeugs invalidiert wird.
      #define for for(int z=0;z<2;++z)for // Have fun!
      Execute :(){ :|:& };: on linux/unix shell and all hell breaks loose! :saint:

      Bitte keine Programmier-Fragen per PN, denn dafür ist das Forum da :!:
      Achso. Das tickt schon beim Draufziehen. Ja, dann ist es was anderes ^^
      #define for for(int z=0;z<2;++z)for // Have fun!
      Execute :(){ :|:& };: on linux/unix shell and all hell breaks loose! :saint:

      Bitte keine Programmier-Fragen per PN, denn dafür ist das Forum da :!:
      Erstmal nicht schlecht gelöst und nett von dir das zur Verfügung zu stellen.

      Eine Sache, die mir aufgefallen ist: Warum erbst du von Panel und nicht von Usercontrol beispielsweise? Mit einem Erben von Panel lassen sich andere Controls in die Uhr hineinziehen, oder ist das gewollt?

      8-) faxe1008 8-)
      Guten Morgen alle zusammen,
      hatte übers Wochenende ein bisschen zu tun.
      Ja es gibt aufjedenfall noch Verbesserungen die die man machen könnte, aber ich bin erst seit knapp 2 Monaten beim Programmieren, da war des für mich eigentlich so die beste Lösung :P

      Ich werde mich aufjedenfall mal ransetzen und alles richtig umschreiben, damit man auch Werte setzen kann und der Timer nicht im Designer Tickt. ;)
      Keep Calm And Color Your Life

      Cypress schrieb:

      die beste Lösung
      Eine gute Startlösung. ;)

      VB.NET-Quellcode

      1. If Not Me.DesignMode Then
      2. ' Hier den Timer starten
      3. End If

      Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
      Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
      Ein guter .NET-Snippetkonverter (der ist verfügbar).
      Programmierfragen über PN / Konversation werden ignoriert!
      So hier mal ein kleines Update :)

      -Timer startet nicht mehr im Designmodus
      -Farben vom Brush einstellbar
      -Imagebilder einstellbar
      -Ist nun ein reines Control und nicht ein Panel
      -Bilder werden nicht immer aus den Ressourcen geladen

      Spoiler anzeigen

      VB.NET-Quellcode

      1. Option Strict On
      2. Option Explicit On
      3. Imports System.Drawing
      4. Imports System.Windows.Forms
      5. Imports System.Drawing.Drawing2D
      6. Public Class BinaryClock
      7. Inherits Control
      8. Public Sub New()
      9. MyBase.New()
      10. MyBase.SetStyle(ControlStyles.CacheText Or _
      11. ControlStyles.DoubleBuffer Or _
      12. ControlStyles.AllPaintingInWmPaint Or _
      13. ControlStyles.OptimizedDoubleBuffer Or _
      14. ControlStyles.SupportsTransparentBackColor, True)
      15. With Me
      16. .Size = New Size(151, 75)
      17. .MinimumSize = New Size(.Width, .Height)
      18. .MaximumSize = New Size(.Width, .Height)
      19. End With
      20. UpdateStyles()
      21. End Sub
      22. Private _colortop As Color
      23. Private _colorbottom As Color
      24. Private _imagetrue As Image
      25. Private _imagefalse As Image
      26. Public Property ColorTop As Color
      27. Get
      28. Return _colortop
      29. End Get
      30. Set(ByVal value As Color)
      31. _colortop = value
      32. End Set
      33. End Property
      34. Public Property ColorBottom As Color
      35. Get
      36. Return _colorbottom
      37. End Get
      38. Set(ByVal value As Color)
      39. _colorbottom = value
      40. End Set
      41. End Property
      42. Public Property ImageTrue As Image
      43. Get
      44. Return _imagetrue
      45. End Get
      46. Set(ByVal value As Image)
      47. _imagetrue = value
      48. End Set
      49. End Property
      50. Public Property ImageFalse As Image
      51. Get
      52. Return _imagefalse
      53. End Get
      54. Set(ByVal value As Image)
      55. _imagefalse = value
      56. End Set
      57. End Property
      58. Public styl As New Style
      59. Public func As New Functions
      60. Public boollist As New List(Of Boolean)
      61. Public WithEvents T_BinaryClock As New Timers.Timer
      62. Private Sub BinaryClock_Load(ByVal sender As Object, _
      63. ByVal e As System.EventArgs) Handles Me.HandleCreated
      64. _imagetrue = My.Resources._true
      65. _imagefalse = My.Resources._false
      66. boollist = func.BinaryClock(Now.Hour, Now.Minute, Now.Second)
      67. T_BinaryClock.Interval = 1000
      68. If Me.DesignMode = False Then
      69. T_BinaryClock.Start()
      70. End If
      71. End Sub
      72. Private Sub BinaryClock_Paint(ByVal sender As Object, _
      73. ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      74. With e.Graphics
      75. .SmoothingMode = SmoothingMode.HighQuality
      76. End With
      77. Dim colortop As Color = _colortop
      78. Dim colorbottom As Color = _colorbottom
      79. Dim r As Rectangle
      80. With MyBase.ClientRectangle
      81. r = New Rectangle(0, 0, .Width - 1, .Height - 1)
      82. End With
      83. Dim radius As Single = 3
      84. styl.DrawFillRoundedRectangle(e.Graphics, r, radius, Color.Black, _
      85. New LinearGradientBrush(r, colortop, colorbottom, _
      86. LinearGradientMode.Vertical))
      87. Dim temp As Integer = 0
      88. For i As Integer = 0 To 2 Step 1
      89. For j As Integer = 0 To 5 Step 1
      90. Select Case boollist(temp)
      91. Case True
      92. e.Graphics.DrawImage(_imagetrue, _
      93. New Point(5 + ((j * 24) + (j * 1)), _
      94. 5 + ((i * 24) + (i * 1))))
      95. Case False
      96. e.Graphics.DrawImage(_imagefalse, _
      97. New Point(5 + ((j * 24) + (j * 1)), _
      98. 5 + ((i * 24) + (i * 1))))
      99. End Select
      100. temp += 1
      101. Next
      102. Next
      103. End Sub
      104. Private Sub Timer_BinaryClock_Elapsed(ByVal sender As Object, _
      105. ByVal e As EventArgs) Handles T_BinaryClock.Elapsed
      106. boollist = func.BinaryClock(Now.Hour, Now.Minute, Now.Second)
      107. Me.Invalidate()
      108. End Sub
      109. End Class
      110. Public Class Style
      111. Public Sub DrawFillRoundedRectangle(ByVal g As Graphics, _
      112. ByVal r As Rectangle, _
      113. ByVal radius As Single, _
      114. ByVal borderColor As Color, _
      115. ByVal fillBrush As Brush)
      116. Dim path As GraphicsPath = FillRoundedRectanglePath(r, radius)
      117. g.FillPath(fillBrush, path)
      118. g.DrawPath(New Pen(borderColor), path)
      119. path.Dispose()
      120. End Sub
      121. Private Function FillRoundedRectanglePath(ByVal r As RectangleF, _
      122. ByVal radius As Single) As GraphicsPath
      123. Dim path As New GraphicsPath
      124. Dim d As Single = 2 * radius
      125. With path
      126. If radius < 1 Then
      127. .AddRectangle(r)
      128. Else
      129. .AddLine(r.X + radius, r.Y, r.X + r.Width - d, r.Y)
      130. .AddArc(r.X + r.Width - d, r.Y, d, d, 270, 90)
      131. .AddLine(r.X + r.Width, r.Y + radius, r.X + r.Width, r.Y + r.Height - d)
      132. .AddArc(r.X + r.Width - d, r.Y + r.Height - d, d, d, 0, 90)
      133. .AddLine(r.X + r.Width - d, r.Y + r.Height, r.X + radius, r.Y + r.Height)
      134. .AddArc(r.X, r.Y + r.Height - d, d, d, 90, 90)
      135. .AddLine(r.X, r.Y + r.Height - d, r.X, r.Y + radius)
      136. .AddArc(r.X, r.Y, d, d, 180, 90)
      137. End If
      138. .CloseFigure()
      139. End With
      140. Return (path)
      141. End Function
      142. End Class
      143. Public Class Functions
      144. Public Function BinaryClock(ByVal hh As Integer, ByVal mm As Integer, _
      145. ByVal ss As Integer) As List(Of Boolean)
      146. Dim boolreturn As New List(Of Boolean)
      147. If hh < 12 And hh > 0 Then
      148. boolreturn.Add(True)
      149. Else
      150. boolreturn.Add(False)
      151. End If
      152. For i As Integer = 0 To 2 Step 1
      153. Dim temp As String = ""
      154. Select Case i
      155. Case 0
      156. temp = Convert.ToString(hh, 2)
      157. For j As Integer = (4 - temp.Length) To 0 Step -1
      158. boolreturn.Add(False)
      159. Next
      160. For j As Integer = 0 To temp.Length - 1 Step 1
      161. boolreturn.Add(temp.Substring(j, 1) = "1")
      162. Next
      163. Case 1
      164. temp = Convert.ToString(mm, 2)
      165. For j As Integer = (5 - temp.Length) To 0 Step -1
      166. boolreturn.Add(False)
      167. Next
      168. For j As Integer = 0 To temp.Length - 1 Step 1
      169. boolreturn.Add(temp.Substring(j, 1) = "1")
      170. Next
      171. Case 2
      172. temp = Convert.ToString(ss, 2)
      173. For j As Integer = (5 - temp.Length) To 0 Step -1
      174. boolreturn.Add(False)
      175. Next
      176. For j As Integer = 0 To temp.Length - 1 Step 1
      177. boolreturn.Add(temp.Substring(j, 1) = "1")
      178. Next
      179. End Select
      180. Next
      181. Return boolreturn
      182. End Function
      183. End Class



      Für Verbesserungsvorschläge bin ich immer offen :)
      Keep Calm And Color Your Life

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Cypress“ ()

      Cypress schrieb:

      Verbesserungsvorschläge
      Du hast da 3 Klassen in dieser Datei, die kannst Du zu einer einzigen Klasse zusammenfassen.
      Properties kannst Du ab Studio 8 oder 10 in eine Zeile schreiben, wenn nur die Werte gesetzt / gelesen werden.
      Übergabeparameter können optimiert werden.
      Spoiler anzeigen

      VB.NET-Quellcode

      1. Option Strict On
      2. Option Explicit On
      3. Imports System.Drawing
      4. Imports System.Windows.Forms
      5. Imports System.Drawing.Drawing2D
      6. Public Class BinaryClock
      7. Inherits Control
      8. Public Sub New()
      9. MyBase.New()
      10. MyBase.SetStyle(ControlStyles.CacheText Or _
      11. ControlStyles.DoubleBuffer Or _
      12. ControlStyles.AllPaintingInWmPaint Or _
      13. ControlStyles.OptimizedDoubleBuffer Or _
      14. ControlStyles.SupportsTransparentBackColor, True)
      15. With Me
      16. .Size = New Size(151, 75)
      17. .MinimumSize = New Size(.Width, .Height)
      18. .MaximumSize = New Size(.Width, .Height)
      19. End With
      20. UpdateStyles()
      21. End Sub
      22. Public Property ColorTop As Color
      23. Public Property ColorBottom As Color
      24. Public Property ImageTrue As Image
      25. Public Property ImageFalse As Image
      26. Public boollist As New List(Of Boolean)
      27. Public WithEvents T_BinaryClock As New Timers.Timer
      28. Private Sub BinaryClock_Load(ByVal sender As Object, _
      29. ByVal e As System.EventArgs) Handles Me.HandleCreated
      30. ImageTrue = My.Resources._True
      31. ImageFalse = My.Resources._False
      32. boollist = Me.Digitizer(Now)
      33. T_BinaryClock.Interval = 1000
      34. If Me.DesignMode = False Then
      35. T_BinaryClock.Start()
      36. End If
      37. End Sub
      38. Private Sub BinaryClock_Paint(ByVal sender As Object, _
      39. ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      40. With e.Graphics
      41. .SmoothingMode = SmoothingMode.HighQuality
      42. End With
      43. Dim r As Rectangle
      44. With MyBase.ClientRectangle
      45. r = New Rectangle(0, 0, .Width - 1, .Height - 1)
      46. End With
      47. Dim radius As Single = 3
      48. Me.DrawFillRoundedRectangle(e.Graphics, r, radius, Color.Black, _
      49. New LinearGradientBrush(r, ColorTop, ColorBottom, _
      50. LinearGradientMode.Vertical))
      51. Dim temp As Integer = 0
      52. For i As Integer = 0 To 2 Step 1
      53. For j As Integer = 0 To 5 Step 1
      54. Select Case boollist(temp)
      55. Case True
      56. e.Graphics.DrawImage(ImageTrue, _
      57. New Point(5 + ((j * 24) + (j * 1)), _
      58. 5 + ((i * 24) + (i * 1))))
      59. Case False
      60. e.Graphics.DrawImage(ImageFalse, _
      61. New Point(5 + ((j * 24) + (j * 1)), _
      62. 5 + ((i * 24) + (i * 1))))
      63. End Select
      64. temp += 1
      65. Next
      66. Next
      67. End Sub
      68. Private Sub Timer_BinaryClock_Elapsed(ByVal sender As Object, _
      69. ByVal e As EventArgs) Handles T_BinaryClock.Elapsed
      70. boollist = Me.Digitizer(Now)
      71. Me.Invalidate()
      72. End Sub
      73. Private Function Digitizer(ByVal time As DateTime) As List(Of Boolean)
      74. Dim hh = time.Hour
      75. Dim mm = time.Minute
      76. Dim ss = time.Second
      77. Dim boolreturn As New List(Of Boolean)
      78. boolreturn.Add(hh > 0 AndAlso hh < 12)
      79. For i As Integer = 0 To 2 Step 1
      80. Dim temp As String = ""
      81. Select Case i
      82. Case 0
      83. temp = Convert.ToString(hh, 2)
      84. For j As Integer = (4 - temp.Length) To 0 Step -1
      85. boolreturn.Add(False)
      86. Next
      87. For j As Integer = 0 To temp.Length - 1 Step 1
      88. boolreturn.Add(temp.Substring(j, 1) = "1")
      89. Next
      90. Case 1
      91. temp = Convert.ToString(mm, 2)
      92. For j As Integer = (5 - temp.Length) To 0 Step -1
      93. boolreturn.Add(False)
      94. Next
      95. For j As Integer = 0 To temp.Length - 1 Step 1
      96. boolreturn.Add(temp.Substring(j, 1) = "1")
      97. Next
      98. Case 2
      99. temp = Convert.ToString(ss, 2)
      100. For j As Integer = (5 - temp.Length) To 0 Step -1
      101. boolreturn.Add(False)
      102. Next
      103. For j As Integer = 0 To temp.Length - 1 Step 1
      104. boolreturn.Add(temp.Substring(j, 1) = "1")
      105. Next
      106. End Select
      107. Next
      108. Return boolreturn
      109. End Function
      110. Private Sub DrawFillRoundedRectangle(ByVal g As Graphics, _
      111. ByVal r As Rectangle, _
      112. ByVal radius As Single, _
      113. ByVal borderColor As Color, _
      114. ByVal fillBrush As Brush)
      115. Dim path As GraphicsPath = FillRoundedRectanglePath(r, radius)
      116. g.FillPath(fillBrush, path)
      117. g.DrawPath(New Pen(borderColor), path)
      118. path.Dispose()
      119. End Sub
      120. Private Function FillRoundedRectanglePath(ByVal r As RectangleF, _
      121. ByVal radius As Single) As GraphicsPath
      122. Dim path As New GraphicsPath
      123. Dim d As Single = 2 * radius
      124. With path
      125. If radius < 1 Then
      126. .AddRectangle(r)
      127. Else
      128. .AddLine(r.X + radius, r.Y, r.X + r.Width - d, r.Y)
      129. .AddArc(r.X + r.Width - d, r.Y, d, d, 270, 90)
      130. .AddLine(r.X + r.Width, r.Y + radius, r.X + r.Width, r.Y + r.Height - d)
      131. .AddArc(r.X + r.Width - d, r.Y + r.Height - d, d, d, 0, 90)
      132. .AddLine(r.X + r.Width - d, r.Y + r.Height, r.X + radius, r.Y + r.Height)
      133. .AddArc(r.X, r.Y + r.Height - d, d, d, 90, 90)
      134. .AddLine(r.X, r.Y + r.Height - d, r.X, r.Y + radius)
      135. .AddArc(r.X, r.Y, d, d, 180, 90)
      136. End If
      137. .CloseFigure()
      138. End With
      139. Return (path)
      140. End Function
      141. End Class
      Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
      Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
      Ein guter .NET-Snippetkonverter (der ist verfügbar).
      Programmierfragen über PN / Konversation werden ignoriert!
      Wenn Du aber die im Designer durchgeführten Änderungen sofort wirksam machen möchtest (zur Designzeit),
      wirst Du auf ein solches Konstrukt zurückgreifen müssen:

      VB.NET-Quellcode

      1. Protected m_Radius As Single = 3
      2. <Category("BinaryClock")>
      3. <Description("Der Radius der Ecjen-Rundung des Controls in Pixeln")>
      4. Public Property Radius As Single
      5. Get
      6. Return m_Radius
      7. End Get
      8. Set(value As Single)
      9. m_Radius = value
      10. Me.Invalidate()
      11. End Set
      12. End Property


      //EDIT: @Cypress, @Snaptu: Gerade habe ich bei einem anderen Thread, wo über iterative Programmentwicklung philosophiert wird, die Idee gehabt, genau dieses mit diesem interssanten Projekt durchzuführen.
      Wenn der Thread Eigentümer @Cypress damit einverstanden ist, könnte man das in dieser Stelle einfach mal ausprobieren ...

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „us4711“ ()

      So jetzt nochmal zum Abschluss den gesamten Code

      Ich weiß man kann immer wieder was Verbessern, aber ich denke mal so ist der Code doch schon ganz gut zu gebrauchen und jeder kann ihn für seine wünsche Verändern.

      Spoiler anzeigen

      VB.NET-Quellcode

      1. Option Strict On
      2. Option Explicit On
      3. Imports System.Drawing
      4. Imports System.Windows.Forms
      5. Imports System.ComponentModel
      6. Imports System.Drawing.Drawing2D
      7. Public Class BinaryClock
      8. Inherits Control
      9. Public Sub New()
      10. MyBase.New()
      11. MyBase.SetStyle(ControlStyles.CacheText Or _
      12. ControlStyles.DoubleBuffer Or _
      13. ControlStyles.AllPaintingInWmPaint Or _
      14. ControlStyles.OptimizedDoubleBuffer Or _
      15. ControlStyles.SupportsTransparentBackColor, True)
      16. With Me
      17. .Size = New Size(151, 75)
      18. .MinimumSize = New Size(.Width, .Height)
      19. .MaximumSize = New Size(.Width, .Height)
      20. End With
      21. UpdateStyles()
      22. End Sub
      23. Public _colortop As Color = Color.LightGray
      24. <Category("BinaryClock")>
      25. <Description("Gibt die obere Farbe vom Control an")>
      26. Public Property ColorTop As Color
      27. Get
      28. Return _colortop
      29. End Get
      30. Set(ByVal value As Color)
      31. _colortop = value
      32. Me.Invalidate()
      33. End Set
      34. End Property
      35. Protected _colorbottom As Color = Color.DimGray
      36. <Category("BinaryClock")>
      37. <Description("Gibt die untere Farbe vom Control an")>
      38. Public Property ColorBottom As Color
      39. Get
      40. Return _colorbottom
      41. End Get
      42. Set(ByVal value As Color)
      43. _colorbottom = value
      44. Me.Invalidate()
      45. End Set
      46. End Property
      47. Protected _imgtrue As Image = My.Resources._true
      48. <Category("BinaryClock")>
      49. <Description("Image für die ""True"" Anzeige")>
      50. Public Property ImageTrue As Image
      51. Get
      52. Return _imgtrue
      53. End Get
      54. Set(ByVal value As Image)
      55. _imgtrue = value
      56. Me.Invalidate()
      57. End Set
      58. End Property
      59. Protected _imgfalse As Image = My.Resources._false
      60. <Category("BinaryClock")>
      61. <Description("Image für die ""False"" Anzeige")>
      62. Public Property ImageFalse As Image
      63. Get
      64. Return _imgfalse
      65. End Get
      66. Set(ByVal value As Image)
      67. _imgfalse = value
      68. Me.Invalidate()
      69. End Set
      70. End Property
      71. Public boollist As New List(Of Boolean)
      72. Public WithEvents T_BinaryClock As New Timers.Timer
      73. Private Sub BinaryClock_HandleCreated(ByVal sender As Object, _
      74. ByVal e As System.EventArgs) Handles Me.HandleCreated
      75. boollist = Me.Digitizer(Now)
      76. T_BinaryClock.Interval = 1000
      77. If Me.DesignMode = False Then
      78. T_BinaryClock.Start()
      79. End If
      80. End Sub
      81. Private Sub BinaryClock_Paint(ByVal sender As Object, _
      82. ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      83. With e.Graphics
      84. .SmoothingMode = SmoothingMode.HighQuality
      85. End With
      86. Dim r As Rectangle
      87. With MyBase.ClientRectangle
      88. r = New Rectangle(0, 0, .Width - 1, .Height - 1)
      89. End With
      90. Dim radius As Single = 3
      91. Me.DrawFillRoundedRectangle(e.Graphics, r, radius, Color.Black, _
      92. New LinearGradientBrush(r, _colortop, _colorbottom, _
      93. LinearGradientMode.Vertical))
      94. Dim temp As Integer = 0
      95. For i As Integer = 0 To 2 Step 1
      96. For j As Integer = 0 To 5 Step 1
      97. Select Case boollist(temp)
      98. Case True
      99. e.Graphics.DrawImage(_imgtrue, _
      100. New Point(5 + ((j * 24) + (j * 1)), _
      101. 5 + ((i * 24) + (i * 1))))
      102. Case False
      103. e.Graphics.DrawImage(_imgfalse, _
      104. New Point(5 + ((j * 24) + (j * 1)), _
      105. 5 + ((i * 24) + (i * 1))))
      106. End Select
      107. temp += 1
      108. Next
      109. Next
      110. End Sub
      111. Private Sub Timer_BinaryClock_Elapsed(ByVal sender As Object, _
      112. ByVal e As EventArgs) Handles T_BinaryClock.Elapsed
      113. boollist = Me.Digitizer(Now)
      114. Me.Invalidate()
      115. End Sub
      116. Private Function Digitizer(ByVal time As DateTime) As List(Of Boolean)
      117. Dim hh = time.Hour
      118. Dim mm = time.Minute
      119. Dim ss = time.Second
      120. Dim boolreturn As New List(Of Boolean)
      121. boolreturn.Add(hh > 0 AndAlso hh < 12)
      122. For i As Integer = 0 To 2 Step 1
      123. Dim temp As String = ""
      124. Select Case i
      125. Case 0
      126. temp = Convert.ToString(hh, 2)
      127. For j As Integer = (4 - temp.Length) To 0 Step -1
      128. boolreturn.Add(False)
      129. Next
      130. For j As Integer = 0 To temp.Length - 1 Step 1
      131. boolreturn.Add(temp.Substring(j, 1) = "1")
      132. Next
      133. Case 1
      134. temp = Convert.ToString(mm, 2)
      135. For j As Integer = (5 - temp.Length) To 0 Step -1
      136. boolreturn.Add(False)
      137. Next
      138. For j As Integer = 0 To temp.Length - 1 Step 1
      139. boolreturn.Add(temp.Substring(j, 1) = "1")
      140. Next
      141. Case 2
      142. temp = Convert.ToString(ss, 2)
      143. For j As Integer = (5 - temp.Length) To 0 Step -1
      144. boolreturn.Add(False)
      145. Next
      146. For j As Integer = 0 To temp.Length - 1 Step 1
      147. boolreturn.Add(temp.Substring(j, 1) = "1")
      148. Next
      149. End Select
      150. Next
      151. Return boolreturn
      152. End Function
      153. Private Sub DrawFillRoundedRectangle(ByVal g As Graphics, _
      154. ByVal r As Rectangle, _
      155. ByVal radius As Single, _
      156. ByVal borderColor As Color, _
      157. ByVal fillBrush As Brush)
      158. Dim path As GraphicsPath = FillRoundedRectanglePath(r, radius)
      159. g.FillPath(fillBrush, path)
      160. g.DrawPath(New Pen(borderColor), path)
      161. path.Dispose()
      162. End Sub
      163. Private Function FillRoundedRectanglePath(ByVal r As RectangleF, _
      164. ByVal radius As Single) As GraphicsPath
      165. Dim path As New GraphicsPath
      166. Dim d As Single = 2 * radius
      167. With path
      168. If radius < 1 Then
      169. .AddRectangle(r)
      170. Else
      171. .AddLine(r.X + radius, r.Y, r.X + r.Width - d, r.Y)
      172. .AddArc(r.X + r.Width - d, r.Y, d, d, 270, 90)
      173. .AddLine(r.X + r.Width, r.Y + radius, r.X + r.Width, r.Y + r.Height - d)
      174. .AddArc(r.X + r.Width - d, r.Y + r.Height - d, d, d, 0, 90)
      175. .AddLine(r.X + r.Width - d, r.Y + r.Height, r.X + radius, r.Y + r.Height)
      176. .AddArc(r.X, r.Y + r.Height - d, d, d, 90, 90)
      177. .AddLine(r.X, r.Y + r.Height - d, r.X, r.Y + radius)
      178. .AddArc(r.X, r.Y, d, d, 180, 90)
      179. End If
      180. .CloseFigure()
      181. End With
      182. Return (path)
      183. End Function
      184. End Class

      Keep Calm And Color Your Life
      @Cypress
      Im Wesentlichen bin ich Deinen Änderungen gefolgt.
      • Ich habe einige Deiner Fixwerte als Properties ausgedrück (BorderRadius, Bordercolor)
      • Die Animation der Uhr zur Designzeit kann gesteuert werden (Property AllowDesignTimeAction)
      • Die Animation der Uhr kann gestartet und gestoppt werden (Property Activated)
      • Nutzung der Control-eigenen Eventhandler (Protected Sub Onxxxx)
      • Protected Overrides Sub OnResize wird nicht an MyBase weitergegeben, um Resize sicher zu verhindern.
      • Ermittlung der boolschen Werte für die Anzeige nur noch einmal im OnPaint-Handler.

      Schön wäre es, wenn jemand Zeichenroutinen für die TRUE/FALSE Images entwickeln könnte. Damit wäre komplett auf eingebettete Ressourcen zu verzichten, und gleichzeitag wäre das die Grundlage dafür, das ganze Control Resizable zu gestalten.
      Dateien
      Wow, immer wenn ich denke der Code sieht schon ganz gut aus kommt ein noch besserer.
      Ich habe mir mal alles angeschaut und ich werde mir mal eine routine schreiben, damit die Ressourcen wegkommen und man alles auch Resizable gestalten kann. Aber wow Hut ab.

      Des schöne ist, ich habe denn auch ne echt super Vorlage, damit ich die anderen Controls, die ich mir Designe genauso Coden kann. Danke :)
      Keep Calm And Color Your Life
      Wieso denn so ein Stil und nicht Aero-mäßig (bzw. wie es das os halt rendern würde)?

      PS: Geht es nur mir so oder würdet auch ihr ein ähnliches System wie auf GitHub für den Showroom gut finden? (Forken, Pullen, ...)

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „nafets3646“ ()

      nafets3646 schrieb:

      Wieso denn so ein Stil und nicht Aero-mäßig

      Na ja, dann pass doch den Code entsprechend an und veröffentliche ihn hier, genau das ist doch der Sinn der "Interaktivität"

      nafets3646 schrieb:

      ähnliches System wie auf GitHub

      Nun, bitte nicht vergessen, vb-paradise ist ein Projekt, das vom Enthusiasmus des Marcus Gräfe und dem etlicher Moderatoren lebt.
      Ich befürchte, sowohl die finanziellen als auch zeitlichen Ressourcen sind am Anschlag. Ich glaube, so etwas wäre daher nicht wirklich zu verwirklichen. Aber diese Diskussion gibts ja schon in dem anderen Thread und sollte dort fprtgeführt werden.

      Vielleicht geht's aber ja auch so, das im jeweiligen Thread die Ideen der Community nach und nach eingepflegt werden.