Laufschrift in der Titelleiste
Leserbewertung(0):bewerten...
kommentieren...

Hans Happel

Machen Sie die Titelleiste mit einer Laufschrift lebendiger.

  • Erstellen Sie eine Form.
  • Schieben Sie ein Timer-Steuerelement in die Form.
  • Geben Sie ein Label-Element hinzu.

Kopieren Sie folgendes in den Deklarationsabschnitt

Option Explicit
Dim DC As Long
Dim RahmenB As Long
Dim RahmenH As Long
Dim Breite As Long
Dim Hoehe As Long
Dim IconB As Long
Dim Pos As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const SRCCOPY = &HCC0020

Im Form_Load-Ereignis sollte folgendes sein:

Private Sub Form_Load()
Me.ScaleMode = 3 'Pixel
Me.BorderStyle = 2 'Änderbar
Me.Caption = ""
Hoehe = GetSystemMetrics(4) - 1
DC = GetWindowDC(Me.hwnd)
RahmenB = GetSystemMetrics(32) 'Rahmenbreite
RahmenH = GetSystemMetrics(33) 'Rahmenhöhe
IconB = GetSystemMetrics(30) 'Icon-Breite
With Label1
'*** Die folgenden 7 Einstellungen können Sie auch im Eigenschaftenfenster vornehmen ***
.Caption = "Tips und Tricks von HBsoft"
.AutoSize = True
.BorderStyle = 0
.FontBold = True
.Left = 0
.Top = 0
.Width = .Width + 2 'etwas verbreitert, wegen der Verschiebung
'*** --------------------------------------------------------------------- ***
.Height = Hoehe
End With
End Sub

Das Form_Resize-Ereignis sollte folgenden Inhalt haben:

Private Sub Form_Resize()
Breite = Me.Width / Screen.TwipsPerPixelX - 2 * RahmenB - 3 * IconB
Pos = Breite 'Anfangsposition
End Sub

Das Timer-Ereignis sieht wie folgt aus:

Private Sub Timer1_Timer()
Dim KopieBreite As Long
Dim Korr As Long 'Korrektur der Schriftbreite beim eintauchen in den linken Rand

If Pos + Label1.Width >= Breite Then 'Die Schrift ist noch nicht in ganzer Breite sichtbar.
KopieBreite = Breite - Pos
Else
KopieBreite = Label1.Width
End If
Pos = Pos - 1
If Pos <= RahmenB Then 'Die Schrift berührt die linke Seite
Korr = RahmenB - Pos
BitBlt DC, RahmenB, RahmenH, KopieBreite - Korr, Hoehe, Picture1.hdc, Korr, 0, SRCCOPY
Else
BitBlt DC, Pos, RahmenH, KopieBreite, Hoehe, Picture1.hdc, 0, 0, SRCCOPY
End If
If Pos < -Label1.Width + RahmenB Then Pos = Breite
End Sub

So sieht das Form_Activate-Ereignis aus:

Private Sub Form_Activate()
With Label1
.BackColor = &H80000002
.ForeColor = &H80000009
DoEvents 'Muß sein, damit Text1 vor dem kopieren erscheint
BitBlt Picture1.hdc, 0, 0, .Width, .Height, Me.hdc, 0, 0, SRCCOPY
.Visible = False
End With
End Sub

Vergessen Sie nicht das Form_Unload-Ereignis. Der DC muß zurück gesetzt werden

Private Sub Form_Unload(Cancel As Integer)
ReleaseDC Me.hwnd, DC
End Sub

Übrigens ! Wenn Sie statt des Label-Elementes ein Picture-Element verwenden, dann können Sie mit dieser Methode auch ein Bild in der Titelleiste bewegen oder einen Farbverlauf erzeugen.