Các chiêu thức trong lập trình Thả một câu từ trên cao xuống

“Thả một câu từ trên cao xuống” (Có thể nói như vậy) home
Xuất xứ : www.pscode.com
Binh khí sử dụng : Một Picture và một CommandButton
Đoạn mã :
Option Explicit
Private Sub command1_Click()
Randomize Timer 'Khởi tạo
‘Khai báo
Dim StartTime(100) 'Thời gian bắt đầu di chuyển
lên xuống
Dim DownMovement(100) As Boolean ' Chúng ta phải lên xuông bao
nhiêu ??????
Dim MoveDistance As Double ' Khoảng cách đích đến
Dim YPos(100) As Double ' Tọa độ Y của chữ
Dim MovementDone(100) As Boolean ' Là đúng khi lên / xuống hoàn
thành
Dim StartHeight(100) As Double ' Chiều cào phải đi
xuống ???
Dim UpMovementTime(100) As Double ' Chiều dài mà ký tự sẽ
lấy để đi lên
Dim PowerLoss(100) As Double ' Đã chạm tới điểm dưới
dung ?????
Dim Message As String ' Thông điệp bạn cần hiển thị
Dim Looop As Integer ' Biến vòng lặp
Dim TextColor(100) As ColorConstants ' Màu sắc của mỗi ký tự

' Thiết lập

picture1.ScaleMode = 4
picture1.FontName = "Courier New" ' Font chữ của ký tự

Message = "Ô hiệu ứng chữ !!! Mail của tác giả nè (-_-) :
" ' Thông điệp bạn muốn hiển thị

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 'Đặt thời gian
xuống, cần phải tính tóan vị trí
Next Looop

Do

picture1.Cls ' Xóa Picture

‘ Vòng lặp để tiến hành đếm từng ký tự
For Looop = 1 To Len(Message)


If DownMovement(Looop) = True Then

MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 * ((Timer
- StartTime(Looop)) ^ 2))) ' Tính khoảng cách rơi

If YPos(Looop) >= picture1.ScaleHeight - 1 Then

MovementDone(Looop) = True ' Ký tự chạm phần đáy dưới Downmovement (Di
chuyển xuống) hoàn thành

Else
MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 *
(UpMovementTime(Looop) - (Timer - StartTime(Looop))) ^ 2)) ' Yónh khoảng
cách rơi

If YPos(Looop) <= StartHeight(Looop) + 0.1 Then
MovementDone(Looop) = True ' Ký tự chạm đến điểm cao nhất upmovement
(Di chuyển lên trên) hòan thành

End If

YPos(Looop) = MoveDistance

If YPos(Looop) > picture1.ScaleHeight - 1 Then
' Nếu ký tự thỏa điều kiện này phải sửa lại chúng
YPos(Looop) = picture1.ScaleHeight - 1
' Tại vị trí dưới cùng
End If

picture1.CurrentX = picture1.ScaleWidth / 2 - Int((Len(Message)
/ 2)) + Looop
picture1.CurrentY = YPos(Looop)
' Đặt vị tọa độ Y cho ký tự
picture1.ForeColor = TextColor(Looop)
' Đặt màu cho ký tự
picture1.Print Mid(Message, Looop, 1)
' Đặt chử vào picture1

Next Looop

DoEvents

For Looop = 1 To Len(Message)

If MovementDone(Looop) = True Then

If DownMovement(Looop) = True Then ' Khoảng cách chuyển
đổi giữa up/downmovement (Di chuyển lên/Di chuyển xuống)
DownMovement(Looop) = False
StartHeight(Looop) = StartHeight(Looop) +
((picture1.ScaleHeight - StartHeight(Looop)) * PowerLoss(Looop)) '
Startheight mới, bởi vì tốc độ bị sai ?!?!
UpMovementTime(Looop) = Sqr((picture1.ScaleHeight -
StartHeight(Looop)) / (0.5 * 9.81)) ' D9ộ dài bao nhiêu sẽ
upmovement (Di chuyển lên trên) sau đó???
Else
DownMovement(Looop) = True
End If

StartTime(Looop) = Timer ' Đặt thời gian bắt
đầu di chuyển
MovementDone(Looop) = False
End If

Next Looop

Loop ' Đến khi StartHeight = picture1.ScaleHeight

End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub