Um den vertikalen NewsTicker zu realisieren bin ich folgendermaßen vorgegangen: 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 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 Dieser Tipp wurde bereits 9.372 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |