دستوری شبیه به sleep اما برنامه قفل نشه

[Mask]

با سلام
از چه دستوری میتوان به جای sleep استفاده کرد که روند اجرایی برنامه متوقف بشه اما برنامه فریز نشه؟

[BORHAN TEC]

سلام
میتونید از تابعی مثل این استفاده کنید:
procedure SpecialSleep(SleepTime: Integer);
var
oldTime, newTime: Integer;
begin
oldTime := GetTickCount;
while True do
begin
Application.ProcessMessages;
newTime := GetTickCount;
if (newTime - oldTime) > SleepTime then
break;
end;
end;
موفق باشید...

[Mask]

ممنون از راهنماییتون.
این کد رو خودم قبلا نوشته ام.
اما :
اولا استفاده از Application.ProcessMessages رو زیاد دوست ندارم و منطقی نمیبینم.
دوما : بازم مشکلی که باقی میمونه اینه که کاربر تا پایان کار sleep نمیتونه برنامه رو ببنده ، و این زیاد خوشایند نیست.
نظرتون چیه؟
راه بهتری سراغ ندارید؟

[بهروز عباسی]

ممنون از راهنماییتون.
این کد رو خودم قبلا نوشته ام.
اما :
اولا استفاده از Application.ProcessMessages رو زیاد دوست ندارم و منطقی نمیبینم.
دوما : بازم مشکلی که باقی میمونه اینه که کاربر تا پایان کار sleep نمیتونه برنامه رو ببنده ، و این زیاد خوشایند نیست.
نظرتون چیه؟
راه بهتری سراغ ندارید؟
درود
یادمه یه تاپیک با موضوعی مشابه دیدم!
ایجاد وقفه و Thread رو سرچ کنن ببین پیدا نمیکنی چون وقتی دنبال multi threading بودم چنین تاپیکی دیدم
آقای کشاورز پاسخ داد بود

[بهروز عباسی]

حاجی بفرما اینم لینک
http://barnamenevis.org/showthread.php?26406-%D8%A7%DB%8C%D8%AC%D8%A7%D8%AF-%D8%AA%D8%A7%D8%AE%DB%8C%D8%B1-%D8%AF%D8%B1-%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87&highlight=thread

[MohsenB]

سلام

بیاید یکم کدبازی کنیم :

برای یه حل ساده برای این کار من به فکر زیر افتادم که یکم از اسمبلی استفاده کنم و از روشهایی که تو اسمبلی استفاده میشه :
البته این کد اولیه هست شاید مشکل داشته باشه و شاید راه بهتری هم وجود داشته باشه ، البته روی کامپیوتر من که اجرا شد ، بهر حال به نظرم بجای این همه جواب دادن با سرچ تو اینترنت و کپی و پیست کردن بهتره یکم کارای خلاقانه انجام بدیم و یکم تولید علم کنیم نه همش استفاده کنیم .

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

type
TForm1 = class(TForm)
...
private
procedure DoMyDelayTimer(Sender :TObject);
procedure MBDelay(ms :Cardinal);
...
end;
...
var
LastPC :Cardinal;

procedure TForm1.DoMyDelayTimer(Sender :TObject);
begin
TTimer(Sender).Enabled:= False;
TTimer(Sender).Free;
asm
push LastPC
ret
end;
end;

procedure TForm1.MBDelay(ms :Cardinal);
begin
with TTimer.Create(nil) do begin
Interval:= ms;
OnTimer:= DoMyDelayTimer;
Enabled:= True;
end;
end;


procedure TForm1.btnrunClick(Sender: TObject);
begin
mmo1.Lines.Add('1');
mmo1.Lines.Add('2');
//Tartib Zir Sabet Ast
MBDelay(500);
asm
call @df
@df:
pop eax
add eax, 11
mov LastPC, eax
end;
Exit;
//End Of Tartib Sabet
mmo1.Lines.Add('3');
mmo1.Lines.Add('4');
mmo1.Lines.Add('5');
mmo1.Lines.Add('6');
end;

