FAIRE DÉFILER DU TEXTE À UNE VITESSE SÉLECTIONNABLE.

Commentaire de boursicotteur le 27/07/2003 01:02:41

Attention: Tu ne fais pas circuler mais tu donne seulement l'illusion.

Essai donc ceci...
-----------------

Dim xTexteAffiché

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

    Vitesse.Max = 200
    Vitesse.Min = 4
    Vitesse.Value = 4
    Frame1.Caption = "mSec/Pix"

    xTexteAffiché = "Voici comment faire défiler du texte pixel par pixel avec 2 picturebox et aucun timer... Boursicotteur. 2003"
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .Visible = False
        .BorderStyle = vbBSNone
    
        '.FontName = "MS Sans Serif"
        .FontSize = 20
        .ForeColor = vbBlue

        .Top = 0
        .Left = 0
        .Width = 15 * (Picture1.TextWidth(xTexteAffiché) + 1) 'Ajoute 1 pix(15 twips) pour éviter trainée résiduelle
        .Height = 15 * (Picture1.TextHeight(xTexteAffiché))
    End With

    With Picture2
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .Visible = True
        .BorderStyle = vbBSNone
    
        .Top = 0
        .Left = 0.05 * Me.Width
        .Width = 0.9 * Me.Width
        .Height = Picture1.Height
    End With
    '----

    Picture1.CurrentY = 0
    Picture1.CurrentX = 0
    Picture1.Print xTexteAffiché
End Sub

Private Sub Command1_Click()
    Select Case Command1.Caption
    Case "GO"
        Command1.Caption = "STOP"
    
        '----
        Picture2.Cls
        xPosMin = -(Picture1.ScaleWidth - 1)
        xPos = xPosMin

        Do While Command1.Caption = "STOP"
            If GetTickCount - xx1 >= Vitesse.Value Then
                xx1 = GetTickCount
                Picture2.PaintPicture Picture1.Image, xPos, 0
                xPos = IIf(xPos > xPosMin, xPos - 1, Picture2.ScaleWidth)
            End If
            DoEvents
        Loop
        '----
    
    Case "STOP"
        Command1.Caption = "GO"
    End Select
End Sub

Private Sub Vitesse_Change()
    lblvitesse.Caption = Vitesse.Value
End Sub