Timers and Animation

Dim ps As PAINTSTRUCT

Dim hdc As Long

(hdc=BeginPaint(hWnd,ps

((hbrOld=SelectObject(hdc,GetStockObject(HOLLOW_BRUSH

draw your ellipses here'

Ellipse hdc, 300, 300, 500, 510

EndPaint hwnd,ps 

---

 : Animation 

const  BALL_MOVE=2

 

Type BALLINFO

width

height

x

y

dx

dy

End Type 

dim g_ballInfo As BALLINFO

const int ID_TIMER = 1

در زمان ساخت یا نمایش پنجره 

(ret =SetTimer(hwnd,ID_TIMER, 50,0

if(ret= 0) Then

"MsgBox "Zzzz

در WinProc

case WM_TIMER

 Dim rcClient As RECT

(hdc=GetDC(hwnd

GetClientRect hwnd,rcClient

UpdateBall rcClient

DrawBall hdc,rcClient

ReleaseDC hwnd, hdc

تابع آپدیت کردن : 

(UpdateBall(ByRef prc As RECT

g_ballInfo.x=g_ballInfo.x+g_ballInfo.dx

g_ballInfo.y= g_ballInfo.y+g_ballInfo.dy 

if g_ballInfo.x < 0 Then 

 g_ballInfo.x=0

 g_ballInfo.dx=BALL_MOVE

 else if(g_ballInfo.x+g_ballInfo.width>prc.right)  Then

g_ballInfo.x=prc.right-g_ballInfo.width g_ballInfo.dx=g_ballInfo.dx-BALL_MOVE

End If 

 if(g_ballInfo.y<0)Then 

     g_ballInfo.y = 0

     g_ballInfo.dy = BALL_MOVE

else if(g_ballInfo.y+g_ballInfo.height>prc.bottom) Then

g_ballInfo.y=prc.bottom-g_ballInfo.height

g_ballInfo.dy=g_ballInfo.dy-BALL_MOVE

End If 

در تابع زیر میتوان ترسیم موردنظر را انجام داد یا بیتمپ داخل آن لود نمود

(DrawBall(ByVal hdc As Long,ByRef prc As RECT

(FillRect hdc,prc,GetStockObject(WHITE_BRUSH

 : Finally 

KillTimer hwnd, ID_TIMER