Visual Basıc'te Uçan Yazı

Visual Basıc'te uçan yazı yapmak isteyenler aşağıdaki kodu forma yapıştırsın yeter

rivate Sub Command1_Click()
Randomize Timer 'Init Rnd

'Declarations
Dim StartTime(100) 'Starttime of a up/down movement
Dim DownMovement(100) As Boolean 'are we doing a up or down movement ???
Dim MoveDistance As Double 'distance target has moved since the start of the movement
Dim YPos(100) As Double 'Holds the y position of a letter
Dim MovementDone(100) As Boolean 'Is set to true when a up / down movement is completed
Dim StartHeight(100) As Double 'From which hight will the letter fall down ?
Dim UpMovementTime(100) As Double 'How long will it the letter take to move up
Dim PowerLoss(100) As Double 'losing xx% of power when touching the ground
Dim Message As String 'Message you want to display
Dim Looop As Integer 'Loop var
Dim TextColor(100) As ColorConstants 'Color of one letter


'Settings

Picture1.ScaleMode = 4
Picture1.FontName = "Arial"

Message = "*** deneme *** CONTACT ME: [Linkleri görebilmek için üye olun veya giriş yapın.] (Zeki görür) " 'Mesajı okuyalım.

For Looop = 1 To Len(Message)

PowerLoss(Looop) = 0.2 + ((Rnd * 25) / 100) '
StartHeight(Looop) = 0
TextColor(Looop) = RGB(80 + Looop * 2, 80 + Looop * 2, 255)

Next Looop

For Looop = 1 To Len(Message)
StartTime(Looop) = Timer
Next Looop

Do

Picture1.Cls
For Looop = 1 To Len(Message)

If DownMovement(Looop) = True Then

MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 * ((Timer - StartTime(Looop)) ^ 2))) 'Calculating falling distance

If YPos(Looop) >= Picture1.ScaleHeight - 1 Then MovementDone(Looop) = True 'The letter reached the bottom border. The Downmovement is complete

Else
MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 * (UpMovementTime(Looop) - (Timer - StartTime(Looop))) ^ 2)) 'Calculating falling distance

If YPos(Looop) <= StartHeight(Looop) + 0.1 Then MovementDone(Looop) = True 'The letter reached the max. height. The upmovement is complete

End If

YPos(Looop) = MoveDistance

If YPos(Looop) > Picture1.ScaleHeight - 1 Then 'If the letter fell out of our picturebox we fix it
YPos(Looop) = Picture1.ScaleHeight - 1 'At the bottom position
End If

Picture1.CurrentX = Picture1.ScaleWidth / 2 - Int((Len(Message) / 2)) + Looop
Picture1.CurrentY = YPos(Looop) 'Setting the letters y position
Picture1.ForeColor = TextColor(Looop) 'Setting the letters color
Picture1.Print Mid(Message, Looop, 1) 'Text output

Next Looop

DoEvents

For Looop = 1 To Len(Message)

If MovementDone(Looop) = True Then

If DownMovement(Looop) = True Then 'Switch between up/downmovement
DownMovement(Looop) = False
StartHeight(Looop) = StartHeight(Looop) + ((Picture1.ScaleHeight - StartHeight(Looop)) * PowerLoss(Looop)) 'New Startheight, because of speed lost ?!?!
UpMovementTime(Looop) = Sqr((Picture1.ScaleHeight - StartHeight(Looop)) / (0.5 * 9.81)) 'How long will the NEXT upmovement last ???
Else
DownMovement(Looop) = True
End If

StartTime(Looop) = Timer 'Set the StartTime of a new movement
MovementDone(Looop) = False

End If

Next Looop

Loop 'Until StartHeight = OUT.ScaleHeight

End Sub

Private Sub Form_Activate()
On Error Resume Next
Picture1.BackColor = "H8000000F"
End Sub

Private Sub Form_Load()
Form1.WindowState = 2
End Sub

Private Sub Form_Terminate()
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub