Im Internet fand ich unter dem Link www.codeproject.com/KB/GDI-plus/StarWarsStyleTextScroller.aspx diese Textscroller-Lösung unter C# geschrieben. Ich habe den Code in VB übersetzt, ein wenig angepasst/verändert und zwei zusätzliche Eigenschaften für dieses Custom-Control definiert. Alle Eigenschaften sind im Code in englisch recht verständlich erklärt. Man braucht nun nur noch das Control in eine Form zu setzen und zu starten. Man kann ein wenig damit herum experimentieren und für sich die passenden Einstellungen finden. Ich kann mir vorstellen, dass man es gut für die Credits-Anzeige verwenden könnte. Der Fantasie sind da keine Grenzen gesetzt; auch für Ergänzungen und Modifikationen. Hier der Code des Controls: Imports System Imports System.Windows.Forms Imports System.Collections.Generic Imports System.ComponentModel Imports System.Data Imports System.Text Imports System.Drawing Imports System.Drawing.Drawing2D Namespace ExtendedComponents Public Class Scroller Inherits UserControl ''' <summary> ''' String list. ''' </summary> Private m_text As String() = New String(-1) {} ''' <summary> ''' Offset for animation. ''' </summary> Private m_scrollingOffset As Integer = 0 ''' <summary> ''' Top part size of text in percents. ''' </summary> Private m_topPartSizePercent As Integer = 50 ''' <summary> ''' Font, which is used to draw. ''' </summary> Private m_font As New Font("Arial", 20, FontStyle.Bold, _ GraphicsUnit.Pixel) ''' <summary> ''' Alignment of the text. ''' </summary> Private m_textalignment As StringAlignment ''' <summary> ''' With fog or not. ''' </summary> Private m_withFog As Boolean ''' <summary> ''' Constructor ''' </summary> Public Sub New() InitializeComponent() ' Enables double buffering (to remove flickering) ' and enables user paint. SetStyle(ControlStyles.OptimizedDoubleBuffer Or _ ControlStyles.UserPaint Or _ ControlStyles.AllPaintingInWmPaint, True) End Sub ''' <summary> ''' Text to scroll. ''' </summary> Public Property TextToScroll() As String Get Return String.Join(vbLf, m_text) End Get Set(ByVal value As String) Dim buffer As String = value ' Splits text by "\n" symbol. m_text = buffer.Split(New Char(0) {ControlChars.Lf}) End Set End Property ''' <summary> ''' Timer interval. ''' </summary> Public Property Interval() As Integer Get Return m_Timer.Interval End Get Set(ByVal value As Integer) m_Timer.Interval = value End Set End Property ''' <summary> ''' Font, which is used to draw. ''' </summary> Public Property TextFont() As Font Get Return m_font End Get Set(ByVal value As Font) m_font = value End Set End Property ''' <summary> ''' Alignment of the text. ''' </summary> Public Property TextAlignment() As StringAlignment Get Return m_textalignment End Get Set(ByVal value As StringAlignment) m_textalignment = value End Set End Property ''' <summary> ''' With dust or not. ''' </summary> Public Property WithFog() As Boolean Get Return m_withFog End Get Set(ByVal value As Boolean) m_withFog = value End Set End Property ''' <summary> ''' Top part size of text in percents (of control width). ''' </summary> Public Property TopPartSizePercent() As Integer Get Return m_topPartSizePercent End Get Set(ByVal value As Integer) If (value >= 10) AndAlso (value <= 100) Then m_topPartSizePercent = value Else Throw New _ InvalidEnumArgumentException( _ "Wert muss größer als 0 und kleiner als 100 sein.") End If End Set End Property ''' <summary> ''' Paint handler. ''' </summary> ''' <param name="e"></param> Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs) MyBase.OnPaint(e) With e.Graphics ' Sets antialiasing mode for better quality. .SmoothingMode = SmoothingMode.HighQuality .TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit ' Prepares background. .FillRectangle(New SolidBrush(Me.BackColor), Me.ClientRectangle) End With ' Creates GraphicsPath for text. Dim path As New GraphicsPath() Dim format As StringFormat = StringFormat.GenericTypographic format.Alignment = m_textalignment ' Visible lines counter. Dim visibleLines As Integer = 0 Dim pt As Point Dim ptX As Short Select Case format.Alignment Case StringAlignment.Center ptX = Me.ClientSize.Width / 2 Case StringAlignment.Far ptX = Me.ClientSize.Width Case StringAlignment.Near ptX = 0 End Select For i As Integer = m_text.Length - 1 To 0 Step -1 pt = New Point(ptX, CInt((m_scrollingOffset + Me.ClientSize.Height _ - (m_text.Length - i) * m_font.Size))) ' Adds visible lines to path. If (pt.Y + m_font.Size > 0) AndAlso (pt.Y < Me.Height) Then path.AddString(m_text(i), m_font.FontFamily, _ CInt(m_font.Style), m_font.Size, pt, format) visibleLines += 1 End If Next ' For repeat scrolling. If (visibleLines = 0) AndAlso (m_scrollingOffset < 0) Then ' m_scrollingOffset = CInt(Me.Font.SizeInPoints) * m_text.Length m_scrollingOffset = Me.Bounds.Bottom - CInt(Me.Font.SizeInPoints) End If Dim topSizeWidth As Integer = CInt( _ (Me.Width * m_topPartSizePercent / 100.0F)) ' Wraps Graphics path from rectangle to trapeze. path.Warp(New PointF(3) { _ New PointF((Me.Width - topSizeWidth) / 2, 0), _ New PointF(Me.Width - (Me.Width - topSizeWidth) / 2, 0), _ New PointF(0, Me.Height), New PointF(Me.Width, Me.Height)}, _ New RectangleF(Me.ClientRectangle.X, Me.ClientRectangle.Y, _ Me.ClientRectangle.Width, Me.ClientRectangle.Height), _ Nothing, WarpMode.Perspective) ' Draws wrapped path. e.Graphics.FillPath(New SolidBrush(Me.ForeColor), path) path.Dispose() If m_withFog = True Then ' Draws fog effect with help of gradient brush with alpha colors, ' using the controls backcolor as fog-color. Using br As Brush = New LinearGradientBrush(New Point(0, 0), _ New Point(0, Me.Height), _ Color.FromArgb(255, Me.BackColor), _ Color.FromArgb(0, Me.BackColor)) e.Graphics.FillRectangle(br, Me.ClientRectangle) End Using End If End Sub ''' <summary> ''' Starts the animation from the beginning. ''' </summary> Public Sub Start() ' Calculates scrolling offset. ' m_scrollingOffset = CInt(Me.Font.SizeInPoints) * m_text.Length m_scrollingOffset = Me.Bounds.Bottom - CInt(Me.Font.SizeInPoints) m_Timer.Start() End Sub ''' <summary> ''' Stops the animation. ''' </summary> Public Sub [Stop]() m_Timer.[Stop]() End Sub Private components As IContainer Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container Me.m_Timer = New System.Windows.Forms.Timer(Me.components) Me.SuspendLayout() ' m_Timer Me.m_Timer.Interval = 50 ' Scroller Me.Name = "Scroller" ' Me.Size = New System.Drawing.Size(399, 368) Me.ResumeLayout(False) End Sub
End Class End Namespace Um die Animation zu starten, genügt der Befehl Scroller1.Start(), zum Stoppen Scroller1.Stop(). Viel Spaß damit! Dieser Tipp wurde bereits 10.606 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. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |