Timer til Tracker

Hej Sippet

DU skal lave en ny timer der baserer sig på en tråd. Hvis du gør det får du en akkrutesse på 1/1000 af et sekund.

Jeg har her et froslag til et sådan tråd timer, lavet som et komponent :

unit ThdTimer;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs;

const
  DEFAULT_INTERVAL = 1000;

type
  TThreadedTimer = class;

  TTimerThread = class(TThread)
  private
    FOwner: TThreadedTimer;
    FInterval: Word;
    FStop: THandle;
  protected
    constructor Create(CreateSuspended: Boolean); virtual;
    procedure Execute; override;
  end;

  TThreadedTimer = class(TComponent)
  private
    FEnabled: Boolean;
    FOnTimer: TNotifyEvent;
    FTimerThread: TTimerThread;

    procedure DoTimer;

    procedure SetEnabled(Value: Boolean);
    function GetInterval: Word;
    procedure SetInterval(Value: Word);
    function GetThreadPriority: TThreadPriority;
    procedure SetThreadPriority(Value: TThreadPriority);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Interval: Word read GetInterval write SetInterval
      default DEFAULT_INTERVAL;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property ThreadPriority: TThreadPriority read GetThreadPriority
      write SetThreadPriority;
  end;

procedure Register;

implementation

{ TTimerThread }

constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);

  // create event object for signaling interruptions
  FStop := CreateEvent(nil, False, False, nil);
end;

procedure TTimerThread.Execute;
begin
  repeat
      // wait for time elapse
      if WaitForSingleObject(FStop, FInterval) = WAIT_TIMEOUT then
        // if time elapsed run user-event
        Synchronize(FOwner.DoTimer);
  until Terminated;

  // Delete event object
  CloseHandle(FStop);
end;

{ TThreadedTimer }

constructor TThreadedTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  // create timer thread
  FTimerThread := TTimerThread.Create(True);
  FTimerThread.FOwner := Self;
  FTimerThread.FreeOnTerminate := False;
  FTimerThread.Priority := tpNormal;
  FTimerThread.FInterval := DEFAULT_INTERVAL;
end;

destructor TThreadedTimer.Destroy;
begin
  // Destroy thread
  // signal thread to terminate
  FTimerThread.Terminate;
  SetEvent(FTimerThread.FStop);
  // resume if stopped
  if FTimerThread.Suspended then FTimerThread.Resume;
  // wait and free
  FTimerThread.WaitFor;
  FTimerThread.Free;

  inherited Destroy;
end;

procedure TThreadedTimer.DoTimer;
begin
  if Assigned(FOnTimer) then
    FOnTimer(self);
end;

procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;

    if FEnabled then
    begin
      // When enabled resume thread
      if FTimerThread.FInterval > 0 then
      begin
        SetEvent(FTimerThread.FStop);
        FTimerThread.Resume;
      end;
    end
    else
      // suspend thread
      FTimerThread.Suspend;
  end;
end;

function TThreadedTimer.GetInterval: Word;
begin
  Result := FTimerThread.FInterval;
end;

procedure TThreadedTimer.SetInterval(Value: Word);
begin
  if Value <> FTimerThread.FInterval then
  begin
    Enabled := False;
    FTimerThread.FInterval := Value;
  end;
end;

function TThreadedTimer.GetThreadPriority: TThreadPriority;
begin
  Result := FTimerThread.Priority;
end;

procedure TThreadedTimer.SetThreadPriority(Value: TThreadPriority);
begin
  FTimerThread.Priority := Value;
end;

procedure Register;
begin
  RegisterComponents('System', [TThreadedTimer]);
end;

end.

Jens B

Kanont
Tak skal du have :)

Måske du så vil være så filnk at akseptere mit svar :-) !?!?\


Jens B