mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-28 08:42:55 +02:00
added Timer patch from Vincent Snijders
git-svn-id: trunk@1330 -
This commit is contained in:
parent
650efeac77
commit
e8bfd838c7
@ -32,7 +32,8 @@ interface
|
||||
{$ifdef Trace}
|
||||
{$ASSERTIONS ON}
|
||||
{$endif}
|
||||
|
||||
|
||||
{ $DEFINE VerboseTimer}
|
||||
{ $DEFINE VerboseMouseBugfix}
|
||||
{ $DEFINE RaiseExceptionOnNilPointers}
|
||||
|
||||
@ -61,7 +62,7 @@ type
|
||||
FMessageQueue: TLazQueue; // queue of PMsg
|
||||
FPaintMessages: TDynHashArray; // hasharray of PLazQueueItem
|
||||
WaitingForMessages: boolean;
|
||||
|
||||
|
||||
FRCFilename: string;
|
||||
FRCFileParsed: boolean;
|
||||
FRCFileAge: integer;
|
||||
@ -193,6 +194,9 @@ type
|
||||
function UpdateHint(Sender: TObject): Integer; override;
|
||||
function RecreateWnd(Sender: TObject): Integer; override;
|
||||
|
||||
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
|
||||
function DestroyTimer(TimerHandle: integer) : boolean; override;
|
||||
|
||||
{$I gtkwinapih.inc}
|
||||
|
||||
property RCFilename: string read FRCFilename write SetRCFilename;
|
||||
@ -225,8 +229,7 @@ begin
|
||||
LastLeft:=EmptyLastMouseClick;
|
||||
LastMiddle:=EmptyLastMouseClick;
|
||||
LastRight:=EmptyLastMouseClick;
|
||||
FOldTimerData:=TList.Create;
|
||||
|
||||
|
||||
// clipboard
|
||||
ClipboardSelectionData:=TList.Create;
|
||||
for c:=Low(TClipboardType) to High(TClipboardType) do begin
|
||||
@ -275,14 +278,6 @@ var i: integer;
|
||||
ced: PClipboardEventData;
|
||||
c: TClipboardType;
|
||||
begin
|
||||
// timer
|
||||
for i:=0 to FOldTimerData.Count-1 do begin
|
||||
t:=PGtkITimerinfo(FOldTimerData[i]);
|
||||
dispose(t);
|
||||
end;
|
||||
FOldTimerData.Free;
|
||||
FOldTimerData:=nil;
|
||||
|
||||
// clipboard
|
||||
for i:=0 to ClipboardSelectionData.Count-1 do begin
|
||||
ced:=PClipboardEventData(ClipboardSelectionData[i]);
|
||||
@ -309,6 +304,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.105 2002/11/23 13:48:44 mattias
|
||||
added Timer patch from Vincent Snijders
|
||||
|
||||
Revision 1.104 2002/11/12 13:16:05 lazarus
|
||||
MG: fixed TListView with more than 2 columns
|
||||
|
||||
|
@ -788,7 +788,6 @@ begin
|
||||
end;
|
||||
|
||||
FreeStockItems;
|
||||
|
||||
// MG: using gtk_main_quit is not a clean way to close
|
||||
//gtk_main_quit;
|
||||
end;
|
||||
@ -890,6 +889,71 @@ Begin
|
||||
Result:=0;
|
||||
End;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: CreateTimer
|
||||
Params: Interval:
|
||||
TimerFunc: Callback
|
||||
Returns: a GTK-timer id (use this ID to destroy timer)
|
||||
|
||||
This function will create a GTK timer object and associate a callback to it.
|
||||
|
||||
Design: A callback to the TTimer class is implemented.
|
||||
------------------------------------------------------------------------------}
|
||||
function TGTKObject.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer;
|
||||
var
|
||||
TimerInfo: PGtkITimerinfo;
|
||||
begin
|
||||
if ((Interval < 1) or (TimerFunc = nil))
|
||||
then
|
||||
Result := 0
|
||||
else begin
|
||||
New(TimerInfo);
|
||||
TimerInfo^.TimerFunc := TimerFunc;
|
||||
{$IFDEF VerboseTimer}
|
||||
writeln('TGTKObject.SetTimer ',HexStr(Cardinal(TimerInfo),8),' CurTimerCount=',FTimerData.Count,' OldTimerCount=',FOldTimerData.Count);
|
||||
{$ENDIF}
|
||||
Result:= gtk_timeout_add(Interval, @gtkTimerCB, TimerInfo);
|
||||
if Result = 0 then
|
||||
Dispose(TimerInfo)
|
||||
else begin
|
||||
TimerInfo^.TimerFunc := TimerFunc;
|
||||
TimerInfo^.TimerHandle:=Result;
|
||||
FTimerData.Add(TimerInfo);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: DestroyTimer
|
||||
Params: TimerHandle
|
||||
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.DestroyTimer(TimerHandle: integer) : 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 (TimerInfo^.TimerHandle=TimerHandle) then
|
||||
begin
|
||||
{$IFDEF VerboseTimer}
|
||||
writeln('TGTKObject.KillTimer TimerInfo=',HexStr(Cardinal(TimerInfo),8),' TimerHandle=',TimerHandle,' CurTimerCount=',FTimerData.Count,' OldTimerCount=',FOldTimerData.Count);
|
||||
{$ENDIF}
|
||||
gtk_timeout_remove(TimerInfo^.TimerHandle);
|
||||
FTimerData.Delete(n);
|
||||
Dispose(TimerInfo);
|
||||
end;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TGtkObject.LoadFromXPMFile(Bitmap: TObject; Filename: PChar);
|
||||
var
|
||||
GdiObject: PGdiObject;
|
||||
@ -6650,6 +6714,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.292 2002/11/23 13:48:44 mattias
|
||||
added Timer patch from Vincent Snijders
|
||||
|
||||
Revision 1.291 2002/11/21 18:49:53 mattias
|
||||
started OnMouseEnter and OnMouseLeave
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user