paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 15:10:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: add 64bit safe version of callback and timer functions. Issue #23052

Browse Source 
git-svn-id: trunk@39164 -
This commit is contained in:
blikblum 2012-10-25 14:19:27 +00:00
parent 98c3996b73
commit 384db6d21b
4 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/win32/win32callback.inc
View File

@ -2728,7 +2728,7 @@ end;
Calls the timerfunction in the Timer Object in the LCL Calls the timerfunction in the Timer Object in the LCL
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TimerCallBackProc(window_hwnd : hwnd; msg : DWORD; idEvent: UINT; dwTime: DWORD); stdcall; procedure TimerCallBackProc(window_hwnd : hwnd; msg : DWORD; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
Var Var
TimerInfo: PWin32TimerInfo; TimerInfo: PWin32TimerInfo;
n: Integer; n: Integer;

2
lcl/interfaces/win32/win32def.pp
View File

@ -40,7 +40,7 @@ type
{ lazarus win32 Interface definition for additional timer data needed to find the callback} { lazarus win32 Interface definition for additional timer data needed to find the callback}
PWin32TimerInfo = ^TWin32Timerinfo; PWin32TimerInfo = ^TWin32Timerinfo;
TWin32TimerInfo = record TWin32TimerInfo = record
TimerID: UINT; // the windows timer ID for this timer TimerID: UINT_PTR; // the windows timer ID for this timer
TimerFunc: TWSTimerProc; // owner function to handle timer TimerFunc: TWSTimerProc; // owner function to handle timer
end; end;

8
lcl/interfaces/win32/win32extra.pas
View File

@ -410,6 +410,14 @@ const
SHGFI_LARGEICON = $000000000; SHGFI_LARGEICON = $000000000;
SHGFI_ICON = $000000100; SHGFI_ICON = $000000100;
type
//64bit safe Timer functions and callback
//todo: remove as soon the last supported fpc version has updated header (rev 22526)
TIMERPROC = procedure (hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
function SetTimer(hWnd:HWND; nIDEvent:UINT_PTR; uElapse:UINT; lpTimerFunc: TIMERPROC): UINT_PTR; external 'user32' name 'SetTimer';
function KillTimer(hWnd:HWND; uIDEvent:UINT_PTR):WINBOOL; external 'user32' name 'KillTimer';
implementation implementation
uses uses

6
lcl/interfaces/win32/win32object.inc
View File

@ -562,7 +562,7 @@ begin
if (Interval > 0) and (TimerFunc <> nil) then begin if (Interval > 0) and (TimerFunc <> nil) then begin
New(TimerInfo); New(TimerInfo);
TimerInfo^.TimerFunc := TimerFunc; TimerInfo^.TimerFunc := TimerFunc;
TimerInfo^.TimerID := Windows.SetTimer(0, 0, Interval, @TimerCallBackProc); TimerInfo^.TimerID := Win32Extra.SetTimer(0, 0, Interval, @TimerCallBackProc);
if TimerInfo^.TimerID=0 then if TimerInfo^.TimerID=0 then
dispose(TimerInfo) dispose(TimerInfo)
else begin else begin
@ -587,9 +587,9 @@ begin
while (n>0) do begin while (n>0) do begin
dec(n); dec(n);
TimerInfo := FTimerData[n]; TimerInfo := FTimerData[n];
if (TimerInfo^.TimerID=UINT(TimerHandle)) then if (TimerInfo^.TimerID=UINT_PTR(TimerHandle)) then
begin begin
Result := Boolean(Windows.KillTimer(0, UINT(TimerHandle))); Result := Boolean(Win32Extra.KillTimer(0, UINT_PTR(TimerHandle)));
FTimerData.Delete(n); FTimerData.Delete(n);
Dispose(TimerInfo); Dispose(TimerInfo);
end; end;