paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 09:02:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

added Timer patch from Vincent Snijders

Browse Source 
git-svn-id: trunk@1330 -
This commit is contained in:
mattias 2002-02-09 01:48:17 +00:00
parent 650efeac77
commit e8bfd838c7
2 changed files with 78 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/interfaces/gtk/gtkint.pp
View File

@ -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

69
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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