vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB4, VB5, VB602.01.04
AboutBox mit Farbverlauf und Scrolltext

In so gut wie jeder Anwendung findet man ein Info-Fenster mit Informationen über das Programm, den Autor etc. Dieses Info-Fenster, auch AboutBox genannt, kann grau und trist sein, aber auch bunt und schön :-) Wie wäre es mit einer AboutBox mit Farbverlauf? Wie wäre es, wenn der Info-Text von unten nach oben scrollt und sich nahtlos dem Farbverlauf anpasst? Die Anwender wären sicherlich begeistert :-)

Autor:  ArthurWBewertung:     [ Jetzt bewerten ]Views:  1.422 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

In so gut wie jeder Anwendung findet man ein Info-Fenster mit Informationen über das Programm, den Autor etc. Dieses Info-Fenster, auch AboutBox genannt, kann grau und trist sein, aber auch bunt und schön Wie wäre es mit einer AboutBox mit Farbverlauf? Wie wäre es, wenn der Info-Text von unten nach oben scrollt und sich nahtlos dem Farbverlauf anpasst? Die Anwender wären sicherlich begeistert

Alles, was Sie hierzu benötigen ist eine Form, zwei PictureBox-Controls, sowie ein Timer-Control. Das erste PictureBox-Control dient für die Anzeige, das zweite PictureBox-Control als Zwischenpuffer. Über den Timer wird die Scroll-Geschwindigkeit des Info-Textes gesteuert.

Let's begin

Erstellen Sie ein neues Projekt und platzieren auf die Form zwei PictureBox-Controls (picOut und picBuffer). Ziehen Sie auf die Form noch ein Timer-Control und benennen es RedrawTimer. Die Positionierung der Controls und alles Weitere erfolgt dann zur Laufzeit.

Der Info-Text selbst soll aus einer Textdatei gelesen werden. Öffnen Sie also den Windows-Editor und speichern Ihren Info-Text dann ins Programmverzeichnis unter dem Namen about.txt.

Fügen Sie nachfolgenden Code in den Codeteil der Form1 ein:

Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function BitBlt Lib "gdi32" ( _
  ByVal hdcDest As Long, _
  ByVal XDest As Long, _
  ByVal YDest As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal hDCSrc As Long, _
  ByVal xSrc As Long, _
  ByVal ySrc As Long, _
  ByVal dwRop As Long) As Long
 
Private Const SRCCOPY = &HCC0020
 
' Benötigte Variablen
Dim Tempstring(1 To 3000) As Variant
Dim NumLines As Long
Dim lY As Long

Im Form_Load Ereignis werden zunächst die Controls platziert und die benötigten Eigenschaften festgeleht. Danach wird die Textdatei zeilenweise ausgelesen und im String-Array Tempstring zwischengespeichert. Anschließend wird der Farbverlauf erstellt und der Timer für die Textausgabe gestartet.

Private Sub Form_Load()
  ' Textdatei zeilenweise auslesen und im
  ' String-Array zwischenspeichern
  Dim iLine As Integer
  Dim F As Integer
 
  NumLines = 0
  F = FreeFile
  Open App.Path & "\about.txt" For Input As #F
  Do Until EOF(1)
    NumLines = NumLines + 1
    Line Input #F, Tempstring(NumLines)
  Loop
  Close #F
 
  ' Ausgabe-PictureBox positionieren
  picOut.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
  picOut.AutoRedraw = True
 
  ' Eigenschaften der Form und der Controls festlegen
  With picBuffer
    .Width = picOut.Width
    .Height = picOut.Height
    .ScaleMode = vbPixels
    .ForeColor = vbWhite
    .BackColor = vbBlack
    .AutoRedraw = True
    .Visible = False
 
    ' Schriftart
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
  End With
  Me.ScaleMode = vbPixels
 
  ' Höhe der AusgabeBox = Startposition für die Textausgabe
  lY = picBuffer.ScaleHeight
 
  ' Farbverlauf erstellen
  GradiantBackground picBuffer
 
  ' Timer starten
  ReDrawTimer.Interval = 25
  ReDrawTimer.Enabled = True
End Sub

Für das Erstellen des Farbverlaufs ist folgende Prozedur zuständig:

' Farbverlauf erstellen
Private Sub GradiantBackground(picBox As PictureBox)
  Dim ipicHeight As Long
  Dim ipicWidth As Long
  Dim lYOffset As Long
  Dim iColorCur As Single
  Dim iColorStep As Single
 
  With picBox
    ipicWidth = .ScaleWidth
    ipicHeight = .ScaleHeight
 
    iColorCur = 255
    iColorStep = 5 * (0 - 255) / ipicHeight
 
    For lYOffset = 0 To ipicHeight Step 5
      picBox.Line (-1, lYOffset - 1)-(ipicWidth, lYOffset + 5), _
        RGB(0, 0, iColorCur), BF
      iColorCur = iColorCur + iColorStep
    Next lYOffset
  End With
End Sub

Fehlt jetzt nur noch die Textausgabe:

' Scrollende Textausgabe mit Farbverlauf
Private Sub RedrawTimer_Timer()
  Dim l As Long
  Dim J As Long
 
  On Error Resume Next
 
  ' Zeichne den Hintergrund nach picBuffer
  GradiantBackground picBuffer
 
  With picBuffer
    ' alle Textzeilen durchlaufen
    For J = 1 To NumLines
      ' Startposition der Textzeile setzen (unten - mittig)
      .CurrentY = lY + (J * .FontSize + (6 * J))
      .CurrentX = (.ScaleWidth / 2) - (.TextWidth(Tempstring(J)) / 2)
 
      ' Vordergrundfarbe: weiß
      .ForeColor = vbWhite
 
      ' Wenn die aktuelle Linie den Punkt < 245 Pixel erreicht hat,
      ' Schrift-Farbverlauf erstellen
      If .CurrentY < 245 Then
        ' Falls ein Stück vom Text verlaufen ist
        ' und nicht am oberen Rand ist jetzt...
        If .CurrentY > 15 Then
          ' Ändern der Vordergrund Farbe (in unserem Fall blau)
          .ForeColor = RGB((((255 / 235) * .CurrentY)), _
            (((255 / 235) * .CurrentY)), (((255 / 17) * .CurrentY)))
 
        Else
          ' Wir sind oben angekommen und setzen machen die Schrift
          ' jetzt durchsichtig
          .ForeColor = vbBlue
 
          If J = NumLines And picBuffer.CurrentY < -25 Then
            ' Wenn die letzte Zeile ausgegeben wurde und diese ganz oben
            ' angezeigt wird, kein Text mehr scrollen und Fenster schließen
            ReDrawTimer.Enabled = False
            Unload Me
          End If
        End If
      End If
 
      ' Textzeile in "Buffer" schreiben
      picBuffer.Print Tempstring(J)
    Next
 
    ' ok... jetzt ist der komplette "Pufferspeicher" beschrieben,
    ' so dass wir diesen jetzt direkt in das Ausgabecontrol übertragen
    l = BitBlt(picOut.hDC, 0, picOut.ScaleTop, picOut.ScaleWidth, _
      picOut.ScaleHeight, .hDC, 0, 0, SRCCOPY)
    picOut.Refresh
 
    ' Offset ändern (Position, an der der Text beim nächsten
    ' Durchlauf angezeigt werden soll)
    lY = lY - 1
  End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
  ' Timer beenden
  RedrawTimer.Enabled = False
End Sub

Starten Sie jetzt das Projekt und genießen Ihre neue AboutBox