Thema: Delphi SetTimer in einer Klasse

Einzelnen Beitrag anzeigen

Tryer

Registriert seit: 16. Aug 2003
200 Beiträge
 
#3

Re: SetTimer in einer Klasse

  Alt 13. Apr 2004, 19:58
Seltsam das Du es überhaupt so zum laufen bekommst, ich würde da mit Zugriffsverletzungen rechnen

Aus der Win32-Hilfe:
Zitat:
The TimerProc function is an application-defined callback function that processes WM_TIMER messages.

VOID CALLBACK TimerProc(

HWND hwnd, // handle of window for timer messages
UINT uMsg, // WM_TIMER message
UINT idEvent, // timer identifier
DWORD dwTime // current system time
);
Wie Du vielleicht erkennst hat das nicht viel mit Deiner Methoden TWas.TimerProc zu tun.

Hier mal noch eine andere Lösungsmöglichkeit, die zudem den Vorteil bietet das man innerhalb der (globalen) Callback-Prozedur über "dwUser" auch die Möglichkeit hat auf eine Objektinstanz zuzugreifen:
Delphi-Quellcode:
program Project1;

uses
  Windows,
  Classes,
  Types,
  mmSystem,
  SysUtils;

type
   TLittleTimer = class(TObject)
   private
     FCount: Cardinal;
     FTimerID: Cardinal;
   public
     constructor Create;
     destructor Destroy; override;
     function IsActive: Boolean;
     procedure Pieps;
     property TimeCallCount: Cardinal read FCount;
     procedure Start(Delay: Cardinal);
     procedure Stop;
  end;

var
  Was: TLittleTimer;

{ CallBack-Prozedur
  Obwohl diese Prozedur global deklariert ist erlaube ich mir auf
  die als private deklarierten Felder von TLittleTimer zuzugreifen,
  schliesslich ist diese Routine fester Bestandteil von TLittleTimer.
  In gleicher Weise liesse sich hier auch ein Event auslösen.
}

procedure MyTimeCallBack(uID, uMsg: Cardinal; dwUser, dw1, dw2: DWord); stdcall;
var
  Tmr: TLittleTimer;
begin
  Tmr := TLittleTimer(dwUser);
  Inc(Tmr.FCount);
  Tmr.Pieps;
end;

{ TLittleTimer }

constructor TLittleTimer.Create;
begin
  inherited;
  FCount := 0;
  FTimerID := 0;
end;

destructor TLittleTimer.Destroy;
begin
  Stop;
  inherited;
end;

function TLittleTimer.IsActive: Boolean;
begin
  Result := FTimerID <> 0;
end;

procedure TLittleTimer.Pieps;
begin
  Beep;
end;

procedure TLittleTimer.Start(Delay: Cardinal);
begin
  if FTimerID = 0 then
  begin
    FCount := 0;
    // Timer starten und eigene Instanz in dwUser übergeben
    FTimerID := TimeSetEvent(Delay, 0, @MyTimeCallBack, Cardinal(Self),
      TIME_PERIODIC);
  end;
end;

procedure TLittleTimer.Stop;
begin
  if FTimerID <> 0 then
    TimeKillEvent(FTimerID);
end;
{------------------------------------------------------------------------------}

begin
  Was := TLittleTimer.Create;
  try
    Was.Start(500);
    if Was.IsActive then
    begin
      while Was.TimeCallCount < 5 do
      begin
        Sleep(1);
        DoSomething;
      end;
    end;
  finally
    Was.Free;
  end;
end.
"TimeSetEvent", "TimeKillEvent" und "TimeProc" sind die passenden Schlagworte in der Win32-Hilfe.

MfG,
Tryer
  Mit Zitat antworten Zitat