vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB2005, VB200804.08.09
Trapezförmiger Text-Scroller á la "Star Wars"

Realisierung eines Textscrollers, der eine Textanzeige wie in den Filmen der Star-Wars-Reihe imitiert.

Autor:   Dietrich HerrmannBewertung:  Views:  10.587 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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
    Private WithEvents m_Timer As System.Windows.Forms.Timer

    Private Sub m_Timer_Tick(ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles m_Timer.Tick
      ' Changes the offset.
      m_scrollingOffset -= 1
      ' Repaints whole control area.
      Invalidate()
    End Sub
  End Class
End Namespace

Um die Animation zu starten, genügt der Befehl Scroller1.Start(), zum Stoppen Scroller1.Stop().

Viel Spaß damit!



Anzeige

Kauftipp Unser Dauerbrenner!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.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


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.