Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0291: Verschiedene Typen von Laufschriften erzeugen

VB 5/6-Tipp 0291: Verschiedene Typen von Laufschriften erzeugen

 von Klaus Langbein

Schwierigkeitsgrad:

Verwendete API-Aufrufe: Sleep

Download: Download des Beispielprojektes [5,86 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 1)
' Steuerelement: Textfeld "Text2"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"


'Autor: Klaus Langbein
'E-Mail: klaus@activevb.de

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Text As String
Private Stopped As Integer

Private Sub scroll_text()
    Dim LeftChar As String
    Stopped = 0
    
    Do
        LeftChar = Left$(Text, 1)
        Text = Right$(Text, Len(Text) - 1) + LeftChar
        Text2.Text = Text
        Call pause(30, 1)
    Loop Until Stopped = 1
End Sub

Private Sub Command1_Click()
    Call Command2_Click
    DoEvents
    'stopped = 0
    DoEvents
    Text = Text1.Text
    
    If Option1(0).Value = -1 Then
        Call scroll_text
    Else
        Timer1.Interval = 50
        Timer1.Enabled = -1
    End If
End Sub

Private Sub Command2_Click()
    Stopped = 1
    Timer1.Enabled = 0
End Sub

Private Sub Form_Load()
    Form2.Show
    Form3.Show
    Stopped = 1
End Sub

Private Sub pause(ByVal Pau As Single, ByVal DoEv As Integer)
    Call Sleep(Pau)
    If DoEv = 1 Then DoEvents
End Sub

Private Sub Option1_Click(Index As Integer)
    'If stopped = 0 then
    Call Command2_Click
    Call pause(100, 1)
    Call Command1_Click
    'End If
End Sub

Private Sub Timer1_Timer()
    Dim LeftChar As String
    
    LeftChar = Left$(Text, 1)
    Text = Right$(Text, Len(Text) - 1) & LeftChar
    Text2.Text = Text
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Formular "Form2" alias Form2.frm  ---------
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 1)
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Beschriftungsfeld "cntrl" (Index von 1 bis 2) auf Picture1
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"


'Autor: Klaus Langbein
'E-Mail: klaus@activevb.de

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Text As String
Private Stopped As Integer
Private TwpP As Integer

Private Sub move_text()
    Dim l1 As Long, l2 As Long, lw As Long
  
    l1 = cntrl(1).Left
    l2 = cntrl(1).Left
    lw = cntrl(1).Width
    
    DoEvents
    If l1 > 0 Then
        l1 = l1 - 1
        cntrl(1).Left = l1
        cntrl(2).Left = l1 - lw
    Else
        l2 = l2 - 1
        cntrl(2).Left = l2
        cntrl(1).Left = l2 + lw
    End If
End Sub

Private Sub Command1_Click()
    Text = Text1.Text
    cntrl(1).Caption = Text
    cntrl(2).Caption = Text
    
    DoEvents
    Picture1.Width = cntrl(1).Width * TwpP / 3
    
    cntrl(1).Left = 0
    cntrl(2).Left = cntrl(1).Left + cntrl(1).Width
  
    'Call scroll_text
    If Option1(0).Value = -1 Then
        Call scroll_text
    Else
        Timer1.Interval = 5
        Timer1.Enabled = True
    End If
End Sub

Private Sub Command2_Click()
    Stopped = 1
    Timer1.Enabled = False
End Sub

Private Sub Form_Load()
    TwpP = Screen.TwipsPerPixelX
    Picture1.Height = cntrl(1).Height * TwpP + 4 * TwpP
    
    cntrl(1).Top = 0
    cntrl(2).Top = 0
End Sub

Private Sub pause(ByVal Pau As Single, ByVal DoEv As Integer)
    Call Sleep(Pau)
    If DoEv = 1 Then DoEvents
End Sub

Private Sub scroll_text()
    Stopped = 0
  
    Do
        Call move_text
        Call pause(10, 1)
    Loop Until Stopped = 1
End Sub

Private Sub Timer1_Timer()
    Call move_text
End Sub
'---------- Ende Formular "Form2" alias Form2.frm  ----------
'--------- Anfang Formular "Form3" alias Form3.frm  ---------
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 1)
' Steuerelement: Bildfeld-Steuerelement "Picture2"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"


'Autor: Klaus Langbein
'E-Mail: klaus@activevb.de

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Text As String
Private Stopped As Integer
Private TwpP As Integer
Private l1 As Long
Private l2 As Long

Private Sub move_text()
    Dim lw As Long
    
    lw = Picture2.TextWidth(Text)
    l1 = l1 - 1
    If l1 <= -lw Then l1 = 1
  
    Picture2.Cls
    Picture2.CurrentX = l1
    Picture2.CurrentY = 1
    Picture2.Print Text$ + Text$
    Picture2.Refresh
End Sub

Private Sub scroll_text()
    Stopped = 0
    Do
        Call move_text
        Call pause(10, 1)
    Loop Until Stopped = 1
End Sub

Private Sub Command1_Click()
    Timer1.Enabled = 0
    Call Command2_Click
    Text$ = Text1.Text
    l1 = 1
    
    If Option1(1).Value = -1 Then
        Timer1.Interval = 10
        Timer1.Enabled = -1
    Else
        Call scroll_text
    End If
End Sub

Private Sub Command2_Click()
    Stopped = 1
    Timer1.Enabled = 0
End Sub

Private Sub Form_Load()
    TwpP = Screen.TwipsPerPixelX
End Sub

Private Sub pause(ByVal Pau As Single, ByVal DoEv As Integer)
    Call Sleep(Pau)
    If DoEv = 1 Then DoEvents
End Sub

Private Sub Option1_Click(Index As Integer)
    Call Command1_Click
End Sub

Private Sub Timer1_Timer()
    Call move_text
End Sub
'---------- Ende Formular "Form3" alias Form3.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.