application.processmessages

[h4sh3m]

سلام

دوستان همين طور كه از عنوان هم مشخص هست مي خوام اين كد رو براي برنامه اي كه فرو نداره اعمال كنم ولي نمي خوام از forms استفاده كنم در قسمت uses به خاطر سايز فايل.

حالا مي خوام ببينم دوستان چيزي سراغ دارن ؟ يه جايي يه زماني ديده بودم ولي اون موقع لازم نداشتم برنداشتم !!!



با تشكر

[Felony]

خوب مشکل کجاست ؟ 5 دقیقه وقت میزاشتید و کد مربوط به Application.ProcessMessages رو استخراج میکردید و با کمی تغییر ازش استفاده میکردید :

function IsMDIMsg(var Msg: TMsg): Boolean;
begin
Result := False;
if (Application.MainForm <> nil) and
(Application.MainForm.FormStyle = fsMDIForm) and (Screen.ActiveForm <> nil)
and (Screen.ActiveForm.FormStyle = fsMDIChild) then
Result := TranslateMDISysAccel(Application.MainForm.ClientHa ndle, Msg);
end;

function IsKeyMsg(var Msg: TMsg): Boolean;
var
Wnd: HWND;
WndProcessID, ProcessID: Cardinal;
begin
Result := False;
with Msg do
if (Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST) then
begin
Wnd := GetCapture;
if Wnd = 0 then
begin
Wnd := HWnd;
if (Application.MainForm <> nil) and (Wnd = Application.MainForm.ClientHandle) then
Wnd := Application.MainForm.Handle
else
begin
// Find the nearest VCL component. Non-VCL windows wont know what
// to do with CN_BASE offset messages anyway.
// TOleControl.WndProc needs this for TranslateAccelerator
while not IsVCLControl(Wnd) and (Wnd <> 0) do
Wnd := GetParent(Wnd);
if Wnd = 0 then Wnd := HWnd;
end;
{$IF DEFINED(CLR)}
if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
{$ELSE}
if IsWindowUnicode(Wnd) then
begin
if SendMessageW(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
Result := True;
end else if SendMessageA(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
{$IFEND}
Result := True;
end
else
begin
GetWindowThreadProcessId(Wnd, WndProcessId);
GetWindowThreadProcessId(Application.Handle, ProcessId);
if (WndProcessID = ProcessID) then
if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
Result := True;
end;
end;
end;


function IsPreProcessMessage(var Msg: TMsg): Boolean;
var
Wnd: HWND;
Control: TWinControl;
begin
Result := False;
Wnd := GetCapture;
if Wnd = 0 then
begin
Wnd := Msg.HWND;
if (Application.MainForm <> nil) and
(Wnd = Application.MainForm.ClientHandle) then
Control := Application.MainForm
else
begin
Control := FindControl(Wnd);
while Control = nil do
begin
Wnd := GetParent(Wnd);
if Wnd <> 0 then
Control := FindControl(Wnd)
else
Break;
end;
end;
if Control <> nil then
Result := Control.PreProcessMessage(Msg);
end;
end;

function aProcessMessage(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 not IsPreProcessMessage(Msg) and not Handled and not IsMDIMsg(Msg)
and not IsKeyMsg(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}
end;
end;
end;
end;

procedure MyProcessMessages;
var
Msg: TMsg;
begin
while aProcessMessage(Msg) do;
end;

این هم نمونه استفاده :

var
i: Integer;
begin
for i := 0 to 2000000 do
begin
Label1.Caption := IntToStr(i);
MyProcessMessages;
Sleep(10);
end;
end;

[h4sh3m]

سلام

جناب آقاي تاجيك ممنون كه جواب دادي ولي اين چيزي نيست كه من مي خوام چون اگه درست روي مسئله رو بخونيد ميبينيد كه نوشتم از Forms استفاده نميكنم در حالي كه شما توي كدهاتون ازش استفاده كردين !!!

كلا شي اي به نام Application ندارم اگه از Forms استفاده نكنم!



با تشكر

[vcldeveloper]

ولي اين چيزي نيست كه من مي خوام چون اگه درست روي مسئله رو بخونيد ميبينيد كه نوشتم از Forms استفاده نميكنم در حالي كه شما توي كدهاتون ازش استفاده كردين !!!
لزومی نداره از همه اون کد استفاده کنید. ProcessMessages یک Message loop در ویندوز هست که نحوه عملکردش و توابع API استفاده شده در آن رو می تونید در مستندات MSDN یا هر کتاب آموزش برنامه نویسی برای ویندوز پیدا کنید. توابع کلیدی که باید درباره شان تحقیق کنید عبارتند از: PeekMessage, TranslateMessage, DispatchMessage.

البته اصلا معلوم نیست که شما این قابلیت رو برای چه کاری میخواید. اگر معلوم بود، شاید میشد گفت پیگیری کردن Application.ProcessMessage برای کار شما بیهوده هست، و بهتر هست از تکنیک دیگه ایی استفاده بشه.

[h4sh3m]

سلام جناب كشاورز

من يه برنامه اي دارم كه با استفاده از API نوشته شده و از فرم هاي خود دلفي توش استفاده نشده و به همين خاطر براي پردازش هاي زمانبر برنامه در حالت هنگ به سر ميبره كه اگه اين تكه كد باشه ديگه هنگ نميكنه برا همين مي خواستم ببينم شما چيزي براش سراغ دارين يا نه ؟
البته من خودم يه جايي ديدم (حالا پيدا نميكنم!).



با تشكر

[Felony]

آقای کشاورز که راهنمایی کردن من هم اون کد رو گذاشتم ، خودتون میتونستید قسمت ها مورد نیاز رو استخراج کنید و تابع مورد نظر رو بنویسید ، در هر صورت من براتون نوشتم :

Procedure MyProcess;
var
Msg: tMsg;
begin
While PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
if Msg.Message <> WM_QUIT then
begin
TranslateMessage(Msg);
DispatchMessage(Msg)
end
else
begin
// free all resources that reserve by application here .
end;
end;

تو اون قسمتی که Comment نوشتم منابع رزرو شده توسط برنامه رو آزاد کنید .

[h4sh3m]

سلام


جناب تاجيك از كمكتون ممنون ، من خودم قبلا يه تابعي شبيه اين نوشته بودم و كار نكرده بود البته امروز ايراد كار رو پيدا كردم كه از جاي ديگه اي بود !!! و من فكر ميكردم كه كدها ايراد دارن ولي به هر حال از راهنماييتون ممنونم.