Текущий архив: 2005.03.20;
Скачать: CL | DM;

Вниз

таймер для консоли   Найти похожие ветки 

← →
dimm ©   (2005-02-09 22:50) [0]

нужен таймер для консоли. аналог вообшем TTimer,
делал через GetTicKCount в цикле, но через некоторое время он сбивался.
если у кого есть исходник или идея. буду признателен.

---

← →
Alexander Panov ©   (2005-02-09 22:59) [1]

См. простейший пример:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls,ExtCtrls;

type
 TProcedureCallBackSimpleTimer=procedure(Sender: TObject);

 TSimpleTimer=class(TThread)
   FCS: RTL_CRITICAL_SECTION;
   FEvent: THandle;
   FInterval: Integer;
   FEnabled: Boolean;
   FOnTimer: TProcedureCallBackSimpleTimer;
   FCheckSuspended : Boolean;
 private
   procedure Timer;
   procedure SetEnabled(const aEnabledTimer: Boolean);
   procedure SetCallback(const Proc:TProcedureCallBackSimpleTimer);
 protected
   procedure Execute;override;
 public
   constructor Create;
   destructor Destroy;override;

   property Interval: Integer read FInterval write FInterval;
   property Enabled: Boolean read FEnabled write SetEnabled;
   property OnTimer: TProcedureCallBackSimpleTimer
               write SetCallback;
 end;

 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   Button2: TButton;
   Button3: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 TT: TSimpleTimer;

implementation

{$R *.dfm}

constructor TSimpleTimer.Create;
begin
 inherited Create(True);
 FEvent := CreateEvent(nil,True,False,nil);
 if FEvent=0 then raise Exception.Create("Error!");
 FEnabled := False;
 FInterval := 1000;
 FOnTimer := nil;
 FCheckSuspended := False;
 InitializeCriticalSection(FCS);
 FreeOnTerminate := True;
end;

destructor TSimpleTimer.Destroy;
begin
 CloseHandle(FEvent);
 DeleteCriticalSection(FCS);
end;

procedure TSimpleTimer.Timer;
begin
 if Assigned(FOnTimer) then
 begin
   EnterCriticalSection(FCS);
   FOnTimer(Self);
   LeaveCriticalSection(FCS);
 end;
end;

procedure TSimpleTimer.Execute;
begin
 while not Terminated do
 begin
   if Terminated then Break;
   WaitForSingleObject(FEvent,FInterval);
   if FCheckSuspended then
   begin
     FCheckSuspended := False;
     Continue;
   end;
   Timer;
 end;
end;

procedure TSimpleTimer.SetEnabled(const aEnabledTimer: BOolean);
begin
 FEnabled := aEnabledTimer;
 if FEnabled
   then Resume
   else
   begin
     Suspend;
     FCheckSuspended := True;
   end;
end;

procedure TSimpleTimer.SetCallBack(const Proc:TProcedureCallBackSimpleTimer);
begin
 FOnTimer := Proc;
end;

procedure MCallBack(Sender: TObject);
begin
 Form1.Memo1.Lines.Add("Тик-Так");
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 TT := TSimpleTimer.Create;
 TT.Interval := 1000;
 TT.OnTimer := @MCallBack;
 TT.Enabled := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 TT.Enabled := not TT.Enabled;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 TT.Terminate;
end;

end.


---

← →
Leonid Troyanovsky ©   (2005-02-09 23:35) [2]

> dimm ©   (09.02.05 22:50)  
> нужен таймер для консоли. аналог вообшем TTimer,


CreateWaitableTimer and so on.

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2005-02-09 23:44) [3]

> Alexander Panov ©   (09.02.05 22:59) [1]
..
>  while not Terminated do
>  begin
>    if Terminated then Break;
>    WaitForSingleObject(FEvent,FInterval);


Если FInterval = INFINITE, то все приседания с Terminated
малополезны. Т.е., стоит сделать свой Terminate в котором
устанавливать FEvent. Ну, и, наверное, свой Destroy, бо
Terminate не виртуальный. И, в любом (не INFINITE) случае,
полезно анализировать результат  WaitForSingleObject.

--
Regards, LVT.

---

Страницы: 1 вся ветка

Текущий архив: 2005.03.20;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.078 c