+ WinApi: added SetTimer/Killtimer based on existing Widgetset.CreateTimer as part of lclextentions integration

git-svn-id: trunk@23417 -

lcl/include/winapi.inc

@@ -1272,6 +1272,41 @@ begin
     Result := (Right <= Left) or (Bottom <= Top);
 end;
 
+{------------------------------------------------------------------------------
+  Function: KillTimer
+  Params: hWnd:
+          uIDEvent:
+  Returns:
+
+ ------------------------------------------------------------------------------}
+function KillTimer(Wnd: HWND; uIDEvent: UINT_PTR): BOOL;
+var
+  MapID: record
+    case Boolean of
+      True: (nIDEvent: UINT_PTR; Wnd: HWND);
+      False: (filler: array[1..2] of Pointer);
+  end;
+  ID: Cardinal;
+  InfoPtr: PTimerInfo;
+begin
+  if MTimerMap = nil then Exit(False);
+  if MTimerInfo = nil then Exit(False);
+
+  // make sure all is zero
+  FillByte(MapID, SizeOf(MapID), 0);
+  MapID.Wnd := Wnd;
+  MapID.nIDEvent := uIdEvent;
+
+  if not MTimerMap.GetData(MapID, ID) then Exit(False);
+
+  InfoPtr := MTimerInfo.GetDataPtr(ID);
+  if InfoPtr = nil then Exit(False);
+
+  Result := Widgetset.DestroyTimer(InfoPtr^.Handle);
+  MTimerInfo.Delete(ID);
+  MTimerMap.Delete(MapID);
+end;
+
 {------------------------------------------------------------------------------
   Function: MakeLParam
   Params:
@@ -1450,6 +1485,76 @@ begin
   Result := True;
 end;
 
+{------------------------------------------------------------------------------
+  Function: SetTimer
+  Params: hWnd:
+          nIDEvent:
+          uElapse:
+          lpTimerFunc:
+  Returns:
+
+ ------------------------------------------------------------------------------}
+function SetTimer(Wnd: HWND; nIDEvent: UINT_PTR; uElapse: UINT;  lpTimerFunc: TTimerProc): UINT_PTR;
+var
+  MapID: record
+    case Boolean of
+      True: (nIDEvent: UINT_PTR; Wnd: HWND);
+      False: (filler: array[1..2] of Pointer);
+  end;
+  ID: Cardinal;
+  Info: TTimerInfo;
+  InfoPtr: PTimerInfo;
+  Existing: Boolean;
+begin
+  if MTimerMap = nil
+  then MTimerMap := TMap.Create({$ifdef CPU32}itu8{$else}itu16{$endif}, SizeOf(Cardinal));
+  if MTimerInfo = nil
+  then MTimerInfo := TMap.Create(itu4, SizeOf(TTimerInfo));
+
+  // make sure all is zero
+  FillByte(MapID, SizeOf(MapID), 0);
+  MapID.Wnd := Wnd;
+  MapID.nIDEvent := nIdEvent;
+
+  Existing := MTimerMap.GetData(MapID, ID);
+  if Existing
+  then begin
+    InfoPtr := MTimerInfo.GetDataPtr(ID);
+    if InfoPtr = nil
+    then Existing := False
+    else Widgetset.DestroyTimer(InfoPtr^.Handle);
+  end;
+
+  if not Existing
+  then begin
+    // new id
+    Inc(MTimerSeq);
+    ID := MTimerSeq;
+    Info.Wnd := Wnd;
+    // for null windows we create an ID else the ID passed is used
+    if Wnd = 0
+    then Info.IDEvent := ID
+    else Info.IDEvent := nIdEvent;
+    MapID.nIDEvent := Info.IDEvent;
+    MTimerMap.Add(MapID, ID);
+    InfoPtr := @Info;
+  end;
+
+  InfoPtr^.TimerProc := lpTimerFunc;
+  InfoPtr^.Handle := WidgetSet.CreateTimer(uElapse, @TTimerID(PtrUInt(ID)).TimerNotify);
+
+  if not Existing
+  then MTimerInfo.Add(ID, Info); // add after all data is set
+
+  if InfoPtr^.Handle <> 0
+  then Exit(ID); // success
+
+  // cleanup
+  MTimerInfo.Delete(ID);
+  MTimerMap.Delete(MapID);
+  Result := 0;
+end;
+
 {------------------------------------------------------------------------------
   Function:
   Params:

lcl/include/winapih.inc

@@ -174,6 +174,8 @@ function IsWindowEnabled(handle: HWND): boolean; {$IFDEF IF_BASE_MEMBER}virtual;
 function IsWindowVisible(handle: HWND): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function IsZoomed(handle: HWND): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
+//function KillTimer --> independent
+
 procedure LeaveCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function LineTo(DC: HDC; X, Y: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
@@ -237,6 +239,7 @@ function SetStretchBltMode(DC: HDC; StretchMode: Integer): Integer; {$IFDEF IF_B
 function SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function SetTextCharacterExtra(_hdc : hdc; nCharExtra : Integer):Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+//function SetTimer --> independent
 function SetWindowLong(Handle: HWND; Idx: Integer; NewLong : PtrInt): PtrInt;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@@ -298,6 +301,8 @@ function IntersectRect(var DestRect: TRect; const SrcRect1, SrcRect2: TRect): Bo
 function IsCharAlphaNumeric(c : Char) : Boolean;
 function IsRectEmpty(const ARect: TRect): Boolean;
 
+function KillTimer(Wnd: HWND; uIDEvent: UINT_PTR): BOOL;
+
 function MakeWParam(l, h: Word): WPARAM; inline;
 function MakeLParam(l, h: Word): LPARAM; inline;
 function MakeLResult(l, h: Word): LRESULT; inline;
@@ -310,10 +315,11 @@ function PointToSmallPoint(const P : TPoint) : TSmallPoint; inline;
 function RGB(R, G, B : Byte) : TColorRef; inline;
 
 function ScrollWindow(hWnd: HWND; XAmount, YAmount: Integer; Rect, ClipRect: PRect): Boolean; inline;
-function SetRect(Var ARect : TRect; xLeft,yTop,xRight,yBottom : Integer) : Boolean;
+function SetRect(var ARect : TRect; xLeft,yTop,xRight,yBottom : Integer) : Boolean;
 function SetRectEmpty(var ARect: TRect): Boolean;
 function SetScrollPos(Handle: HWND; nBar, nPos: Integer; bRedraw: Boolean): Integer;
 function SetScrollRange(Handle: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: Boolean): Boolean;
+function SetTimer(Wnd: HWND; nIDEvent: UINT_PTR; uElapse: UINT;  lpTimerFunc: TTimerProc): UINT_PTR;
 function SmallPointToPoint(const P : TSmallPoint) : Tpoint;
 
 function UnionRect(var DestRect: TRect; const SrcRect1, SrcRect2: TRect): Boolean; //pbd

lcl/interfacebase.pp

@@ -79,6 +79,9 @@ type
     lcDragDockStartOnTitleClick // ability to start drag/dock events on title bar click
   );
 
+type
+  TWSTimerProc = procedure of object;
+
   { TWidgetSet }
 
   TWidgetSet = class(TObject)
@@ -117,7 +120,7 @@ type
     function  IsHelpKey(Key: Word; Shift: TShiftState): Boolean; virtual;
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle; virtual; abstract;
+    function CreateTimer(Interval: integer; TimerProc: TWSTimerProc): THandle; virtual; abstract;
     function DestroyTimer(TimerHandle: THandle): boolean; virtual; abstract;
     function AppHandle: Thandle; virtual;
 

lcl/interfaces/carbon/carbonint.pas

@@ -116,7 +116,7 @@ type
     function  IsHelpKey(Key: Word; Shift: TShiftState): Boolean; override;
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle; override;
     function DestroyTimer(TimerHandle: THandle) : boolean; override;
     function PrepareUserEvent(Handle: HWND; Msg: Cardinal; wParam: WParam;
       lParam: LParam; out Target: EventTargetRef): EventRef;

lcl/interfaces/carbon/carbonobject.inc

@@ -556,7 +556,7 @@ begin
   inherited Create;
   FTerminating := False;
 
-  FTimerMap := TMap.Create(its4, SizeOf(TFNTimerProc));
+  FTimerMap := TMap.Create(its4, SizeOf(TWSTimerProc));
   FCurrentCursor := 0;
   FMainMenu := 0;
   FCaptureWidget := 0;
@@ -1217,7 +1217,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TimerCallback(inTimer: EventLoopTimerRef; inUserData: UnivPtr);
 var
-  TimerFunc: TFNTimerProc;
+  TimerFunc: TWSTimerProc;
 begin
   {$IFDEF VerboseTimer}
     DebugLn('TimerCallback');
@@ -1242,7 +1242,7 @@ end;
 
   Creates new timer with specified interval and callback function
  ------------------------------------------------------------------------------}
-function TCarbonWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle;
+function TCarbonWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle;
 var
   Timer: EventLoopTimerRef;
 begin

lcl/interfaces/cocoa/cocoaint.pas

@@ -47,9 +47,9 @@ type
   { TCocoaTimerObject }
 
   TCocoaTimerObject=objcclass(NSObject)
-    func : TFNTimerProc;
+    func : TWSTimerProc;
     procedure timerEvent; message 'timerEvent';
-    class function initWithFunc(afunc: TFNTimerProc): TCocoaTimerObject; message 'initWithFunc:';
+    class function initWithFunc(afunc: TWSTimerProc): TCocoaTimerObject; message 'initWithFunc:';
   end;
 
   { TCocoaAppDelegate }
@@ -84,7 +84,7 @@ type
     procedure AppBringToFront; override;
     procedure AppSetTitle(const ATitle: string); override;
 
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; override;
     function DestroyTimer(TimerHandle: THandle): boolean; override;
     function AppHandle: THandle; override;
 
@@ -281,7 +281,7 @@ begin
     NSApp.dockTile.setBadgeLabel(NSStringUtf8(ATitle));
 end;
 
-function TCocoaWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle;
+function TCocoaWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle;
 var
   timer : NSTimer;
   user  : TCocoaTimerObject;
@@ -387,7 +387,7 @@ begin
   if Assigned(@func) then func;
 end;
 
-class function TCocoaTimerObject.initWithFunc(afunc: TFNTimerProc): TCocoaTimerObject;
+class function TCocoaTimerObject.initWithFunc(afunc: TWSTimerProc): TCocoaTimerObject;
 begin
   Result:=alloc;
   Result.func:=afunc;

lcl/interfaces/fpgui/fpguiint.pp

@@ -73,7 +73,7 @@ type
     procedure SetDesigning(AComponent: TComponent); override;  
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; override;
     function DestroyTimer(TimerHandle: THandle): boolean; override;
 
     // device contexts

lcl/interfaces/fpgui/fpguiobject.inc

@@ -23,11 +23,11 @@ type
   private
     FLCLTimer: TTimer;
     FTimer: TfpgTimer;
-    FCallback: TFNTimerProc;
+    FCallback: TWSTimerProc;
   protected
     procedure FPGTimer(Sender: TObject);
   public
-    constructor Create(AInterval: Integer; ACallbackFunc: TFNTimerProc);
+    constructor Create(AInterval: Integer; ACallbackFunc: TWSTimerProc);
     destructor  Destroy; override;
 
     property Timer : TfpgTimer read FTimer;
@@ -41,7 +41,7 @@ begin
     FCallback;
 end;
 
-constructor TFPGUITimer.Create(AInterval: Integer; ACallbackFunc: TFNTimerProc);
+constructor TFPGUITimer.Create(AInterval: Integer; ACallbackFunc: TWSTimerProc);
 begin
   FTimer := TfpgTimer.Create(AInterval);
   FTimer.OnTimer:=@FPGTimer;
@@ -91,7 +91,7 @@ end;
 
   Creates a new timer and sets the callback event.
  ------------------------------------------------------------------------------}
-function TFpGuiWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle;
+function TFpGuiWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle;
 var
   Timer: TFPGUITimer;
 begin

lcl/interfaces/gtk/gtkglobals.pp

@@ -220,7 +220,7 @@ type
   PGtkITimerInfo = ^TGtkITimerinfo;
   TGtkITimerInfo = record
     TimerHandle: guint;        // the gtk handle for this timer
-    TimerFunc  : TFNTimerProc; // owner function to handle timer
+    TimerFunc  : TWSTimerProc; // owner function to handle timer
   end;
 
 var

lcl/interfaces/gtk/gtkint.pp

@@ -286,7 +286,7 @@ type
                              ConvertAmpersandsToUnderScores: Boolean) : PChar;
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle; override;
+    function CreateTimer(Interval: integer; TimerProc: TWSTimerProc) : THandle; override;
     function DestroyTimer(TimerHandle: THandle) : boolean; override;
     procedure DestroyLCLComponent(Sender: TObject);virtual;
 

