Mega Code Archive

 
Categories / Delphi / Examples
 

Uygulamanızın önceliği 2

//daha önce bu konu ile ilgili Sayın T. Bağrıyanık'ın bir örneği vardı. UYGULAMANIZA ÖNCELİK vermek ve Eski durumuna geri getirmek. var PriorityClass, Priority: Integer; begin //Uygulamanın ilk öncelik değerleri alınıyor PriorityClass := GetPriorityClass(GetCurrentProcess); Priority := GetThreadPriority(GetCurrentThread); // Uygulamanın önceliğinin arttırılması işlemi SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); Sleep(10); //////////////Çalışacak kodlar //////////////................ //////////////Sonda uygulama ilk önceliğe geri dönderiliyor.... SetThreadPriority(GetCurrentThread, Priority); SetPriorityClass(GetCurrentProcess, PriorityClass); end; //Theread Kullanımına örnek---CPU Hızının ölçülmesi unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Label1: TLabel; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); private Stop: Boolean; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function GetCPUSpeed: Double; const DelayTime = 500; // measure time in ms var TimerHi, TimerLo: DWORD; PriorityClass, Priority: Integer; begin PriorityClass := GetPriorityClass(GetCurrentProcess); Priority := GetThreadPriority(GetCurrentThread); SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); Sleep(10); asm dw 310Fh // rdtsc mov TimerLo, eax mov TimerHi, edx end; Sleep(DelayTime); asm dw 310Fh // rdtsc sub eax, TimerLo sbb edx, TimerHi mov TimerLo, eax mov TimerHi, edx end; SetThreadPriority(GetCurrentThread, Priority); SetPriorityClass(GetCurrentProcess, PriorityClass); Result := TimerLo / (1000.0 * DelayTime); end; procedure TForm1.Timer1Timer(Sender: TObject); begin Stop := False; while not Stop do begin Label1.Caption := Format('CPU hızı: %f MHz', [GetCPUSpeed]); Application.ProcessMessages; sleep(500); Stop := True; end; end; procedure TForm1.Button1Click(Sender: TObject); begin close; end; end.