Credit- & Info-Box mit Lauftext Manchmal will man am Anfang seines Programms Infos über den Autor, die Version, Free- oder Shareware und ähnliches ausgeben, oder am Schluss die Namen der Mitwirkenden oder einen Dank für verschiedene Unterstützung aussprechen. Man kann einen Text vorbereiten, ihn entsprechend formatieren, in ein Array umwandeln und mit ein wenig Aufwand und einem Timer über eine PictureBox laufen lassen.
Autor:  Guido Eisenbeis	Bewertung:     [ Jetzt bewerten ]	Views:  21.665

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 3 Bewertung insgesamt: mittelmäßig Durchschnittliche Bewertung: 2.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Manchmal will man am Anfang seines Programms Infos über den Autor, die Version, Free- oder Shareware und ähnliches ausgeben, oder am Schluss die Namen der Mitwirkenden oder einen Dank für verschiedene Unterstützung aussprechen. Man kann einen Text vorbereiten, ihn entsprechend formatieren, in ein Array umwandeln und mit ein wenig Aufwand und einem Timer über eine PictureBox laufen lassen.

Wir wollen jedoch mehr!

Wir wollen:

• Die Applikation soll uns ermöglichen, einen Text über eine PictureBox oder eine Form laufen zu lassen.
• Sie soll uns die Eingabe des Textes erleichtern, indem sie jeden beliebigen Text automatisch direkt aus einer Text-Datei einliest.
• Der Text soll vollkommen unbearbeitet sein können und beim Einlesen automatisch umgebrochen werden.
• Er soll wahlweise links- oder rechtsbündig, oder zentriert ausgegeben werden können.
• Die Ausgabe-Breite soll von uns bestimmt werden können.
• Wir wollen im Hintergrund ein beliebiges Bild darstellen, das direkt aus einer Bild-Datei geladen werden kann.
• Falls das Bild kleiner oder größer als unsere PictureBox ist, soll sie automatisch eingepasst werden.
• Der Text soll über dem Bild erscheinen.
• Die Geschwindigkeit der Laufschrift soll sich einstellen lassen.
• Keine Begrenzung (fast) was die Länge des Textes betrifft.
• Und trotz alledem soll es möglichst wenige Ressourcen verbrauchen.
• Zu diesem Zweck machen wir uns 1x die Arbeit, und ruhen uns dann auf unseren Lorbeeren aus. Schließlich programmieren wir ja, um uns wiederkehrende Abläufe zu vereinfachen. Also programmieren wir uns eine komplette Applikation, die unseren Wünschen entspricht.

Sie heißt: "Credit- & Info-Box mit Lauftext (GES)".

Lasst uns programmieren!

Wir starten Visual Basic und erstellen ein neues Standard-EXE-Projekt.
Das Projekt bekommt den Namen "CreditUndInfoBox".

Unser Programm wird in der Lage sein, die Ausgabe auf einer Form oder einer PictureBox beliebiger Größe zu machen. In unserem Workshop setzen wir nun eine PictureBox "Picture1" auf unsere "Form1". Die Größe der PictureBox entspricht etwa einem Viertel des Bildschirms, "Form1" ist ein wenig größer. Wir fügen unserem Projekt ein BAS-Modul hinzu und nennen es "basCreditUndInfoBox". Damit wären unsere Vorbereitungen auch schon abgeschlossen.

Bei unserem Programm-Code fangen wir hinten an:

Der Lauftext.

Um unseren Text über die PictureBox "laufen zu lassen", benutzen wir einen Timer. Wir programmieren einen API-Timer, den wir ebenfalls in unser BAS-Modul packen. Dadurch bleibt unser Code unabhängig.

Wir fügen folgende Deklarationen ein:

Option Explicit
 
' Hilfs-Funktionen (Timer)
Private Declare Function SetTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal nIDEvent As Long, _
  ByVal uElapse As Long, _
  ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal nIDEvent As Long) As Long

