openblt/Host/Source/MicroBoot/stopwatch.pas

unit StopWatch;
//***************************************************************************************
//  Description: StopWatch timer for counting minutes and seconds.
//    File Name: stopwatch.pas
//
//---------------------------------------------------------------------------------------
//                          C O P Y R I G H T
//---------------------------------------------------------------------------------------
//   Copyright (c) 2018 by Feaser    http://www.feaser.com    All rights reserved
//
//   This software has been carefully tested, but is not guaranteed for any particular
// purpose. The author does not offer any warranties and does not guarantee the accuracy,
//   adequacy, or completeness of the software and is not responsible for any errors or
//              omissions or the results obtained from use of the software.
//
//---------------------------------------------------------------------------------------
//                            L I C E N S E
//---------------------------------------------------------------------------------------
// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or
// modify it under the terms of the GNU General Public License as published by the Free
// Software Foundation, either version 3 of the License, or (at your option) any later
// version.
//
// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
// PURPOSE. See the GNU General Public License for more details.
//
// You have received a copy of the GNU General Public License along with OpenBLT. It
// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}

interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
  Classes, SysUtils, ExtCtrls;


//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
  //------------------------------ TStopWatchUpdateEvent --------------------------------
  TStopWatchUpdateEvent = procedure(Sender: TObject; Interval: String) of object;

  //------------------------------ TStopWatch -------------------------------------------
  TStopWatch = class(TObject)
  private
    FStartTime: TDateTime;
    FRunning: Boolean;
    FInterval: String;
    FInternalTimer: TTimer;
    FUpdateEvent: TStopWatchUpdateEvent;
    function    GetInterval: String;
    procedure   InternalTimerOnTimer(Sender: TObject);
  public
    constructor Create;
    destructor  Destroy; override;
    procedure   Start;
    procedure   Stop;
    property    Interval: String read GetInterval;
    property    OnUpdate: TStopWatchUpdateEvent read FUpdateEvent write FUpdateEvent;
  end;


implementation
//***************************************************************************************
// NAME:           Create
// PARAMETER:      none
// RETURN VALUE:   none
// DESCRIPTION:    Class constructor
//
//***************************************************************************************
constructor TStopWatch.Create;
begin
  // Call inherited constructor.
  inherited Create;
  // Initialize variables.
  FRunning := False;
  FInterval := '';
  FUpdateEvent := nil;
  // Create timer instance.
  FInternalTimer := TTimer.Create(nil);
  // Configure the timer instance.
  FInternalTimer.Enabled := False;
  FInternalTimer.Interval := 100;
  FInternalTimer.OnTimer := @InternalTimerOnTimer;
end; //*** end of Create ***


//***************************************************************************************
// NAME:           Destroy
// PARAMETER:      none
// RETURN VALUE:   none
// DESCRIPTION:    Class destructor.
//
//***************************************************************************************
destructor TStopWatch.Destroy;
begin
  // Stop the stopwatch.
  Stop;
  // Release timer instance.
  FInternalTimer.Free;
  // Call inherited destructor.
  inherited Destroy;
end; //*** end of Destroy ***


//***************************************************************************************
// NAME:           Start
// PARAMETER:      none
// RETURN VALUE:   none
// DESCRIPTION:    Starts the stopwatch timer
//
//***************************************************************************************
procedure TStopWatch.Start;
begin
  // Store the start time.
  FStartTime := Time;
  // Start the stopwatch.
  FRunning := True;
  // Start the internal timer.
  FInternalTimer.Enabled := True;
end; //*** end of Start ***


//***************************************************************************************
// NAME:           Stop
// PARAMETER:      none
// RETURN VALUE:   none
// DESCRIPTION:    Stops the stopwatch timer
//
//***************************************************************************************
procedure TStopWatch.Stop;
begin
  // Stop the internal timer.
  FInternalTimer.Enabled := False;
  // Stop the stopwatch.
  FRunning := False;
end; //*** end of Stop ***


//***************************************************************************************
// NAME:           GetInterval
// PARAMETER:      none
// RETURN VALUE:   Stopwatch time as string in format [min]:[sec].
// DESCRIPTION:    Obtains the stopwatch time as a formatted string.
//
//***************************************************************************************
function TStopWatch.GetInterval : String;
var
  hr  : word;
  min : word;
  sec : word;
  ms  : word;
begin
  // Decode the elased stopwatch time.
  DecodeTime(Time-FStartTime, hr, min, sec, ms);
  // Check if stopwatch is running.
  if not FRunning then
  begin
    min := 0;
    sec := 0;
  end;
  // Update the formatted stopwatch time string.
  Result := Format('%2.2d:%2.2d', [min, sec]);
end; //*** end of GetInterval ***


//***************************************************************************************
// NAME:           InternalTimerOnTimer
// PARAMETER:      Sender Source of the event.
// RETURN VALUE:   none
// DESCRIPTION:    Event handler that gets called when the timer expires.
//
//***************************************************************************************
procedure TStopWatch.InternalTimerOnTimer(Sender: TObject);
begin
  // Trigger the OnUpdate method.
  if Assigned(FUpdateEvent) then
  begin
    FUpdateEvent(Self, GetInterval);
  end;
end; //*** end of InternalTimerOnTimer ***


end.
//******************************** end of stopwatch.pas *********************************