Keskustelu: Koodit: Pascal: Threaded Timer

unit ThdTimer;

interface

uses
  Classes, Windows;

type
  (* Luodaan TThreadista, koska se on helpoin tapa saada oma säie. *)
  TThdTimer = class(TThread)
  private
    (* Tämä kertoo, onko ajastin päällä *)
    FEnabled: Boolean;
    (* Tämä on aikaraja *)
    FInterval: Cardinal;
    (* TNotifyEvent, joka suoritetaan, kun ajastin laukeaa *)
    FOnTimer: TNotifyEvent;
    (* Tätä tarvitaan toimintaan *)
    FStop: THandle;
  protected
    (* Suoritettava osa *)
    procedure Execute; override;
  public
    (* Constructor *)
    constructor Create(CreateSuspended: Boolean);

    (* Propertyt aiemmille ominaisuuksille *)
    property Enabled: Boolean read FEnabled write FEnabled;
    property Interval: Cardinal read FInterval write FInterval;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    (* Thread kutsuu tätä aikarajan ummetessa *)
    procedure Go;
  end;

implementation

(* Tätä kutsutaan, kun ajastin laukeaa. Tarkistetaan, että OnTimer on määritetty ja olemme käynnissä *)
procedure TThdTimer.Go;
begin
  if (Assigned(OnTimer) and Enabled) then OnTimer(Self);
end;

(* Constructor, kutsuu aiempaa ja asettaa oletusarvot ominaisuuksille *)
constructor TThdTimer.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FStop := CreateEvent(nil, False, False, nil);
  FInterval := 10;
  FEnabled := True;
end;

(* Tätä suoritetaan jatkuvasti.
   Niin kauan, kuin ollaan käynnissä, odotetaan aikarajan verran FStopia, joka ei koskaan vastaa :) *)
procedure TThdTimer.Execute;
begin
  while not Terminated do
    if WaitForSingleObject(FStop, FInterval) = WAIT_TIMEOUT then
      Synchronize(nil, Go);
end;

end.

unit Unit1;

interface

uses
  Forms, ThdTimer;

type
  TForm1 = class(TForm)
    procedure TimerTimer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  public
    Timer: TThdTimer;
  end;

var
  Form1: TForm1;
  Timer2: TThdTimer;

implementation

{$R *.dfm}

procedure TForm1.TimerTimer(Sender: TObject);
begin
  Form1.Color := (Form1.Color + $010101) and $ffffff;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Form1.Color := (Form1.Color) xor (Random(3) * $77 + Random(3) * $7700 + Random(3) * $770000);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  (* Luodaan ajastimet, asetetaan aikaraja ja toiminto *)
  Timer := TThdTimer.Create(False);
  Timer.Interval := 10;
  Timer.OnTimer := TimerTimer;

  Timer2 := TThdTimer.Create(False);
  Timer2.Interval := 1000;
  Timer2.OnTimer := Timer2Timer;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Timer.Destroy;
  Timer2.Destroy;
end;

end.