http://bugeyes.blog.edu.cn/user1/20989/archives/2006/1131090.shtml
本代码实现了转动五角星的效果,仅博大家一笑,其丑陋程度,不堪入目,呵呵
代码:
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_NOACTIVATE = &H10
Public Const HWND_TOPMOST = -1
Dim str As String * 20
Dim i As Single
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 Then End
End Sub
Private Sub Form_Load()
i = 1
str = "BugEyes趣味程序欣赏"
Picture1.Scale (-750, 750)-(750, -750)'自定义坐标系
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 180, 220, noactivate 设置窗口位置
End Sub
Private Sub Timer1_Timer()
Dim X1, Y1, X2, Y2, X3, Y3, X4, Y4, X5, Y5 As Long
Static Angel, ang As Single
Dim R, R1 As Long
Picture1.Cls
If Angel = 6.27 Then Angel = 0
R = 750'外面大五角星的转动
X1 = R * Cos(Angel): Y1 = R * Sin(Angel)
X2 = R * Cos(Angel + 1.256): Y2 = R * Sin(Angel + 1.256)
X3 = R * Cos(Angel + 2 * 1.256): Y3 = R * Sin(Angel + 2 * 1.256)
X4 = R * Cos(Angel + 3 * 1.256): Y4 = R * Sin(Angel + 3 * 1.256)
X5 = R * Cos(Angel + 4 * 1.256): Y5 = R * Sin(Angel + 4 * 1.256)
Picture1.Line (X1, Y1)-(X3, Y3), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.Line (X1, Y1)-(X4, Y4), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.Line (X2, Y2)-(X4, Y4), RGB(Rnd * 255, Rnd * 255, 255)
Picture1.Line (X2, Y2)-(X5, Y5), RGB(Rnd * 255, Rnd * 255, 255)
Picture1.Line (X3, Y3)-(X5, Y5), RGB(Rnd * 255, Rnd * 255, 255)
Angel = Angel + 0.11
Label1.Caption = "今 天 的 日 期是:" & Date & Chr(13) + Chr(10) + "现 在 的 时 间是:" & Time
Form1.Caption = Mid(str, i) + Space(5) + Mid(str, 1, i - 1)'窗口标题的动态效果
i = i + 0.05
If i >= 19 Then i = 1
If ang = -6.27 Then ang = 0
R1 = 100'内部小五角星的转动
ang = 0 - Angel
X1 = R1 * Cos(ang): Y1 = R1 * Sin(ang)
X2 = R1 * Cos(ang + 1.256): Y2 = R1 * Sin(ang + 1.256)
X3 = R1 * Cos(ang + 2 * 1.256): Y3 = R1 * Sin(ang + 2 * 1.256)
X4 = R1 * Cos(ang + 3 * 1.256): Y4 = R1 * Sin(ang + 3 * 1.256)
X5 = R1 * Cos(ang + 4 * 1.256): Y5 = R1 * Sin(ang + 4 * 1.256)
Picture1.Line (X1, Y1)-(X3, Y3), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.Line (X1, Y1)-(X4, Y4), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.Line (X2, Y2)-(X4, Y4), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.Line (X2, Y2)-(X5, Y5), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.Line (X3, Y3)-(X5, Y5), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
End Sub
程序运行某时刻截图:
在我blog上面有源代码下载