Tipp 0147 Digitale Uhr
Autor/Einsender:
Datum:
  Michael Werner
15.11.2006
Entwicklungsumgebung:   VB.Net 2005
Framework:   2.0
Dieses Beispiel zeigt, wie mit GDI+-Methoden eine digitale Uhr gezeichnet werden kann. Für die Erstellung der Klasse clsDigitalClock fügt man schnell Byte-Arrays für die Ziffern, die Punkte der Ziffern als Array, ein MeasureString, eine Funktion Colon und Fill zusammen, und schon hat man (fast) alles, um eine digitale Uhr live zu zeichnen.
Code im Klassenmodul clsDigitalClock
 
Public Class clsDigitalClock

  ' Die Segmente für die 10 Ziffern
  Shared bySegment(,) As Byte = {{1, 1, 1, 0, 1, 1, 1}, _
                                 {0, 0, 1, 0, 0, 1, 0}, _
                                 {1, 0, 1, 1, 1, 0, 1}, _
                                 {1, 0, 1, 1, 0, 1, 1}, _
                                 {0, 1, 1, 1, 0, 1, 0}, _
                                 {1, 1, 0, 1, 0, 1, 1}, _
                                 {1, 1, 0, 1, 1, 1, 1}, _
                                 {1, 0, 1, 0, 0, 1, 0}, _
                                 {1, 1, 1, 1, 1, 1, 1}, _
                                 {1, 1, 1, 1, 0, 1, 1}}

  ' Die Points für die sieben Segmente
  ReadOnly apt(6)() As Point

  ' Das Graphics-Objekt
  ReadOnly g As Graphics

  ' Konstruktor
  Sub New(ByVal g As Graphics)
    Me.g = g
    ' Die gezackten Punkte der Ziffern als Array
    apt(0) = New Point() {New Point(3, 2), New Point(39, 2), _
                          New Point(31, 10), New Point(11, 10)}
    apt(1) = New Point() {New Point(2, 3), New Point(10, 11), _
                          New Point(10, 31), New Point(2, 35)}
    apt(2) = New Point() {New Point(40, 3), New Point(40, 35), _
                          New Point(32, 31), New Point(32, 11)}
    apt(3) = New Point() {New Point(3, 36), New Point(11, 32), _
                          New Point(31, 32), New Point(39, 36), _
                          New Point(31, 40), New Point(11, 40)}
    apt(4) = New Point() {New Point(2, 37), New Point(10, 41), _
                          New Point(10, 61), New Point(2, 69)}
    apt(5) = New Point() {New Point(40, 37), New Point(40, 69), _
                          New Point(32, 61), New Point(32, 41)}
    apt(6) = New Point() {New Point(11, 62), New Point(31, 62), _
                          New Point(39, 70), New Point(3, 70)}
  End Sub

  Function MeasureString(ByVal str As String, ByVal fnt As Font) _
        As SizeF
    Dim szf As New SizeF(0, g.DpiX * fnt.SizeInPoints / 72)
    Dim ch As Char
    For Each ch In str
      If Char.IsDigit(ch) Then
        szf.Width += 42 * g.DpiX * fnt.SizeInPoints / 72 / 72
      ElseIf ch.Equals(":"c) Then
        szf.Width += 12 * g.DpiX * fnt.SizeInPoints / 72 / 72
      End If
    Next ch
    Return szf
  End Function

  Sub DrawString(ByVal str As String, ByVal fnt As Font, _
        ByVal br As Brush, ByVal x As Single, ByVal y As Single)
    Dim ch As Char
    For Each ch In str
      If Char.IsDigit(ch) Then
        x = Number(AscW(ch) - AscW("0"), fnt, br, x, y)
      ElseIf ch.Equals(":"c) Then
        x = Colon(fnt, br, x, y)
      End If
    Next ch
  End Sub

  Private Function Number(ByVal num As Integer, _
        ByVal fnt As Font, ByVal br As Brush, _
        ByVal x As Single, ByVal y As Single) As Single
    Dim i As Integer
    For i = 0 To apt.GetUpperBound(0)
      If bySegment(num, i) = 1 Then
        Fill(apt(i), fnt, br, x, y)
      End If
    Next i
    Return x + 42 * g.DpiX * fnt.SizeInPoints / 72 / 72
  End Function

  Private Function Colon(ByVal fnt As Font, ByVal br As Brush, _
        ByVal x As Single, ByVal y As Single) As Single
    Dim i As Integer
    Dim apt(1)() As Point
    apt(0) = New Point() {New Point(2, 21), New Point(6, 17), _
                          New Point(10, 21), New Point(6, 25)}
    apt(1) = New Point() {New Point(2, 51), New Point(6, 47), _
                          New Point(10, 51), New Point(6, 55)}
    For i = 0 To apt.GetUpperBound(0)
      Fill(apt(i), fnt, br, x, y)
    Next i
    Return x + 12 * g.DpiX * fnt.SizeInPoints / 72 / 72
  End Function

  Private Sub Fill(ByVal apt() As Point, ByVal fnt As Font, _
        ByVal br As Brush, ByVal x As Single, ByVal y As Single)
    Dim i As Integer
    Dim aptf(apt.GetUpperBound(0)) As PointF
    For i = 0 To apt.GetUpperBound(0)
      aptf(i).X = _
            x + apt(i).X * g.DpiX * fnt.SizeInPoints / 72 / 72
      aptf(i).Y = _
            y + apt(i).Y * g.DpiY * fnt.SizeInPoints / 72 / 72
    Next i
    g.FillPolygon(br, aptf)
  End Sub