Dazu gehört die folgende Timer-Prozedur, mit deren Hilfe wir den Text "laufen" lassen. In dieser Prozedur "drucken" wir den Text mit dem "Print"-Befehl in unsere PictureBox. Damit der Eindruck entsteht, dass der Text läuft, beginnen wir am unteren Rand der PictureBox und drucken den Text bei jedem Timer-Intervall ein Stückchen höher.

Wir fügen im BAS-Modul ein:

' Mit Hilfe des Timers die Schrift "laufen lassen"
Sub TimerProc1(ByVal hWnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
 
  ' .... hier Anweisungen für Timer-Event
  On Error Resume Next
  TimerLäuft = True
 
  With objAusgObjekt
    ' vorherige Text-Ausgabe löschen (Bild bleibt erhalten)
    .Cls 
 
    ' Text über das AusgabeObjekt "laufen lassen".
    If AusgabeYPosition > -HilfsTextHöhe Then        
      ' Text immer ein Stückchen hochsetzen
      AusgabeYPosition = AusgabeYPosition - Geschwindigkeit
    Else
      ' Text an den unteren Rand (AusgabeObjekt) setzen
      AusgabeYPosition = .ScaleHeight
    End If
 
    .CurrentY = AusgabeYPosition
 
    ' Text im AusgabeObjekt "drucken"
    objAusgObjekt.Print HilfsText
  End With
End Sub

Textdatei einlesen und Text formatieren

Damit wir einen Text ausgeben können müssen wir ihn zunächst einmal einlesen. Wir haben uns ja am Anfang einige hohe Ziele gesetzt, in Bezug darauf, was unser Programm alles können soll. Kurzer Rückblick: automatisches Einlesen einer beliebigen Text-Datei, automatischer Wort und Zeilenumbruch, anpassen an die Maße der PictureBox, Ausgabe des Textes links- oder rechtsbündig, oder zentriert usw. Dazu greifen wir auf die hervorragende Arbeit von Dieter Otter zurück, nämlich auf seinen Tipp:  Drucken mit autom. Wort- und Zeilenumbruch vom 18.06.2001.

Da wir aber nicht drucken wollen (zumindest nicht auf dem Drucker), können wir auf verschiedene Code-Teile verzichten, wie z.B. Seitenumbrüche und alles was mit der Seitenhöhe (MaxHeight) zu tun hat.

Dafür wollen wir aber Text einlesen. Zu diesem Zweck schreiben wir einen Code, mit dem wir eine Text-Datei binär öffnen und somit in einem Rutsch einlesen können.

Wir nennen unsere so gewonnene Prozedur "ReadMultilineText" und fügen sie in unser BAS-Modul ein:

' ================================================================ 
' Lesen mit autom. Wort- und Zeilenumbruch  (Anfang)              
' ================================================================
'
' Bezeichnung des Original-Codes:
'
'   Drucken mit autom. Wort- und Zeilenumbruch  (Anfang)
'
'   Autor:   Dieter Otter, Homepage:   http://www.tools4vb.de/
'   Datum:   18.06.2001,   Sprache:  deutsch
'
'  
' Bezeichnung des modifizierten Codes:
'
'   Lesen mit autom. Wort- und Zeilenumbruch
'
'   Autor:
'   Gudio Eisenbeis Software (GES), [email protected], 2003-10-15
'
' Features:
'
'   automatischer Wort- und Zeilenumbruch
'   optionale Angabe der Maximalen Breite, mit
'              der die Ausgabe erfolgen soll
'   optionale Angabe der Textausrichtung
'             (linksbündig, rechtsbündig, zentriert)
' 
' 
' Hauptroutine:
' 
' Text lesen mit automatischem Wortumbruch
'
' AusgabeObjekt : Wahlweise eine Form oder eine PictureBox
'
' sText              : Text, der ausgegeben werden soll
'                           (kann auch harte Zeilenumbrüche enthalten)
'
' MaxWidth      : Maximale Breite einer Zeile
'
' tAlign              : 0 = linksbündig (Standard)
'                           1 = rechtsbündig
'                           2 = zentriert
Public Sub ReadMultilineText( _
  ByRef AusgabeObjekt As Object, _
  ByVal sText As String, _
  Optional ByVal MaxWidth As Long = 0, _
  Optional ByVal tAlign As Integer = 0)
 
  Dim FNr As Integer
  Dim sLine() As String
  Dim I As Integer
  Dim NextLine As String
  Dim ZeilenBreite
  Dim AusgabeEndpunkt
 
  ' Textdatei im Binärmodus öffnen und gesamten
  ' Inhalt in einem Rutsch auslesen
  If Dir$(TextPfad, vbNormal) <> "" Then ' Existiert die Datei ?
 
    ' !ACHTUNG! -->  "Datei bereits geöffnet"  <-- !ACHTUNG!
    ' (Falls diese Fehlermeldung erscheint, siehe Ende Modul)
 
    HilfsText = "" ' vorherigen Text löschen
    FNr = FreeFile
    Open TextPfad For Binary As #FNr
    sText = Space$(LOF(FNr))
    Get #FNr, , sText
    Close #FNr
  End If
 
  With AusgabeObjekt
 
    ' zunächst die "harten" Zeilenumbrüche ermitteln
    sLine = Split(sText, vbCrLf)
    For I = 0 To UBound(sLine)
 
      ' Zeile hat keine "Überbreite"
      If .TextWidth(sLine(I)) <= MaxWidth Then
 
        ' Ausrichtung
        ZeilenBreite = .TextWidth(sLine(I))
        Select Case tAlign
          Case 1
            ' rechtsbündig
            AusgabeEndpunkt = MaxWidth + (.ScaleWidth - MaxWidth) / 2
          Case 2
            ' zentriert
            AusgabeEndpunkt = ZeilenBreite + (.ScaleWidth - ZeilenBreite) / 2
          Case Else
            ' linksbündig
            AusgabeEndpunkt = ZeilenBreite + (.ScaleWidth - MaxWidth) / 2
        End Select
 
        ' je nach Ausrichtung Zeile (links) mit
        ' entsprechend vielen Leerzeichen auffüllen
        Do Until ZeilenBreite >= AusgabeEndpunkt
          sLine(I) = " " & sLine(I)
          ZeilenBreite = .TextWidth(sLine(I))
        Loop
 
        ' Zeile in Variable hinzufügen
        HilfsText = HilfsText & sLine(I) & vbCrLf
      Else
        ' Zeile umbrechen
        Do
          NextLine = ""
          While .TextWidth(sLine(I)) > MaxWidth
            NextLine = Right$(sLine(I), 1) + NextLine
            sLine(I) = Left$(sLine(I), Len(sLine(I)) - 1)
          Wend
 
          ' Wortumbruch prüfen
          CheckUmbruch NextLine, sLine(I)
 
          ' Ausrichtung
          ZeilenBreite = .TextWidth(sLine(I))
          Select Case tAlign
            Case 1
              ' rechtsbündig
              AusgabeEndpunkt = MaxWidth + (.ScaleWidth - MaxWidth) / 2
            Case 2
              ' zentriert
              AusgabeEndpunkt = ZeilenBreite + (.ScaleWidth - ZeilenBreite) / 2
            Case Else
              ' linksbündig
              AusgabeEndpunkt = ZeilenBreite + (.ScaleWidth - MaxWidth) / 2
          End Select
 
          ' je nach Ausrichtung Zeile (links) mit
          ' entsprechend vielen Leerzeichen auffüllen
          Do Until ZeilenBreite >= AusgabeEndpunkt
            sLine(I) = " " & sLine(I)
            ZeilenBreite = .TextWidth(sLine(I))
          Loop
 
          ' Zeile in Variable hinzufügen
          HilfsText = HilfsText & sLine(I) & vbCrLf
          sLine(I) = NextLine
        Loop Until Trim$(sLine(I)) = ""
      End If
    Next I
  End With
End Sub

' Hilfsroutine
' korrekten Wortumbruch beachten
Private Sub CheckUmbruch(NextLine As String, Text As String)
  Const Check = " .,;:-_!?(/+=*~"
 
  If NextLine <> "" Then
    If InStr(Check, Left$(NextLine, 1)) = 0 Then
      While InStr(Check, Right$(Text, 1)) = 0 And Len(Text) > 0
        NextLine = Right$(Text, 1) + NextLine
        Text = Left$(Text, Len(Text) - 1)
      Wend
    End If
  End If
End Sub

' !ACHTUNG!  -->  "Datei bereits geöffnet"  <--  !ACHTUNG!
'
' Wenn diese Fehlermeldung erscheint, kann eine mögliche
' Ursache sein, dass im einzulesenden Text eine Zeile
' existiert, die aus ununterbrochenen Zeichen besteht
' und länger ist als "MaxWidth".
' Beispiel: Eine lange Linie mit "xxxxxxxxxxxx"-Zeichen.
' Mögliche Lösung: In "Const Check" aufnehmen (kann aber
' das korrekte Umbrechen an anderer Stelle stören)
 
' ================================================================
' Lesen mit autom. Wort- und Zeilenumbruch  (Ende)                
' ================================================================

Was macht unsere Prozedur?
Sie liest einen Text aus einer Text-Datei ein, sorgt für die Wort- und Zeilenumbrüche, berücksichtigt unsere Ausgabe-Breite (die wir später festlegen werden) und schreibt ihn in die Variable "HilfsText".

Da der Wort- und Zeilenumbruch einige Schleifen durchläuft, ist es von Vorteil, den Text nicht direkt in der PictureBox auszugeben. Stattdessen wird er nur einmal auf diese Weise bearbeitet und dann in unserer Variablen gespeichert. Von dort kann er problemlos "nachgetankt" und mit dem einfachen Print-Befehl ausgegeben werden. Dadurch werden sehr viele Ressourcen gespart.

Auch die Ausrichtung (links, rechts, zentriert) wird in der Variablen gespeichert, indem wir jede Zeile von links ausgehend mit entsprechend mehr oder weniger Leerzeichen auffüllen. Auch das spart wieder Ressourcen, weil der Vorgang auf diese Weise nur 1x gemacht werden muss.

Lauftext-Ausgabe starten

' ================================================================
' Haupt-Code für Lauftext  (Anfang)                               
' ================================================================
 
' kurze Erklärung zu den benötigten Variablen:
Public Geschwindigkeit As Long	  ' empfohlen: von 2 bis 10
Public Textausrichtung As Byte  	' 0 = Links, 1 = Rechts, 2 = Zentriert
Public TextBreite As Single      	' von 0.6 bis 1 (1 = ganze Breite)
Public BildStretchen As Boolean  	' Bild in AusgabeObjekt einpassen
Public TextPfad As String        	' Text der über die PicBox "läuft"
Public BildPfad As String        	' Bild das im Hintergrund erscheint
 
Private AusgabeYPosition As Long  ' horizontale Text-Position
Private objAusgObjekt As Object  	' Form oder PictureBox
Private TimerLäuft As Boolean
 
Private HilfsText As String     	' TextVariable
Private MaxTextWidth As Long
Private HilfsTextHöhe As Long    	' ermittelte TextHöhe
 
Private HilfsBild As StdPicture  	' BildVariable
Private BildWeite As Long
Private BildHöhe As Long

Public Sub StarteLauftext(AusgabeObjekt As Object)
  If Not TextPfad = "" Then
    With AusgabeObjekt
 
      ' AusgabeObjekt "leeren"
      Set .Picture = Nothing
      .Cls
 
      ' Einstellungen setzen
      .ScaleMode = 1           	   ' Maßeinheit auf Twips setzen
      .AutoRedraw = True
'      .Enabled = False
      If TextBreite < 0.6 Then
        MaxTextWidth = .ScaleWidth * 0.6
      ElseIf TextBreite > 1 Then
        MaxTextWidth = .ScaleWidth * 1
      Else
        MaxTextWidth = .ScaleWidth * TextBreite
      End If
 
      ' Bild in Variable laden und Maße in Pixel umwandeln
      Set HilfsBild = LoadPicture(BildPfad)
      BildWeite = CLng(.ScaleX(HilfsBild.Width, vbHimetric, vbTwips))
      BildHöhe = CLng(.ScaleY(HilfsBild.Height, vbHimetric, vbTwips))
 
      ' HilfsBild in AusgabeObjekt malen
      If Not BildPfad = "" Then
        If BildStretchen Then
          ' Bild auf AusgabeObjekt-Größe strecken/stauchen
          .PaintPicture HilfsBild, 0, 0, .ScaleWidth, .ScaleHeight
        Else
          ' Bild mit normaler Größe ausgeben (zentriert)
          .PaintPicture HilfsBild, _
            (.ScaleWidth - BildWeite) / 2, _
            (.ScaleHeight - BildHöhe) / 2
        End If
        ' Das gemalte Bild als Picture laden. Dadurch bleibt
        ' es erhalten, wenn wir unseren Text ausgeben
        .Picture = .Image
      End If
 
      ' Textausgabe in PicBox am unteren Rand beginnen lassen
      If AusgabeYPosition = 0 Then AusgabeYPosition = .ScaleHeight
    End With
 
    ' Den Text in die Variable "HilfsText" einlesen, und dabei
    ' Wort- und Zeilenumbrüche und Ausrichtung verarbeiten
    ReadMultilineText AusgabeObjekt, TextPfad, MaxTextWidth, Textausrichtung
 
    ' Um zu erfahren, wann der Lauftext den oberen Rand des
    ' AusgabeObjekts überschreitet, lesen wir die Texthöhe aus
    HilfsTextHöhe = AusgabeObjekt.TextHeight(HilfsText)
 
    ' Jetzt lassen wir mit Hilfe eines Timers den Text "laufen"
    Set objAusgObjekt = AusgabeObjekt 	' Objekt weiterreichen
    Call SetTimer(AusgabeObjekt.hWnd, 0, 10, AddressOf TimerProc1)
  Else
    MsgBox "Zuerst Textdatei auswählen."
  End If
End Sub

' !WICHTIG! Timer killen, bevor die Anwendung beendet wird!
Public Sub KillTheTimer()
  If TimerLäuft = True Then
    TimerLäuft = False
    KillTimer objAusgObjekt.hWnd, 0
  End If
End Sub
 
' ================================================================
' Haupt-Code für Lauftext  (Ende)                                 
' ================================================================

Private Sub Form_Load()
' Hier alle Einstellungen setzen, den Rest macht der Code
' (Einstellungen für die Schrift und den Hintergrund können im
' jeweiligen AusgabeObjekt (Form oder PictureBox) gemacht werden.)
' -------------------------------------------------------------------
 
  Geschwindigkeit = 2    ' empfohlen: von 2 bis 10
  Textausrichtung = 2    ' 0 = Links, 1 = Rechts, 2 = Zentriert
  TextBreite = 0.9       ' von 0.6 bis 1 (1 = ganze Breite)
  BildStretchen = False
 
  ' Bild und Textdatei (zum Einlesen) hier angeben
  TextPfad = App.Path & "\Test Infobox.txt"
  BildPfad = App.Path & "\britney.jpg"
 
  Call StarteLauftext(Picture1)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ' !WICHTIG! Timer killen, bevor die Anwendung beendet wird!
  Call KillTheTimer
End Sub