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:
Sie heißt: "Credit- & Info-Box mit Lauftext (GES)". Lasst uns programmieren! Wir starten Visual Basic und erstellen ein neues Standard-EXE-Projekt. 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: 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? 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 Darin muss folgendes enthalten sein:
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.789 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
Neu! sevCoolbar 3.0 ![]() Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. |
|||||||||||||
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. |