PDA

View Full Version : DoEvents چیست و چگونه عمل می کند...



butterfly8528
یک شنبه 24 دی 1391, 22:58 عصر
سلام .

بار ها در تاپیک های مختلف دیدم که راجع به دستور DoEvents ( در دلفی Application.ProcessMessages ، در سی شارپ Application.DoEvents ) بحث شده ، این تابع مخصوصا در vb6 که از برنامه نویسی چند نخی پشتیبانی نمی کند بسیار پر کاربرد هست و همانطور که می دانید در حلقه های طولانی به منظور جلوگیری از به اصطلاح هنگ کردن برنامه استفاده می شود .
اما واقعا این دستور چه کاری انجام می دهد و چگونه پیاده سازی شده است ؟

زمانی که برنامه به صورت چند نخی پیاده نشده و تمام دستورات برنامه توسط thread اصلی برنامه اجرا می شود ، و از یک حلقه طولانی مانند مثال زیر استفاده کرده باشیم(البته بدون DoEvents)، تا زمان پایان یافتن حلقه پیام هایی که سیستم عامل به برنامه ما ارسال کرده است ، پردازش نخواهند شد ( این پیام ها شامل ترسیم و بروز رسانی های گرافیکی ، اعلام رویداد ها و ... می باشد ) و این امر موجب می شود که برنامه ما به اصطلاح هنگ کند یا از دسترس خارج شود ،

For i = 0 To 10000
Me.Caption = CStr(i)
Next i

for (int i = 0; i <= 10000; i++)
{
this.Text = i.ToString();
Application.DoEvents();
}

for i := 0 to 10000 do
begin
self.Caption := IntToStr(i);
Application.ProcessMessages;
end;

اما کاری که DoEvents انجام می دهد : به زبان ساده این دستور باعت می شود که پیام های موجود در صف پیام ویندوز پردازش شوند و نسبت به آنها واکنش نشان داده شود (مانند بروز رسانی های گرافیکی و...) و مجددا کنترل به برنامه باز گشته و اجرای دستورات ادامه یابد .

اما این روند چگونه پیاده سازی شده است ؟

با استفاده از توابع:
PeekMessage (http://msdn.microsoft.com/en-us/library/ms644943%28VS.85%29.aspx) برای چک کردن صف پیام و بازیافت پیام در صورت وجود .
TranslateMessage (http://msdn.microsoft.com/en-us/library/ms644955%28v=vs.85%29.aspx) برای ترجمه پیام .
DispatchMessag (http://msdn.microsoft.com/en-us/library/ms644934%28v=vs.85%29.aspx) برای مخابره کردن پیام .

نحوه پیاده سازی دستور DoEvents در VB6 :



' Arshamsoft
' www.arshamsoft.com (http://www.arshamsoft.com)

Option Explicit

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type


Private Declare Function PeekMessageA Lib "user32" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function PeekMessageW Lib "user32" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long

Private Declare Function DispatchMessageA Lib "user32" (lpMsg As Msg) As Long
Private Declare Function DispatchMessageW Lib "user32" (lpMsg As Msg) As Long

Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long


Private Const PM_REMOVE = &H1



Public Sub DoEventsX()
Dim cMsg As Msg
Dim Unicode As Boolean

Unicode = (cMsg.hwnd = 0) Or IsWindowUnicode(cMsg.hwnd)

Do
If Unicode = True Then
If PeekMessageW(cMsg, 0, 0, 0, PM_REMOVE) = 0 Then Exit Do
Else
If PeekMessageA(cMsg, 0, 0, 0, PM_REMOVE) = 0 Then Exit Do
End If

TranslateMessage cMsg

If Unicode = True Then
DispatchMessageW cMsg
Else
DispatchMessageA cMsg
End If
Loop

End Sub


Private Sub Command1_Click()
Dim i As Integer

For i = 0 To 10000
Me.Caption = CStr(i)
DoEventsX
Next i
End Sub



امیدوارم این مطلب برای دوستان مفید واقع بشه .

موفق و آزاد باشید :لبخندساده:.

محسن واژدی
یک شنبه 24 دی 1391, 23:26 عصر
سلام علیکم،
پست زیر هم میتونه مفید باشه:
http://barnamenevis.org/showthread.php?152798-%D8%AF%D8%B3%D8%AA%D9%88%D8%B1-DoEvents&p=697754&viewfull=1#post697754

موفق باشید

meys34
دوشنبه 25 دی 1391, 10:29 صبح
خیلی ممنون بسیار جالب بود... می دونستم DoEvents چیه و چیکار میکنه ....
ولی نمیدونستم میشه با API هم دوباره بازسازیش کرد... (هرچند دلیل این کار نا معلومه برای من!؟!؟!!....)



سلام علیکم،
پست زیر هم میتونه مفید باشه:
http://barnamenevis.org/showthread.php?152798-%D8%AF%D8%B3%D8%AA%D9%88%D8%B1-DoEvents&p=697754&viewfull=1#post697754

موفق باشید

این تاپیک فقط چرایی و چگونگی استفاده از DoEvents توضیح داده شده
ولی "نحوه پیاده سازی دستور DoEvents در VB6 " توسط API رو نه...

Felony
دوشنبه 25 دی 1391, 10:47 صبح
البته استفاده از اون بدون اطلاع دقیق از نحوه عملکرد میتونه مشکل ساز بشه ، قبلا اینجا توضیحات کاملی دادم :

http://barnamenevis.org/showthread.php?372985

butterfly8528
دوشنبه 25 دی 1391, 15:51 عصر
سلام علیکم،
پست زیر هم میتونه مفید باشه:
http://barnamenevis.org/showthread.php?152798-%D8%AF%D8%B3%D8%AA%D9%88%D8%B1-DoEvents&p=697754&viewfull=1#post697754

موفق باشید

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


البته استفاده از اون بدون اطلاع دقیق از نحوه عملکرد میتونه مشکل ساز بشه ، قبلا اینجا توضیحات کاملی دادم :

http://barnamenevis.org/showthread.php?372985
بله درسته ، استفاده ناشیانه از این روند ممکنه نتایج غیر قابل پیش بینی داشته باشه .

butterfly8528
دوشنبه 25 دی 1391, 19:00 عصر
این روند در دلفی با جزییات بیشتر و به صورت زیر در یونیت Vcl.Forms پیاده سازی شده :


[SecurityPermission(SecurityAction.LinkDemand, UnmanagedCode=True)]
function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
Unicode: Boolean;
MsgExists: Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
begin
Unicode := (Msg.hwnd = 0) or IsWindowUnicode(Msg.hwnd);
if Unicode then
MsgExists := PeekMessageW(Msg, 0, 0, 0, PM_REMOVE)
else
MsgExists := PeekMessageA(Msg, 0, 0, 0, PM_REMOVE);

if MsgExists then
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsPreProcessMessage(Msg) and not IsHintMsg(Msg) and
not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
TranslateMessage(Msg);
if Unicode then
DispatchMessageW(Msg)
else
DispatchMessageA(Msg);
end;
end
else
begin
{$IF DEFINED(CLR)}
if Assigned(FOnShutDown) then FOnShutDown(self);
DoneApplication;
{$IFEND}
FTerminate := True;
end;
end;
end;
end;

[UIPermission(SecurityAction.LinkDemand, Window=UIPermissionWindow.AllWindows)]
procedure TApplication.ProcessMessages;
var
Msg: TMsg;
begin
while ProcessMessage(Msg) do {loop};
end;