delay for some time

Please discuss general Delphi programming topics here.

delay for some time

Postby nejco » 08/11/11 21:50

Can someone help me to simplify next code. I have 10 Timers and 10 progressbars but i want to delay each progresbar for some time. Thise code work fine but is so long.
Code: Select all
procedure TForm1.Timer1Timer(Sender: TObject);
begin
tick:=tick+1;
label1.Caption:=inttostr(cas);
progressbar1.position:=trackbar1.Position;
if tick=10 then  begin
progressbar2.position:=progressbar1.position;
timer1.Enabled:=false;
timer2.enabled:=true;
tick:=0;
end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 timer1.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
progressbar3.position:=progressbar2.position;
timer3.Enabled:=true;
timer2.Enabled:=false;
end;

procedure TForm1.Timer3Timer(Sender: TObject);
begin
progressbar4.position:=progressbar3.position;
timer4.Enabled:=true;
timer3.Enabled:=false;
end;

procedure TForm1.Timer4Timer(Sender: TObject);
begin
progressbar5.position:=progressbar4.position;
timer5.Enabled:=true;
timer4.Enabled:=false;
end;

procedure TForm1.Timer5Timer(Sender: TObject);
begin
progressbar6.position:=progressbar5.position;
timer6.Enabled:=true;
timer5.Enabled:=false;
end;

procedure TForm1.Timer6Timer(Sender: TObject);
begin
progressbar7.position:=progressbar6.position;
timer7.Enabled:=true;
timer6.Enabled:=false;
end;

procedure TForm1.Timer7Timer(Sender: TObject);
begin
progressbar8.position:=progressbar7.position;
timer8.Enabled:=true;
timer7.Enabled:=false;
end;

procedure TForm1.Timer8Timer(Sender: TObject);
begin
progressbar9.position:=progressbar8.position;
timer9.Enabled:=true;
timer8.Enabled:=false;
end;

procedure TForm1.Timer9Timer(Sender: TObject);
begin
progressbar10.position:=progressbar9.position;
timer9.Enabled:=false;
end;
nejco
Member
Member
 
Posts: 1
Joined: 08/11/11 21:39

Re: delay for some time

Postby listrik » 08/06/12 08:47

This solution provides an array of 10 timer. You can increase the number of timer.

1. Create a unit with this code

Code: Select all
unit HiResTimer;

interface

uses
 Windows, DateUtils, SysUtils, Forms;

var
 HiResCountsPerMS,        //milli seconds
 HiResCountsPerUS: Int64; //micro seconds

Procedure SetHiResSecond;
Procedure ResetHiResTime(Index: Integer);

//mS or uS
Function ReadHiResTime(Index: Integer; ReadMicoSeconds: Boolean = False): Int64;
Function TimeExpired(Index: Integer; Time2Wait: Int64): Boolean;

//Resolution is approximately 10 mS. Unit can process messages, so form dioesn't freeze
Procedure Delay(Duration: Cardinal; Process_Messages: Boolean = True);

implementation

const
 MaxTimer = 10; //==> 10 Timer 0..9

var
 StartCount: Array[0..MaxTimer] of Int64;

Procedure SetHiResSecond;
begin //Divide calls to the timer by this number to get the elapsed time
 QueryPerformanceFrequency(HiResCountsPerMS);
 HiResCountsPerMS:= Round(HiResCountsPerMS / 1E3);

 QueryPerformanceFrequency(HiResCountsPerUS);
 HiResCountsPerUS:= Round(HiResCountsPerUS / 1E6);
 //Avoid division by zero
 If HiResCountsPerUS = 0 then HiResCountsPerUS:= 1;
end;

Procedure ResetHiResTime(Index: Integer);
begin
 If Index in [0..MaxTimer] then QueryPerformanceCounter(StartCount[Index]);
end;

Function ReadHiResTime(Index: Integer; ReadMicoSeconds: Boolean = False): Int64;
var
 Li, Factor: Int64;
begin
 If Index in [0..MaxTimer] then
 begin
  If ReadMicoSeconds
   then Factor:= HiResCountsPerUS
   else Factor:= HiResCountsPerMS;

  QueryPerformanceCounter(Li);
  If Li < StartCount[Index] then //counter has rolled over
   try
    Result:= Round(((High(Int64) - StartCount[Index]) + Li) / Factor);
   except
    Result:= High(Int64); //max time has elapsed.
                          //Catches "Integer Overflow" when number rolls over
   end
  else
   try
    Result:= Round((Li - StartCount[Index]) / Factor);
   except
    Result:= High(Int64); //max time has elapsed.
                          //Catches "Integer Overflow" when number rolls over
   end;
 end
 else
  Result:= High(Int64); //max time has elapsed
end;

Function TimeExpired(Index: Integer; Time2Wait: Int64): Boolean;
var
 Li: Int64;
begin
 If Index in [0..MaxTimer] then
 begin
  QueryPerformanceCounter(Li);
  try
   Result:= (Round((Li - StartCount[Index]) / HiResCountsPerMS) >= Time2Wait);
  except
   Result:= True; //time has elapsed.
   //catches "Integer Overflow" when number rolls over
  end;
 end
 else
  Result:= True;
end;

//*************************************************************
// Delay - Number of Milliseconds to wait (in 10 mS Steps)
//*************************************************************
Procedure Delay(Duration: Cardinal; Process_Messages: Boolean = True);
var
 StartTime: Cardinal;
 Running  : Boolean;

begin
 StartTime:= GetTickCount;
 Running:= (Duration > 0);
 While Running do
 begin
  try
   Running:= ((GetTickCount - StartTime) < Duration);
  except
   Running:= False; //catches "Integer Overflow" when GetTickCount rolls over
  end;
  If Process_Messages then Application.ProcessMessages;
 end;
End;

initialization
 SetHiResSecond;
end.

2. Insert this code in your main form

Code: Select all
...
ResetHiResTime(0);
While true
begin
 //do something
 Showmessage(IntToStr(ReadHiResTime(0));
end;
listrik
Member
Member
 
Posts: 1
Joined: 08/06/12 08:30


Return to Delphi Programming

Who is online

Users browsing this forum: No registered users and 1 guest