new fpgPause() function.

This function blocks the calling method, but allows for framework
messages still to be processed. Could be useful for some developers.

1 files changed, 13 insertions, 0 deletions

diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas
index 88143118..8532f959 100644
--- a/src/corelib/fpg_main.pas
+++ b/src/corelib/fpg_main.pas
@@ -399,6 +399,7 @@ procedure fpgCheckTimers;
 procedure fpgResetAllTimers;
 function  fpgClosestTimer(ctime: TDateTime; amaxtime: integer): integer;
 function  fpgGetTickCount: DWord;
+procedure fpgPause(MilliSeconds: Cardinal);
 
 // Rectangle, Point & Size routines
 function  InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
@@ -601,6 +602,18 @@ begin
   Result := DWord(Trunc(Now * MSecsPerDay));
 end;
 
+{ blocking function for the caller, but still processes framework messages }
+procedure fpgPause(MilliSeconds: Cardinal);
+var
+  lStart: TDateTime;
+begin
+   lStart := Now * MSecsPerDay;
+   repeat
+     fpgApplication.ProcessMessages;
+   until ((Now*MSecsPerDay)-lStart) > MilliSeconds;
+end;
+
+
 function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
 begin
   if Assigned(@Rect) then