Rubrik: Grafik und Font · Grafische Effekte | VB-Versionen: VB2005, VB2008 | 30.04.09 |
NewsTicker - vertical Ein anderer Typ NewsTicker: die Texte werden vertikal in Endlosschleife abgespielt | ||
Autor: Dietrich Herrmann | Bewertung: | Views: 9.394 |
ohne Homepage | System: Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Um den vertikalen NewsTicker zu realisieren bin ich folgendermaßen vorgegangen:
Als Voraussetzung für meinen Ticker benötigt man eine XML-Datei, die die anzuzeigenden Texte in strukturierter Form enthält.
Dazu habe ich diese Struktur konstruiert:
<?xml version="1.0" encoding="utf-8"?> <news> <artikel1> <titel> Dies ist die Überschrift für den ersten Artikel </titel> <text>Text für den Newsbeitrag</text> </artikel1> <artikel2> <titel> Dies ist die Überschrift für den zweiten Artikel </titel> <text>Text für den Newsbeitrag</text> </artikel2> ... usw. ... </news>
Die Anzahl der Artikel ist quasi unbegrenzt; allerdings muss die Nummerierung so erfolgen, wie oben gezeigt.
Nun zum Programm
In eine Form ein Panel gesetzt mit der Eigenschaft Dock=Fill. BackgroundColor von beiden schwarz. Der Form die gewünschte Größe für den Ticker geben.
Das Programm arbeitet so, dass zu jedem Artikel in der XML-Datei eine Richtextbox erzeugt und gefüllt wird. Alle Richtextboxen werden in einem Feld gespeichert. Beim Start des Tickers steht der Ticker bis die Verzögerungszeit um ist, ehe er zu laufen beginnt. Dann werden die Richtextboxen des Feldes so zu sagen ständig in einer Endlosschleife nach oben 'gezogen'.
Jetzt zum Code.
Imports System.IO Imports System.Net Imports System.Text Imports System.Xml Imports System.Xml.XPath Public Class Form1
' Textfont Dim txFont As Font = New Font("Arial", 12.0F, FontStyle.Regular) ' Textfarbe 1 Dim tx1Color As Color = Color.Lime ' Textfarbe 2 Dim tx2Color As Color = Color.Gold ' Zähler für Artikel Dim anzParagraphs As Short = 0 ' Feld für RichtextBox je Artikel Dim paragraphsField() As RichTextBox ' Timer-Objekte zum Steuern der Laufschrift Dim WithEvents oTimer As Timer ' für Ablauf Dim WithEvents vTimer As Timer ' für Anfangsverzögerung ' Definition des XML-Objekts (lesen) Dim xdoc As New XmlDocument Dim xnode As XmlNode Dim fName As String = "theTickerText.xml" ' Name der xml-Datei Dim artUS, artTX As String ' Artikelüberschrift, Artikeltext Dim az As Short = 1
Private Sub Form1_FormClosing(ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing ' Timer stoppen oTimer.Stop() oTimer.Dispose() vTimer.Dispose() End Sub
Private Sub Form1_Load(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles MyBase.Load ' Fenstergröße Me.Width = 360 Me.Height = My.Computer.Screen.Bounds.Height Me.Left = 0 Me.Top = 0 ' an dieser Stelle erzeuge ich die XML-Datei ' (das Erzeugen dieser Datei zeige ich hier im Tipp nicht.)!! ' den Parameter anzParagraphs (Anzahl der Artikel) muss man selbst ' beim Erzeugen der XML-Datei ermitteln und setzen anzParagraphs = ... ReDim paragraphsField(anzParagraphs - 1) ' laden des xml-Files mit den Artikeln xdoc.Load(Application.StartupPath & "\" & fName) ' füllen des Feldes mit den RichtextBoxen fillParaField() ' Timer starten oTimer = New Timer ' Timer für den Ablauf oTimer.Interval = 60 ' die Geschwindigkeit für den Ablauf vTimer = New Timer ' Timer für die Anfangsverzögerung vTimer.Interval = 5000 ' die Anfangsverzögerung in sec vTimer.Start() End Sub
Private Sub vTimer_Tick(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles vTimer.Tick oTimer.Start() vTimer.Stop() End Sub
Private Sub oTimer_Tick(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles oTimer.Tick ' bewegen der Texte (neuberechnen der Top's der ' RichTextboxen des Feldes) For i As Short = 0 To anzParagraphs - 1 With paragraphsField(i) .Top -= 1 If .Bottom = 0 Then If i = 0 Then .Top = paragraphsField(anzParagraphs - 1).Bottom Else .Top = paragraphsField(i - 1).Bottom End If End If End With Next i End Sub
' Füllen des Feldes mit RichtextBoxen je Artikel Sub fillParaField() Dim tTop As Short = 0 az = 1 For p As Short = 1 To anzParagraphs ' der Titel xnode = xdoc.SelectSingleNode("//news/artikel" + az.ToString + "/titel") artUS = xnode.InnerText ' der Artikeltext xnode = xdoc.SelectSingleNode("//news/artikel" + az.ToString + "/text") artTX = xnode.InnerText artTX += " ?" Dim tb As New RichTextBox ' neue RTBox erzeugen With tb ' Eigenschaften setzen .ReadOnly = True .TabStop = False .Parent = Panel1 .BackColor = Panel1.BackColor .BorderStyle = BorderStyle.None .Multiline = True .WordWrap = True .ScrollBars = RichTextBoxScrollBars.None .Left = 0 .Width = .Parent.Width .Font = txFont Dim theColor As Color ' alternierende Textfarbe If p Mod 2 = 0 Then theColor = tx2Color Else theColor = tx1Color End If .SelectionBackColor = theColor .SelectionColor = Color.Black .SelectionFont = New Font("", txFont.Size) .AppendText(artUS + vbCrLf) .SelectionBackColor = Color.Black .SelectionColor = theColor .SelectionFont = New Font("", txFont.Size) .AppendText(artTX + vbCrLf) Dim dwPreferredHeight As Integer = .PreferredHeight Dim dwPreferredSize As Integer = .PreferredSize.Height Dim dwGetPreferredSize As Integer = _ .GetPreferredSize(New Drawing.Size(.Width, 0)).Height ' Richtige Höhe = Oberkante des letzten Zeichens + ' Höhe des letzten Zeichens + Breite des Rahmens der rtfBox + 1 Pixel .Select(.Text.Length, 0) Dim dwSmartHeight As Integer = _ .GetPositionFromCharIndex(.Text.Length).Y + _ .SelectionFont.GetHeight() + (.Height - .ClientSize.Height) + 1 .Height = dwSmartHeight .Refresh() .Top = tTop tTop += .Height End With ' speichern der Richtextbox im Feld paragraphsField(p - 1) = tb az += 1 Next p End Sub
End Class