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 |