_abflash.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

unit _AbFlash;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                                  timer                                       }
{                                                                              }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com           }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2001 A.Baecker, All rights Reserved             }
{******************************************************************************}

{$I abks.inc}

interface


uses
   Windows,
   Messages, SysUtils, Classes, Controls , AbThread;

type

  TAbFlash = class(TComponent)
  private
    FEnabled      : Boolean;
    FInterval     : Cardinal;
    FOnTimer      : TNotifyEvent;
    FTimerThread    : TAbThread ;
    FThreadPriority : TThreadPriority;
    procedure SetThreadPriority(Value: TThreadPriority);
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure UpdateTimer;
  protected
    procedure Timer; dynamic;
    property OnTimer  : TNotifyEvent read FOnTimer  write SetOnTimer;
    property Interval : Cardinal     read FInterval write SetInterval default 50;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled        : Boolean read FEnabled   write SetEnabled  default True;
    property ThreadPriority : TThreadPriority read FThreadPriority write
             SetThreadPriority default tpNormal;
  end;


implementation


uses Forms;

{ TTimerThread }
{==============================================================================}

type
  TTimerThread = class(TAbThread )
  private
    tOwner    : TAbFlash;
    tInterval : Cardinal;
  protected
    procedure Execute; override;
  public
    constructor Create(Timer: TAbFlash; Enabled: Boolean);
  end;

constructor TTimerThread.Create(Timer: TAbFlash; Enabled: Boolean);
begin
  tOwner := Timer;
  inherited Create(not Enabled);
  tInterval := 16;
  FreeOnTerminate := True;
end;

procedure TTimerThread.Execute;

  function ThreadClosed: Boolean;
  begin
    Result := Terminated or Application.Terminated or (tOwner = nil);
  end;

begin
  repeat
      if (SleepEx(tInterval, False) = 0) and not ThreadClosed then
        Synchronize(tOwner.Timer);
  until ThreadClosed;
end;

{ TAbFlash }

constructor TAbFlash.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 16;
  FThreadPriority := tpNormal;
  FTimerThread := TTimerThread.Create(Self, False);
  FTimerThread.FreeOnTerminate := true;
end;

destructor TAbFlash.Destroy;
begin
  FEnabled := False;
  FOnTimer := nil;
  if (FTimerThread <> nil) then begin
    while FTimerThread.Suspended do FTimerThread.Resume;
    FTimerThread.Terminate;
  end;
  TTimerThread(FTimerThread).tOwner := nil;
  inherited Destroy;
end;

procedure TAbFlash.UpdateTimer;
begin
    if not FTimerThread.Suspended then FTimerThread.Suspend;
    TTimerThread(FTimerThread).tInterval := Interval;
    if (Interval <> 0) and FEnabled and Assigned(FOnTimer) then begin
      FTimerThread.Priority := FThreadPriority;
      while FTimerThread.Suspended do FTimerThread.Resume;
    end;
end;

procedure TAbFlash.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then begin
    FEnabled := Value;
    UpdateTimer;
  end;
end;

procedure TAbFlash.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then begin
    FInterval := Value;
    UpdateTimer;
  end;
end;


procedure TAbFlash.SetThreadPriority(Value: TThreadPriority);
begin
  if Value <> FThreadPriority then begin
    FThreadPriority := Value;
    UpdateTimer;
  end;
end;

procedure TAbFlash.SetOnTimer(Value: TNotifyEvent);
begin
  if Assigned(FOnTimer) <> Assigned(Value) then begin
    FOnTimer := Value;
    UpdateTimer;
  end else FOnTimer := Value;
end;

procedure TAbFlash.Timer;
begin
  if FEnabled and not (csDestroying in ComponentState) and
    Assigned(FOnTimer) then FOnTimer(Self);
end;

end.