/components/jcf2/Utils/Delay.pas

  1unit Delay;
  2
  3{ AFS 14 Jan 2K
  4 abstraction of timer mechanism
  5 Use this to call a proc after a short delay
  6
  7 Needed for IDE regiestering
  8
  9 See delayed reg. technique from sample code by Mike Remec
 10  http://www.miharemec.com/doc/ota-nmi.html
 11
 12 usage:
 13
 14 lcMyDelay := TDelay.Create;
 15 lcMyDelay.ObjectProc := lcSomeObject.Proc;
 16 lcMyDelay.DoItSoon;
 17 ....
 18 lcMyDelay.Free;
 19
 20 or
 21
 22 lcMyDelay := TDelay.Create;
 23 lcMyDelay.Proc := SomeProc;
 24 lcMyDelay.DoItSoon;
 25 ....
 26 lcMyDelay.Free;
 27
 28}
 29
 30{(*}
 31(*------------------------------------------------------------------------------
 32 Delphi Code formatter source code 
 33
 34The Original Code is Delay, released May 2003.
 35The Initial Developer of the Original Code is Anthony Steele. 
 36Portions created by Anthony Steele are Copyright (C) 1999-2000 Anthony Steele.
 37All Rights Reserved. 
 38Contributor(s): Anthony Steele. 
 39
 40The contents of this file are subject to the Mozilla Public License Version 1.1
 41(the "License"). you may not use this file except in compliance with the License.
 42You may obtain a copy of the License at http://www.mozilla.org/NPL/
 43
 44Software distributed under the License is distributed on an "AS IS" basis,
 45WITHOUT WARRANTY OF ANY KIND, either express or implied.
 46See the License for the specific language governing rights and limitations 
 47under the License.
 48
 49Alternatively, the contents of this file may be used under the terms of
 50the GNU General Public License Version 2 or later (the "GPL") 
 51See http://www.gnu.org/licenses/gpl.html
 52------------------------------------------------------------------------------*)
 53{*)}
 54
 55{$I JcfGlobal.inc}
 56
 57interface
 58
 59uses ExtCtrls;
 60
 61type
 62  TProcedure = procedure(var pbTryAgain: boolean);
 63  TObjectProcedure = procedure(var pbTryAgain: boolean) of object;
 64
 65  TDelay = class(TObject)
 66  private
 67    fiDelay: integer;
 68
 69    // can call a proc, or a proc on an object (or both)
 70    fcProc: TProcedure;
 71    fcObjectProc: TObjectProcedure;
 72
 73    fcTimer: TTimer;
 74    fbDone: boolean;
 75
 76    procedure DoItNow(Sender: TObject);
 77  public
 78    constructor Create;
 79    destructor Destroy; override;
 80
 81    procedure DoItSoon;
 82
 83    { how long to delay in Miliseconds}
 84    property Delay: integer Read fiDelay Write fiDelay;
 85
 86    { done yet? }
 87    property Done: boolean Read fbDone;
 88
 89    { proc to call }
 90    property Proc: TProcedure Read fcProc Write fcProc;
 91    property objectProc: TobjectProcedure Read fcObjectProc Write fcObjectProc;
 92  end;
 93
 94
 95implementation
 96
 97uses SysUtils;
 98
 99const
100  // default of 100ms = 1/0 second
101  DEFAULT_DELAY = 100;
102
103{ TDelay }
104constructor TDelay.Create;
105begin
106  inherited;
107
108  fcTimer := nil; // create the timer when needed
109  fcProc  := nil;
110  fcObjectProc := nil;
111
112  fiDelay := DEFAULT_DELAY; // default 1/2 sec
113  fbDone  := False;
114end;
115
116destructor TDelay.Destroy;
117begin
118  FreeAndNil(fcTimer);
119  inherited;
120end;
121
122
123procedure TDelay.DoItNow(Sender: TObject);
124var
125  lbDoAgain: boolean;
126begin
127  Assert(fcTimer <> nil);
128
129  lbDoAgain := False;
130  // disable until finished
131  fcTimer.Enabled := False;
132
133  if Assigned(fcProc) then
134    fcProc(lbDoAgain);
135  if assigned(fcObjectProc) then
136    fcObjectProc(lbDoAgain);
137
138  //FreeAndNil(fcTimer); this causes problems in IDE plug-ins
139
140  // stop unless the proc called raised the falg
141  if lbDoAgain then
142  begin
143    // restart
144    fcTimer.Enabled := True;
145  end
146  else
147  begin
148    fbDone := True;
149      { no longer timing }
150    fcTimer.OnTimer := nil;
151  end;
152end;
153
154procedure TDelay.DoItSoon;
155begin
156  // need a timer now 
157  if fcTimer = nil then
158    fcTimer := TTimer.Create(nil);
159
160  fcTimer.Interval := fiDelay;
161  fcTimer.OnTimer := DoItNow;
162  fcTimer.Enabled := True;
163  fbDone := False;
164end;
165
166end.