Next Looop Loop ' Đến khi StartHeight = picture1.ScaleHeight End Sub Private Sub Form_QueryUnloadCancel As Integer, UnloadMode As Integer End End Sub.
Trang 1“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è (-_-) :
overkillpage@gmx.net" ' 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
Trang 2
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
Trang 3
Next Looop
Loop ' Đến khi StartHeight = picture1.ScaleHeight
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) End
End Sub