هل يمكن ان نجعل قيمة الوقت في التايمر Timer اقل من واحد مللي ثانيه ؟

الخاصية Interval في Timer هي من نوع Cardinal

وكما تعلم Cardinal يكون من 0 الى 4294967295

سؤال جميل يطرح سؤال أخر ضمنيا

كيف يمكن أن تصمم تايمر عندها ممكن بتصوري بسهولة تجيب عن هذا السؤال

طبعا بغض النظر هل نحتاج إلى وقت أقل من الميلي ثانية أم لا ؟ فقط كما قال الأخ لانه

اقتباس

طلع هذا السؤال في رأسي

يوجد عداد خاص تتميز به معالجات البانتيوم يسمى RDTSC.. هذا العداد يبدء العد كلما قمت بتغدية الحاسوب بالتيار الكهربائي وفق سرعة نبضات المعالج, و هو عداد كبير سعته هي 64بيت أي 8بايتات.

يمكن الوصول لقيم دقيقة بإستعمال تعليمة لغة التجميع RDTSC المعروفة في معالجات pentium فقط التي تقوم بقراءة العداد من سعة Int64 و وضعه في السجلين edx :eax حيث edx تضم word الأعلى و eax تضم word الأدنى:

function RDTSC: comp;
var TimeStamp: record case byte of
				 1: (Whole: comp);
				 2: (Lo, Hi: Longint);
			   end;
begin
  asm
	db $0F; db $31;
	mov [TimeStamp.Lo], eax
	mov [TimeStamp.Hi], edx
  end;
  Result := TimeStamp.Whole;
end;

يمكنك وضع هذه التعليمة ماشرة وسط الكود بإستعمال هذه التوجيهات على هذا النحو في المثال السابق الذي سيمكن من حساب عدد نبضات المعالج اللازمة لتنفيذ التعليمات التي بين الإستدعاء الأول للدالة والإستدعاء الثاني.

فيمكن كتابتها في نسخ ديلفي التي أدمجت تعليمة RDTSC في ديلفي إنطلاقا من النسخة السادسة بكل بساطة:

function Read_RDTSC: Int64;
asm
  rdtsc
end;

ملاحظة: هذا العداد لا يعد الوقت بأجزاء الثانية و لكن بوحدة سرعة المعالج.

كود كامل لإستخدام هذا العداد بدقة متناهية لحساب الوقت, يمكن الإعتماد على هذا المثال في برمجة time قوي يعوض timer لويندوز بإذماجه داخل thread.

كود الوحدة الرئيسية:

// It's a microsecond timer, based on TSC Pentium register.
// It's not a component, only two objects:
// - simple timer
// - and stacked one, provided more powerfull code
//
// timer written for Delphi 7, but, afaik, will work on earlier versions too.
//
// Leonid Koninin, 2007
//
// No any warranties. Can be used absolutely free.
//

unit uLkTimer;

interface

type
  TLkBaseTimer = class
  protected
	FOver: int64;
	FStart: int64;
	FDiv: int64;
  public
	property TickStart: int64 read FStart;
	property TickDivisor: int64 read FDiv;

	function Tick: int64; register;
	function TickPeriod: int64; register;

	procedure TimeStart;
	function TimePeriod: int64;

	procedure Calibrate;

	constructor Create;
	class function One: TLkBaseTimer;
  end;

  TLkStackTimer = class
  protected
	stk: array[0..30] of int64;
	stp: Integer;
	FDiv: int64;
	FOver: int64;
	function Tick: int64; register;
	function TickInterval(pop: Boolean = true): int64;
  public
	procedure TimerStart;
	function TimerInterval(pop: Boolean = true): int64;

	procedure Calibrate;
	constructor Create;
  end;

function HPT: TLkBaseTimer;

implementation

uses SysUtils,
  MMSystem;

function HPT: TLkBaseTimer;
begin
  result := TLkBaseTimer.One;
end;

{ TLkBaseTimer }

var
  AnOne: TLkBaseTimer = nil;

procedure TLkBaseTimer.Calibrate;
var
  mtmr, tmr: int64;
  i, j: Integer;
begin
  FOver := 0;
  mtmr := $FFFFFFFFFF;
  for i := 0 to 19 do
	begin
	  TimeStart;
	  tmr := TickPeriod;
	  if mtmr > tmr then mtmr := tmr;
	end;
  FOver := mtmr;
  timeBeginPeriod(1);
  sleep(50);
  TimeStart;
  Sleep(750);
  tmr := Tick - FStart - FOver;
  timeEndPeriod(1);
// microseconds
  FDiv := tmr div 750000;
end;

constructor TLkBaseTimer.Create;
begin
  inherited Create;
  Calibrate;
end;

class function TLkBaseTimer.One: TLkBaseTimer;
begin
  if not assigned(AnOne) then AnOne := TLkBaseTimer.Create;
  result := AnOne;
end;

function TLkBaseTimer.Tick: int64; register;
asm
  rdtsc;
end;

function TLkBaseTimer.TickPeriod: int64; register;
begin
  result := Tick - FStart - FOver;
end;

function TLkBaseTimer.TimePeriod: int64; register;
begin
  result := Tick - FStart - FOver;
  result := result div FDiv;
end;

procedure TLkBaseTimer.TimeStart;
begin
  FStart := Tick;
end;

{ TLkStackTimer }

procedure TLkStackTimer.Calibrate;
var
  i: Integer;
  zz: array[0..19] of int64;
begin
  for i := 0 to 19 do
	begin
	  TimerStart;
	  zz := TickInterval;
	end;
  FOver := zz[0];
  for i := 1 to 19 do if FOver > zz then FOver := zz;
  FDiv := AnOne.TickDivisor;
end;

constructor TLkStackTimer.Create;
begin
  inherited Create;
  stp := -1;
  Calibrate;
end;

function TLkStackTimer.Tick: int64;
asm
  rdtsc;
end;

function TLkStackTimer.TickInterval(pop: Boolean = true): int64;
begin
  result := AnOne.Tick - stk[stp] - FOver;
  if (pop) and (stp >= 0) then dec(stp);
end;

function TLkStackTimer.TimerInterval(pop: Boolean): int64;
begin
  result := AnOne.Tick - stk[stp] - FOver;
  result := result div FDiv;
  if (pop) and (stp >= 0) then dec(stp);
end;

procedure TLkStackTimer.TimerStart;
begin
  inc(stp);
  stk[stp] := Tick;
end;

initialization
  TLkBaseTimer.One;

finalization
  if Assigned(AnOne) then FreeAndNil(AnOne);

end.

كود برنامج التطبيقي:

program test;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  uLkTimer in 'uLkTimer.pas';

var
  n: int64;
  i: Integer;
  zz: array[ 1..10 ] of int64;
  st: TLkStackTimer;
begin
  writeln('one second is:');
  HPT.TimeStart;
  sleep(1000);
  n := hpt.TimePeriod;
  writeln(n);

  writeln('wait 10x700ms seconds:');
  try
	st := TLkStackTimer.Create;
	st.TimerStart;
	for i := 1 to 10 do
	  begin
		sleep(700);
		zz := st.TimerInterval(false);
	  end;
	n := st.TimerInterval;
	for i := 1 to 10 do
	  begin
		write(zz);
		if i>1 then write(':',zz-zz[i-1]);
		writeln;
	  end;
	writeln(n);
  finally
	st.Free;
  end;

  readln;
end.

الف شكر اخي على المعلومات

هل يوجد حل مشابه لمعالجات AMD