lcl/interfaces/gtk/gtkwidgetset.inc

@@ -1484,17 +1484,17 @@ end;
   Design: A callback to the TTimer class is implemented.
  ------------------------------------------------------------------------------}
 function TGtkWidgetSet.CreateTimer(Interval: integer;
-  TimerFunc: TFNTimerProc) : THandle;
+  TimerProc: TWSTimerProc) : THandle;
 var
   TimerInfo: PGtkITimerinfo;
 begin
-  if ((Interval < 1) or (not Assigned(TimerFunc)))
+  if ((Interval < 1) or (not Assigned(TimerProc)))
   then
     Result := 0
   else begin
     New(TimerInfo);
     FillByte(TimerInfo^,SizeOf(TGtkITimerinfo),0);
-    TimerInfo^.TimerFunc := TimerFunc;
+    TimerInfo^.TimerFunc := TimerProc;
     {$IFDEF VerboseTimer}
     DebugLn(['TGtkWidgetSet.CreateTimer Interval=',dbgs(Interval)]);
     {$ENDIF}
@@ -1502,7 +1502,7 @@ begin
     if Result = 0 then
       Dispose(TimerInfo)
     else begin
-      TimerInfo^.TimerFunc := TimerFunc;
+      TimerInfo^.TimerFunc := TimerProc;
       TimerInfo^.TimerHandle:=Result;
       FTimerData.Add(TimerInfo);
     end;

