سلام .
بار ها در تاپیک های مختلف دیدم که راجع به دستور 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 برای چک کردن صف پیام و بازیافت پیام در صورت وجود .
TranslateMessage برای ترجمه پیام .
DispatchMessag برای مخابره کردن پیام .
نحوه پیاده سازی دستور DoEvents در VB6 :
کد:
' Arshamsoft
' 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
امیدوارم این مطلب برای دوستان مفید واقع بشه .
موفق و آزاد باشید
.
این روند در دلفی با جزییات بیشتر و به صورت زیر در یونیت 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;
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :
