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