lcl/interfaces/nogui/noguiint.pp

@@ -61,7 +61,7 @@ type
     destructor Destroy; override;
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle; override;
     function DestroyTimer(TimerHandle: THandle) : boolean; override;
     procedure DestroyLCLComponent(Sender: TObject);virtual;
   public
@@ -137,7 +137,7 @@ begin
   inherited Destroy;
 end;
 
-function TNoGUIWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc
+function TNoGUIWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc
   ): THandle;
 begin
   Result:=0;

lcl/interfaces/qt/qtint.pp

@@ -114,7 +114,7 @@ type
     procedure SetDesigning(AComponent: TComponent); override;
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; override;
     function DestroyTimer(TimerHandle: THandle): boolean; override;
 
     // device contexts

lcl/interfaces/qt/qtobject.inc

@@ -69,7 +69,7 @@ end;
 
   Creates a new timer and sets the callback event.
  ------------------------------------------------------------------------------}
-function TQtWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle;
+function TQtWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle;
 var
   QtTimer: TQtTimer;
 begin

lcl/interfaces/qt/qtobjects.pas

@@ -33,7 +33,7 @@ uses
   // Free Pascal
   Classes, SysUtils, Types,
   // LCL
-  LCLType, LCLIntf, Menus, LCLProc, Graphics, ClipBrd, ExtCtrls;
+  LCLType, LCLIntf, Menus, LCLProc, Graphics, ClipBrd, ExtCtrls, Interfacebase;
 
 type
   // forward declarations
