vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Forms/Controls   |   VB-Versionen: VB5, VB614.10.03
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 EisenbeisBewertung:     [ Jetzt bewerten ]Views:  21.929 

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), guidoeisenbeis@web.de, 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-Prozeduraufruf zu programmieren.

Darin muss folgendes enthalten sein:

  • Das Setzen der unbedingt erforderlichen Eigenschaften unserer PictureBox, wie z.B. "ScaleMode" auf Twips stellen und "AutoRedraw" auf "True".
     
  • Das Verarbeiten unserer persönlichen Einstellungen.
     
  • Die Geschwindigkeit mit der der Text über die PictureBox läuft, die Textausrichtung (links, rechts, zentriert), die Breite, mit der unser Text in der PictureBox ausgegeben wird und ob das Bild, das wir anzeigen, in Original-Größe ausgegeben oder in die PictureBox eingepasst wird.
     
  • Das Laden der Bild- und der Text-Datei, das Bemessen der Ausgabehöhe unseres Textes (damit wir den Text wieder unten anfangen lassen können, müssen wir wissen, wann das Ende oben angekommen ist) und zu guter Letzt, das Starten unseres Timers, damit der Text über unsere PictureBox laufen kann.

Wir fügen folgenden Code in unserem BAS-Modul direkt unterhalb der Deklarationen unseres API-Timers ein:

' ================================================================
' 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)                                 
' ================================================================

Am Schluss des Haupt-Codes haben wir eine Prozedur zum Beenden des Timers eingebaut. Ordnung muss sein.

Testen der Credit- & Info-Box

Damit ist eigentlich alles erledigt, was wir brauchen. Wir sind stolz auf unsere Arbeit und rufen sie auch gleich mit folgendem Code auf:

In Form1 fügen wir ein:

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

Lediglich die richtigen Pfade zu einer Bild- und einer Text-Datei müssen jetzt noch gesetzt werden. (Kopieren Sie z.B. einen Text und ein Bild in diesen Projekt-Ordner und geben Sie die Datei-Namen ein).

Das war's. Wir können unser Programm starten und uns an dem herrlichen Anblick erfreuen

Das komplette Beispiel und ein kleines Demo-Programm, mit dem die verschiedenen Möglichkeiten der "Credit- & Info-Box mit Lauftext (GES)" anschaulich dargestellt werden, können Sie hier downloaden.

Ich hoffe, es hat Ihnen genauso viel Spaß gemacht, wie mir.

Bei Fragen zu diesem Workshop stehe ich Ihnen gerne zur Verfügung.

Gudio Eisenbeis Software, kurz (GES), guidoeisenbeis@web.de, 2003-10-14

Dieser Workshop wurde bereits 21.929 mal aufgerufen.

Über diesen Workshop im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Workshop, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Workshops 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.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel