paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 01:55:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

added Timer patch from Vincent Snijders

Browse Source 
git-svn-id: trunk@2013 -
This commit is contained in:
mattias 2002-08-17 23:40:38 +00:00
parent 3f45b7a427
commit 06b1f43748
1 changed files with 3 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -4751,43 +4751,6 @@ begin
{$EndIf}
end;
{------------------------------------------------------------------------------
Function: KillTimer
Params: hWnd:
nIDEvent:
Returns:
WARNING: There seems to be a bug in gtk-1.2.x which breaks gtk_timeout_remove
thus we can't dispose PGtkITimerinfo here (s.a. gtkTimerCB).
------------------------------------------------------------------------------}
function TGTKObject.KillTimer(hWnd : HWND; uIDEvent : cardinal) : boolean;
var
n : integer;
TimerInfo : PGtkITimerinfo;
begin
Assert(False, 'Trace:removing timer!!!');
n := FTimerData.Count;
while (n > 0) do begin
dec (n);
TimerInfo := PGtkITimerinfo (FTimerData.Items[n]);
if ((pointer (hWnd) <> nil) and (hWnd = TimerInfo^.Handle))
and (uIDEvent = TimerInfo^.IDEvent) then
begin
{$IFDEF VerboseTimer}
writeln('TGTKObject.KillTimer TimerInfo=',HexStr(Cardinal(TimerInfo),8),' ID=',uIDEvent,' CurTimerCount=',FTimerData.Count,' OldTimerCount=',FOldTimerData.Count);
{$ENDIF}
gtk_timeout_remove (TimerInfo^.TimerHandle);
// mark as invalid
TimerInfo^.TimerHandle:= 0;
TimerInfo^.TimerFunc := nil;
FTimerData.Delete(n);
//FOldTimerData.Add(TimerInfo);
Dispose (TimerInfo);
end;
end;
Result:=true;
end;
{------------------------------------------------------------------------------
Function: LineTo
Params: none
@ -6648,46 +6611,6 @@ begin
Assert(False, Format('trace:< [TgtkObject.SetTextColor] DC: 0x%x Color: %8x --> %8x', [Integer(DC), Color, Result]));
end;
{------------------------------------------------------------------------------
Function: SetTimer
Params: hWnd:
nIDEvent:
uElapse:
lpTimerFunc:
Returns: a GTK-timer id
This function will create a GTK timer object and associate a callback to it.
Design: Currently only a callback to the TTimer class is implemented.
------------------------------------------------------------------------------}
function TGTKObject.SetTimer(hWnd: HWND; nIDEvent, uElapse: integer;
lpTimerFunc: TFNTimerProc) : integer;
var
PTimerInfo: PGtkITimerinfo;
begin
KillTimer(hWnd,nIDEvent);
if ((hWnd = 0) or (lpTimerFunc = nil) or (uElapse<1))
then
Result := 0
else begin
New (PTimerInfo);
Fillchar(PTimerInfo^,SizeOf(TGtkITimerinfo),0);
PTimerInfo^.Handle := hWND;
PTimerInfo^.IDEvent := nIDEvent;
PTimerInfo^.TimerFunc := lpTimerFunc;
FTimerData.Add (PTimerInfo);
{$IFDEF VerboseTimer}
writeln('TGTKObject.SetTimer ',HexStr(Cardinal(PTimerInfo),8),' ',nIDEvent,' CurTimerCount=',FTimerData.Count,' OldTimerCount=',FOldTimerData.Count);
{$ENDIF}
Result:= gtk_timeout_add(uElapse, @gtkTimerCB, PTimerInfo);
PTimerInfo^.TimerHandle:=Result;
if Result=0 then begin
KillTimer(hWnd,nIDEvent);
end;
end;
end;
{------------------------------------------------------------------------------
Procedure: SetWindowLong
Params: none
@ -7589,6 +7512,9 @@ end;
{ =============================================================================
$Log$
Revision 1.190 2002/11/23 13:48:46 mattias
added Timer patch from Vincent Snijders
Revision 1.189 2002/11/12 10:16:20 lazarus
MG: fixed TMainMenu creation