@@ -596,11 +596,11 @@ type
   TQtTimer = class(TQtObject)
   private
     FTimerHook: QTimer_hookH;
-    FCallbackFunc: TFNTimerProc;
+    FCallbackFunc: TWSTimerProc;
     FId: Integer;
     FAppObject: QObjectH;
   public
-    constructor CreateTimer(Interval: integer; const TimerFunc: TFNTimerProc; App: QObjectH); virtual;
+    constructor CreateTimer(Interval: integer; const TimerFunc: TWSTimerProc; App: QObjectH); virtual;
     destructor Destroy; override;
     procedure AttachEvents; override;
     procedure DetachEvents; override;
@@ -3690,7 +3690,7 @@ end;
   Returns: Nothing
  ------------------------------------------------------------------------------}
 constructor TQtTimer.CreateTimer(Interval: integer;
-  const TimerFunc: TFNTimerProc; App: QObjectH);
+  const TimerFunc: TWSTimerProc; App: QObjectH);
 begin
   inherited Create;
   FDeleteLater := True;

lcl/interfaces/win32/win32def.pp

@@ -30,7 +30,7 @@ unit Win32Def;
 interface
 
 uses
-  Windows, Classes, LCLType;
+  Windows, Classes, LCLType, Interfacebase;
 
 const
   // it is not good to use WM_USER since many programs use it.
@@ -41,7 +41,7 @@ type
   PWin32TimerInfo = ^TWin32Timerinfo;
   TWin32TimerInfo = record
     TimerID: UINT;         // the windows timer ID for this timer
-    TimerFunc: TFNTimerProc; // owner function to handle timer
+    TimerFunc: TWSTimerProc; // owner function to handle timer
   end;
 
 var

lcl/interfaces/win32/win32int.pp

@@ -188,7 +188,7 @@ type
     procedure ShowHide(Sender: TObject);
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle; override;
     function DestroyTimer(TimerHandle: THandle) : boolean; override;
 
     // thread synchronize support

lcl/interfaces/win32/win32object.inc

@@ -546,7 +546,7 @@ end;
   Design: A timer which calls TimerCallBackProc, is created.
     The TimerCallBackProc calls the TimerFunc.
  ------------------------------------------------------------------------------}
-function TWin32WidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle;
+function TWin32WidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle;
 var
   TimerInfo: PWin32TimerInfo;
 begin

