اسکرین سیور ساده

[M_P_1374]

امروز یه سورس اسکرین سیور میذارم که با توابع سینوس و کسینوس نوشتم رو میذارم
برای تغییر قیافه اون اعداد رو تغییر بدین
یه دونه تایمر با اینتروال 50 بذارین روی فرم و از این کد استفاده کنید


Private Declare Sub 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)

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

Dim End2 As Boolean

Private Sub SetTopMost(frm As Form, ByVal blnMod As Boolean)
If blnMod Then
SetWindowPos frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
CloseShape
End Sub

Private Sub RibbonShape(Color As OLE_COLOR, Radian As Integer)
Dim X As Single, Y As Single, tr As Single, r As Single, a As Single, t As Single

Randomize
a = Atn(5)
Scale (1.5, -1.5)-(-1.5, 1.5)

tr = 40 * Rnd

ForeColor = Color

For t = 0.001 To tr Step 0.001
r = a * Cos(Radian * (t / 2))
X = r * Cos(t * 2)
Y = r * Sin(t)
PSet (X, Y)
Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
CloseShape
End Sub

Private Sub Form_Resize()
Cls
End Sub

Private Sub Timer1_Timer()
RibbonShape RGB(Rnd * 256, Rnd * 256, Rnd * 256), 9
End Sub

Private Sub CloseShape()
Timer1.Enabled = False
Cls
'Character 'E'
ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 4000 To 9000
Line (1500, i)-(2000, i)
Next

ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 2000 To 4000
Line (i, 4000)-(i, 5000)
Line (i, 6000)-(i, 7000)
Line (i, 8000)-(i, 9000)
Next
'Character 'N'
ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 4000 To 8000
Line (i + 1500, i)-(i + 1500, i + 1000)
Next

ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 4000 To 9000
Line (5000, i)-(5500, i)
Next

ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 4000 To 9000
Line (9500, i)-(10000, i)
Next

'Character 'D'
ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 11000 To 12500
Line (i, 8500)-(i, 9000)
Line (i, 7000)-(i, 7500)
Next

ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 4000 To 9000
Line (13000, i)-(12500, i)
Next

ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
For i = 7000 To 9000
Line (11000, i)-(11500, i)
Next
End
End Sub


برای تبدیلش به اسکرین سیور اونو توی قسمت کامپایل فایل یه .scr آخر اسم فایل اضافه کنید