توضیح اینکه : وقتی کلید btnrun زده شد کدها تا عدد 2 به ممو اضافه میشود و از روال خارج میشود ، قبل از خروج پروگرام کانتر محل اجرای خط بعدی در متغییر LastPC ذخیره میشود .
و همچنین قبل از خروج ، روال MBDelay فراخوانی شده که درون آن یک تایمر ساخته می شود و زمان آن تنظیم می شود . بعد از سپری شدن زمان مقدار پروگرام کانتر برگردانده شده و ادامه روال دکمه اجرا می شود .
همچنین فکر کنم این کد به معماری پردازنده هم ربط داشته باشد که اگر روی سیستم شما اجرا نشد اون عدد 11 رو تغییر بدید . انشاءالله تو روزهای آینده بیشتر روش کار میکنم .
همینطور به احتمال زیاد مشکل متغییر های روال صدا زننده هم احتمالا وجود دارد که برای این کد باید از کدهای مستقل از متغییر محلی استفاده شود .

موفق باشید

[MohsenB]

سلام

موفق شدم کد رو خیلی ساده کنم و قابل استفاده برای همه :

var
LastPC :Cardinal;


procedure TForm1.DoMyDelayTimer(Sender :TObject);
begin
TTimer(Sender).Enabled:= False;
TTimer(Sender).Free;
asm
push LastPC
ret
end;
end;

procedure TForm1.MBDelay(ms :Cardinal);
begin
with TTimer.Create(nil) do begin
Interval:= ms;
OnTimer:= DoMyDelayTimer;
Enabled:= True;
end;
asm
mov esp, ebp
pop ebp
pop eax
mov LastPC, eax
end;
end;

حالا دیگه نیازی به اون کدهای اسمبلی درون روال صدا کننده نیست . خیلی راحت مثل همون دستور Sleep جایگزین میشه . برای مثال :

procedure TForm1.btnrunClick(Sender: TObject);
begin
mmo1.Lines.Add('1');
mmo1.Lines.Add('2');
MBDelay(1000);
mmo1.Lines.Add('3');
mmo1.Lines.Add('4');
MBDelay(1000);
mmo1.Lines.Add('5');
mmo1.Lines.Add('6');
end;

موفق باشید

[Felony]

برای یه حل ساده برای این کار من به فکر زیر افتادم که یکم از اسمبلی استفاده کنم و از روشهایی که تو اسمبلی استفاده میشه :
سلام ،

اگر خودت کد رو نوشتی آفرین ؛
یه 10 دقیقه ای داشتیم Call Stack و Stack رو بررسی میکردیم تا به فکر پلیدی که پشت کده پنهانه برسیم :)
مدت ها هست تو این بخش و خیلی از بخش های دیگه این سایت همچین خلاقیت هایی مرده و به شخصه به دلیل کمبود سوالات و مباحث تخصصی رقبت نمیکنم مثل قبل اینجا فعالیت کنم ( البته کمبود وقت هم دارم ) و مثل خیلی های دیگه فقط به تاپیک هایی که حس کنجکاویم رو تحریک کنن سر میزنم ...

خلاصه خوشمان آمد ... ، متشکر .

[MohsenB]

سلام ،

اگر خودت کد رو نوشتی آفرین ؛
یه 10 دقیقه ای داشتیم Call Stack و Stack رو بررسی میکردیم تا به فکر پلیدی که پشت کده پنهانه برسیم :)
مدت ها هست تو این بخش و خیلی از بخش های دیگه این سایت همچین خلاقیت هایی مرده و به شخصه به دیلیل کمبود سوالات و مباحث تخصصی رقبت نمیکنم مثل قبل اینجا فعالیت کنم و مثل خیلی های دیگه فقط به تاپیک هایی که حس کنجکاویم رو تحریک کنن سر میزنم ...

خلاصه خوشمان آمد ... ، متشکر .

فکر پلیدی که پشتش نیست . کاری که انجام میشه به زبان ساده اینه که :

