تبدیل فرم به ستاره ی متحرک در vb

[blackhacking21]

code]Option Explicit]


Private Type POINTAPI
x As Long
y As Long
End Type

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Const ALTERANTE = 1
Const PI = 3.141592
Const Num_Points = 10
Private Sub Form_Click()
Unload Me
End Sub
Private Sub ShapeForm(ByVal Offset As Single)

Dim Rgn As Long
Dim Wid As Single
Dim Hgt As Single
Dim Teta As Single
Dim Dteta As Single
Dim i As Integer

Dim w(0 To 1) As Single
Dim h(0 To 1) As Single
Dim cx As Single
Dim cy As Single
Dim Points() As POINTAPI

If WindowState = vbMinimized Then Exit Sub

Wid = ScaleX(Width, vbTwips, vbPixels)
Hgt = ScaleY(Height, vbTwips, vbPixels)

cx = Wid / 2
cy = Hgt / 2

w(0) = Wid * 0.2
w(1) = Wid * 0.5
h(0) = Hgt * 0.2
h(1) = Hgt * 0.5

Dteta = 2 * PI / Num_Points
Teta = PI / 2

ReDim Points(1 To Num_Points)
For i = 1 To Num_Points
Points(i).x = cx + w(i Mod 2) * Cos(Teta + Offset)
Points(i).y = cy + h(i Mod 2) * Sin(Teta + Offset)
Teta = Teta + Dteta
Next i

Rgn = CreatePolygonRgn(Points(1), Num_Points, ALTERANTE)
SetWindowRgn hWnd, Rgn, True

DeleteObject Rgn
End Sub
Private Sub Timer1_Timer()
Static Offset As Single
ShapeForm Offset
Offset = Offset + PI / 50
End Sub
[/code]
[hr]
این هم کد شفاف سازی فرم ، دو تا کامند باتن روی فرم بندازید
[code]


Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Dim I As Integer
Private Sub Down_Click()
If I > 50 Then
I = I - 10
SetLayeredWindowAttributes Me.hWnd, 0, I, LWA_ALPHA
End If
End Sub
Private Sub Form_Load()
I = 200
Dim Ret As Long
SetWindowLong Me.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes Me.hWnd, 0, 200, LWA_ALPHA
End Sub
Private Sub Up_Click()
If I < 250 Then
I = I + 10
SetLayeredWindowAttributes Me.hWnd, 0, I, LWA_ALPHA
End If
End Sub
[code/]
[hr]
این هم سورس بازی خواندن ذهن
روی فرم دو عدد کامند باتن بندازید و کد های زیر رو اضافه کنین

Dim lo As Integer
Dim hi As Integer
Dim mid As Integer
Dim f(1000) As Integer
'==========
Private Sub Command1_Click()
While low < hi
i = i + 1
g = MsgBox(" ÓæÇá ÔãÇÑå " & i & vbNewLine & "ÚÏÏ íÔäåÇÏí : " & mid, vbYesNoCancel)
Select Case g
Case vbNo
hi = mid - 1
mid = (lo + hi) \ 2
Case vbYes
lo = mid + 1
mid = (lo + hi) \ 2
Case vbCancel
Exit Sub
End Select
Wend
End Sub
'==========
Private Sub Command2_Click()
End
End Sub
'==========
Private Sub Form_Load()
MsgBox (" ÇÑ ÚÏÏ ÈÒѐÊÑ ÇÓÊ " & "yes" & vbNewLine & " ÇÑ ÚÏÏ ˜æ˜ÊÑ ÇÓÊ " & "No" & vbNewLine & " ÇÑ ÚÏÏ åãÇä ÚÏÏ ãæÑÏäÙÑ ÇÓÊ íÇ ÈÑÇí ÇäÕÑÇÝ ÇÏÇãå ÚãáíÇÊ" & "Cancel")
For i = 1 To 1000
f(i) = i
Next i
lo = f(0)
hi = f(1000)
mid = (lo + hi) \ 2

End Sub