End Class
 
Code im Codebereich der Form
 
Imports System.Globalization

Public Class Form1
  Private dt As New DateTime

  Private Sub TimerOnTick(ByVal obj As Object, _
        ByVal ea As EventArgs)
    Dim dtNow As DateTime = DateTime.Now
    dtNow = New DateTime(dtNow.Year, dtNow.Month, dtNow.Day, _
                     dtNow.Hour, dtNow.Minute, dtNow.Second)
    If dtNow <> dt Then
      dt = dtNow
      Invalidate()
    End If
  End Sub

  Protected Overrides Sub OnPaint(ByVal pea As PaintEventArgs)
    Dim dc As New clsDigitalClock(pea.Graphics)
    Dim sT As String = _
          dt.ToString("T", DateTimeFormatInfo.InvariantInfo)
    Dim sF As SizeF = dc.MeasureString(sT, Font)
    Dim fS As Single = Math.Min(ClientSize.Width / sF.Width, _
                                ClientSize.Height / sF.Height)
    Dim fnt As New Font(Font.FontFamily, fS * Font.SizeInPoints)
    sF = dc.MeasureString(sT, fnt)
    dc.DrawString(sT, fnt, Brushes.GreenYellow, _
          (ClientSize.Width - sF.Width) / 2 - sF.Width / 20, _
          (ClientSize.Height - sF.Height) / 2)
  End Sub

  Private Sub Timer1_Tick(ByVal sender As System.Object, _
          ByVal e As System.EventArgs) Handles Timer1.Tick
    TimerOnTick(sender, e)
  End Sub

  Private Sub Form1_Load(ByVal sender As System.Object, _
          ByVal e As System.EventArgs) Handles MyBase.Load
    Me.BackColor = Color.DarkBlue
    Me.Text = DateTime.Now.ToLongDateString
    Timer1.Enabled = True
  End Sub
End Class
 
Weitere Links zum Thema
Analoge Uhr

Windows-Version
98/SE
ME
NT
2000
XP
Vista
Win 7


Download  (13,8 kB) Downloads bisher: [ 1024 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Tipps | Projekte | Tutorials | Bücherecke | VB-/VBA-Tipps | API-Referenz | Komponenten | VB.Net-Forum | VB/VBA-Forum | DirectX-Forum | Foren-Archiv | DirectX | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 20. Januar 2012