وقتی تابعی صدا زده میشه آدرس برگشت هم تو پشته ذخیره میشه ، حالا من تو اون تابع MBDelay اومدم این آدرس رو برداشتم و توی متغییر LastPC ذخیره کردم . این کار باعث شده دیگه به محل صدا زننده تابع تاخیر برنگرده . در موقع رویداد تایمر هم اون آدرس تو پشته ریخته میشه و دستور بازگشت صدا زده میشه . این دستور میاد آخرین آدرس موجود در پشته رو برمیداره و به اون آدرس می ره ... .

فکر کردم قابل فهم باشه توضیح ندادم .
ولی حالا فکر کنم بعلت تفاوت در کامپایلرها تو ورژن های مختلف دلفی چون با استک متفاوت کار میکنن ، تو ورژنای متفاوت کار نکنه . اگر تونستی شما برا دلفی 7 همینو بنویسی یه آفرین هم شما داری . من اگه وقت کنم فردا شب یا پس فردا شب مینویسمش .

موفق باشید

[Felony]

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


وقتی تابعی صدا زده میشه آدرس برگشت هم تو پشته ذخیره میشه ، حالا من تو اون تابع MBDelay اومدم این آدرس رو برداشتم و توی متغییر LastPC ذخیره کردم . این کار باعث شده دیگه به محل صدا زننده تابع تاخیر برنگرده . در موقع رویداد تایمر هم اون آدرس تو پشته ریخته میشه و دستور بازگشت صدا زده میشه . این دستور میاد آخرین آدرس موجود در پشته رو برمیداره و به اون آدرس می ره ... .
من توضیحاتی که در پست اول دادی رو ندیدم ، تاپیک رو باز کردم و سوال رو خوندم و طبق معمول اومدم از آخر تاپیک بیام به اول ببینم کجا به جواب رسیده که پست دوم شما که کد رو توش اصلاح کردی دیدم و اجراش کردم و برام جالب شد بررسیش کنم ... وگرنه با اون توضیح نیازی به بررسی بیشتر نبود .


اگر تونستی شما برا دلفی 7 همینو بنویسی یه آفرین هم شما داری .
انقدر کار سرم ریخته که وقت سر خاروندن ندارم چه برسه به نصب دلفی 7 و ور رفتن با Stack اون وگرنه اساسی پایت بودم .

شب خوش .

[BORHAN TEC]

سلام
جناب MohsenB روشی که شما به کار برده اید با وجود خلاقیت به کار رفته مشکلات بزرگی دارد:
- این روش در همه نسخه های دلفی قابل اجرا نیست. به عنوان مثال من نتوانستم در Delphi XE3 با کامپایلر 32 بیتی از آن اجرا بگیرم.
- در کامپایلر 64 بیتی نمی توان از بلاک asm استفاده کرد!

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

var
HasClosed: Boolean;

procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := 'Start Sleep';
SpecialSleep(10000);
Caption := 'End Sleep';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
HasClosed := True;
end;

procedure TForm1.SpecialSleep(SleepTime: Cardinal);
var
oldTime, newTime: Cardinal;
begin
HasClosed := False;
oldTime := GetTickCount;

while True do
begin
Application.ProcessMessages;
newTime := GetTickCount;

if (newTime - oldTime >= SleepTime) then
Break;

if HasClosed then
Break;
end;

end;

[MohsenB]

سلام
جناب MohsenB روشی که شما به کار برده اید با وجود خلاقیت به کار رفته مشکلات بزرگی دارد:
- این روش در همه نسخه های دلفی قابل اجرا نیست. به عنوان مثال من نتوانستم در Delphi XE3 با کامپایلر 32 بیتی از آن اجرا بگیرم.
- در کامپایلر 64 بیتی نمی توان از بلاک asm استفاده کرد!

به عنوان روش بهتر می توانید از کدی مثل این استفاده کنید، که مشکلات یاد شده را هم توسط یک فلگ حل کرده است:
...[/PASCAL]

سلام

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


موفق باشید