lcl/interfaces/wince/wincedef.pp

@@ -107,7 +107,7 @@ type
   PWinCETimerInfo = ^TWinCETimerinfo;
   TWinCETimerInfo = record
     TimerID: UINT;         // the windows timer ID for this timer
-    TimerFunc: TFNTimerProc; // owner function to handle timer
+    TimerFunc: TWSTimerProc; // owner function to handle timer
   end;
 
 {$ifdef WinCE}

lcl/interfaces/wince/winceint.pp

@@ -204,7 +204,7 @@ type
     procedure ShowHide(Sender: TObject);
 
     // create and destroy
-    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle; override;
+    function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle; override;
     function DestroyTimer(TimerHandle: THandle) : boolean; override;
 
     // thread synchronize support

lcl/interfaces/wince/winceobject.inc

@@ -452,7 +452,7 @@ end;
   Design: A timer which calls TimerCallBackProc, is created.
     The TimerCallBackProc calls the TimerFunc.
  ------------------------------------------------------------------------------}
-function TWinCEWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle;
+function TWinCEWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle;
 var
   TimerInfo: PWinCETimerInfo;
 begin

lcl/lclintf.pas

@@ -52,7 +52,7 @@ uses
   {$IFDEF Windows}Windows, ShellApi, {$ENDIF}
   {$IFDEF Darwin}MacOSAll, {$ENDIF}
   Types, Math, Classes, SysUtils, LCLType, LCLProc, GraphType, InterfaceBase,
-  LResources, FileUtil, UTF8Process;
+  LResources, FileUtil, UTF8Process, Maps, LMessages;
 
 {$ifdef Trace}
   {$ASSERTIONS ON}
@@ -98,12 +98,60 @@ function OpenURL(AURL: String): Boolean;
 
 implementation
 
+type
+  { TTimerID }
+
+  TTimerID = class
+    procedure TimerNotify;
+  end;
+
+  PTimerInfo = ^TTimerInfo;
+  TTimerInfo = record
+    Wnd: HWND;
+    IDEvent: UINT_PTR;
+    TimerProc: TTimerProc;
+    Handle: THandle;
+  end;
+
 var
+  MTimerMap: TMap = nil;   // hWnd + nIDEvent -> ID
+  MTimerInfo: TMap = nil;  // ID -> TTimerInfo
+  MTimerSeq: Cardinal;
+
   FPredefinedClipboardFormats:
     array[TPredefinedClipboardFormat] of TClipboardFormat;
   LowerCaseChars: array[char] of char;
   UpperCaseChars: array[char] of char;
 
+
+  { TTimerMap }
+
+procedure TTimerID.TimerNotify;
+var
+  Info: PTimerInfo;
+  ID: Cardinal;
+begin
+  if MTimerInfo = nil then Exit;
+
+  // this is a bit of a hack.
+  // to pass the ID if the timer, it is passed as an cast to self
+  // So there isn't realy an instance of TTimerID
+  ID := PtrUInt(Self);
+  Info := MTimerInfo.GetDataPtr(ID);
+  if Info = nil then Exit;
+
+  if Info^.TimerProc = nil
+  then begin
+    // send message
+    PostMessage(Info^.Wnd, LM_TIMER, Info^.IDEvent, 0);
+  end
+  else begin
+    // a timerproc was passed
+    Info^.TimerProc(Info^.Wnd, LM_TIMER, Info^.IDEvent, GetTickCount);
+  end;
+end;
+
+
 {$IFNDEF WINDOWS}
 function GetTickCount: DWord;
 begin
@@ -314,4 +362,7 @@ end;
 initialization
   InternalInit;
 
+finalization
+  FreeAndNil(MTimerMap);
+  FreeAndNil(MTimerInfo);
 end.

lcl/lcltype.pp

@@ -67,6 +67,7 @@ type
   TUTF8Char = String[7];
 {$ENDIF USE_UTF8BIDI_LCL}
   UINT = LongWord;
+  UINT_PTR = PtrUInt;
 
   TTranslateString = type String;
 
@@ -2398,9 +2399,20 @@ type
 
 
 //------------------------------------------------------------------------------
-// prototype for timer callback
+//timer
 type
-  TFNTimerProc = procedure of object;
+  TTimerProc = procedure(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
+
+  TLMTimer = record
+    Msg: Cardinal;
+    TimerID: LongWord;
+    TimerProc: TFarProc;
+    Result: LRESULT;
+  end;
+
+  // delphi
+  TFNTimerProc = TFarProc;
+
 
 //------------------------------------------------------------------------------
 // clipboard