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