Vbmatrix 1.0

Télécharger le projet
Commenter

Description

Voici la version Vb de mon code http://www.javascriptfr.com/article.asp?Val=144
Et sans Direct X !
Il possède moins de fonctions, mais il est plus puissant et est plus beau je trouve.

Source / Exemple : 


Dim Matrix(0 To 24) As mtrx
Dim Buffer As String, CurrentCar
Const Matrix_Cars = "WTiF#*åÀl·"
Dim ExeTypeWriter As Boolean
Dim TypeWriterGreen As Byte, DoingFondu As Boolean, FonduVar As String
Private Type mtrx
    X As Long
    Y As Long
    V As Long
End Type
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then ShowCursor True: End
End Sub

Private Sub Form_Load()
    For i = 0 To 24
        Matrix(i).X = Int(Rnd * Screen.Width)
        Matrix(i).Y = Int(Rnd * Screen.Height)
        Matrix(i).V = Int(Rnd * 180) + 128
    Next i
    ShowCursor False
    Buffer = " > Hello, my name is Neo." & Chr$(13) & Chr$(10) & " > Oups, sorry I don't have shut off the translator.<fondu>" & "Downloading french version.........." & Chr$(13) & Chr$(10) & "Executing file.........." & Chr$(13) & Chr$(10) & "Restarting server.........." & Chr$(13) & Chr$(10) & "Connection request, accepted.<fondu> > Voilà, c'est enfin traduit." & Chr$(13) & Chr$(10) & " > Que pensez vous de ce code ?" & Chr$(13) & Chr$(10) & " > A, c'est vrai, vous ne pouvez pas répondre." & Chr$(13) & Chr$(10) & " > Bon, je vais juste parler un peu<fondu> > J'ai fait ce code car sur vbfrance, je n'ai trouvé aucun code" & Chr$(13) & Chr$(10) & "   qui était complet, et je l'ai fait aussi" & Chr$(13) & Chr$(10) & "   car ma version javascript était trop lente.<fondu> > J'ai donc créé ce code, j'ai d'abord mit les bidules qui tombent" & Chr$(13) & Chr$(10) & "   de l'écran, puis j'ai mit l'effet typewriter." & Chr$(13) & Chr$(10) & "   J'ai surtout eu des problèmes avec l'effet de fondu" & _
             Chr$(13) & Chr$(10) & "   car je voulais faire, et j'ai réussi à faire" & Chr$(13) & Chr$(10) & "   Un effet de fondu, puis en même temps le nouveau texte tapé au dessus." & Chr$(13) & Chr$(10) & "Donc au total j'ai mit dexu jours, car pendant un moment je l'ai abandonné." & Chr$(13) & Chr$(10) & " > Bon, j'arrête de tout raconter, dpnc si vous avez de questions :" & Chr$(13) & Chr$(10) & "    clem@progfr.com"
    DoingFondu = False
    TypeWriterGreen = 255
End Sub

Private Sub Timer1_Timer()
    Me.Cls
    Me.Font.Name = "Symbol"
    For i = 0 To 24
        Matrix(i).Y = Matrix(i).Y + Matrix(i).V
        If Matrix(i).Y > Me.ScaleHeight Then Matrix(i).Y = -2100: Matrix(i).X = Int(Rnd * Screen.Width): Matrix(i).V = Int(Rnd * 180) + 128
        For j = 0 To 10
            Me.ForeColor = RGB(0, Int(j / 10 * 255), 0)
            If j > 5 Then Me.ForeColor = RGB((j - 5) / 3 * 64, Int(j / 10 * 255), (j - 5) / 3 * 64)
            Me.CurrentX = Matrix(i).X
            Me.CurrentY = Matrix(i).Y + (j * 14) * 15
            Me.Print Mid$(Matrix_Cars, Int(Rnd * Len(Matrix_Cars)) + 1, 1)
        Next j
    Next i

    Me.Font.Name = "Courier New"
    If DoingFondu = True Then
        If TypeWriterGreen <= 1 Then
            DoingFondu = False
            TypeWriterGreen = 0
        Else
            TypeWriterGreen = TypeWriterGreen - 2
        End If
        Me.ForeColor = RGB(0, TypeWriterGreen, 0)
        Me.CurrentX = 0
        Me.CurrentY = 0
        Me.Print FonduVar
    End If
    If TypeWriterGreen = 255 Or TypeWriterGreen < 200 Then CurrentCar = CurrentCar + 0.5

    For i = 0 To CurrentCar
        ExeTypeWriter = True
        If Mid$(Buffer, Fix(CurrentCar) + 1, 2) = Chr$(13) & Chr$(10) Then
            Me.ForeColor = RGB(0, 255, 0)
            Me.CurrentX = 0
            Me.CurrentY = 0
            Me.Print Mid$(Buffer, 1, i)
            CurrentCar = CurrentCar + 1
            ExeTypeWriter = False
        End If
        If Mid$(Buffer, Fix(CurrentCar) + 1, 7) = "<fondu>" Then
            Me.ForeColor = RGB(0, TypeWriterGreen, 0)
            Me.CurrentX = 0
            Me.CurrentY = 0
            DoingFondu = True
            Dim NewBuf As String
            TypeWriterGreen = 255
            FonduVar = Mid$(Buffer, 1, CurrentCar)
            Buffer = Mid$(Buffer, CurrentCar + 8)
            CurrentCar = 0
            ExeTypeWriter = False
                Me.ForeColor = RGB(0, 255, 0)
                Me.CurrentX = 0
                Me.CurrentY = 0
                Me.Print FonduVar
        End If
        If ExeTypeWriter = True Then
            Me.ForeColor = RGB(0, 255, 0)
            Me.CurrentX = 0
            Me.CurrentY = 0
            Me.Print Mid$(Buffer, 1, CurrentCar)
        End If
    Next
    
End Sub

Conclusion :


Il peut être largement amélioré, par exemple en changeant déjà les caractères qui sont dans les matrix.

J'attend les notes, et les commentaires.

Ps: Le code est totalement libre de droits (du moment que vous ne changez pas juste mon nom, pour y mettre le votre), et j'éspère qu'il servirat beaucoup
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Clem)