abophour.pas

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

unit AbOpHour;

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

{$I abks.inc}

interface

uses
  Windows,
  Classes,
  Graphics,
  Controls,
  extctrls,
  Messages,
  SysUtils,
  Inifiles,
  {****** Abakus VCL - Units ******}
  _GClass,
  _AbInfo,
  _AbProc,
  AbFlashT;

type

  TOpHrOption = (opResetOnLimit, opStopOnLimit, opPresetOnZero);
  TOpHrOptions = set of TOpHrOption;

  TOpHrIndicate = (oiHour, oiHourMin, oiHourMinSec);

  TTimeSetting = class(TPersistent)
  private
    FHour: Integer;
    FMin: Integer;
    fSec: Integer;
  protected
    procedure SetHour(Value: Integer);
    procedure SetMin(Value: Integer);
    procedure SetSec(Value: Integer);
  public
    procedure SetValue(hr, mi, se: Integer);
  published
    property Hour: Integer read FHour write SetHour;
    property Min: Integer read FMin write SetMin;
    property Sec: Integer read fSec write SetSec;
  end;

  TAbOpHourCounter = class(TAbGraphicControl)
  private
    FBevelOuter: TAbSBevel;
    FBevelInner: TAbSBevel;
    FLimit: TTimeSetting;
    FPresetValue: TTimeSetting;
    FSeparatorHour: string;
    FSeparatorMin: string;
    FSeparatorSec: string;
    FSeparatorChar: string;
    FIniSettings: TIniSettings;
    FHourDigits: Integer;
    FCountDown: Boolean;                { count downwards until 0 if true }
    FCount: Boolean;                    { starts counting }
    FOptions: TOpHrOptions;
    FIndicate: TOpHrIndicate;
    FOnZero: TNotifyEvent;
    FOnLimit: TNotifyEvent;
    rClock: TRect;
    min_h: Smallint;
    min_w: Smallint;
    sTime: TSize;
    ComponentInit: Boolean;
  protected
    procedure SetIndicate(Value: TOpHrIndicate);
    procedure SetCountDown(Value: Boolean);
    procedure SetCount(Value: Boolean);
    procedure SetSeparatorHour(Value: string);
    procedure SetSeparatorMin(Value: string);
    procedure SetSeparatorSec(Value: string);
    procedure SetSeparatorChar(Value: string);
    procedure SetHourDigits(Value: Integer);
    procedure PaintTime(can: TCanvas; w, h: Smallint);
    procedure Paint; override;
    procedure ParamChange(Sender: TObject); override;
    procedure WMFlash(var Message: TMessage); message WM_FLASH;
    procedure BeforeFirstPaint;
    procedure CheckTime;
    procedure IncSec(var h, m, s: Integer);
    procedure DecSec(var h, m, s: Integer);
    procedure HandleIni(Ini: TIniFile; Read: Boolean);
  public
    isZero: Boolean;
    isLimit: Boolean;
    hr: Integer;
    mi: Integer;
    se: Integer;
    procedure SetTime(Hour, Min, Sec: Integer);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
    property OnMouseDown;
    property OnMouseUp;
    property Align;
    property Font;
    property Visible;
    property Width default 113;
    property Height default 24;
    property Count: Boolean read FCount write SetCount default false;
    property CountDown: Boolean read FCountDown write SetCountDown default
    false;
    property SeparatorHour: string read FSeparatorHour write SetSeparatorHour;
    property SeparatorMin: string read FSeparatorMin write SetSeparatorMin;
    property SeparatorSec: string read FSeparatorSec write SetSeparatorSec;
    property SeparatorChar: string read FSeparatorChar write SetSeparatorChar;
    property HourDigits: Integer read FHourDigits write SetHourDigits default 4;
    property BevelInner: TAbSBevel read FBevelInner write FBevelInner;
    property BevelOuter: TAbSBevel read FBevelOuter write FBevelOuter;
    property IniSettings: TIniSettings read FIniSettings write FIniSettings;
    property OnZero: TNotifyEvent read FOnZero write FOnZero;
    property OnLimit: TNotifyEvent read FOnLimit write FOnLimit;
    property Limit: TTimeSetting read FLimit write FLimit;
    property PresetValue: TTimeSetting read FPresetValue write FPresetValue;
    property Options: TOpHrOptions read FOptions write FOptions default [];
    property Indicate: TOpHrIndicate read FIndicate write SetIndicate default
    oiHourMinSec;

  end;

implementation


procedure TTimeSetting.SetValue(hr, mi, se: Integer);
var
  minPlus, hourPlus : Integer;
begin
  minPlus := 0;
  hourPlus := 0;

  if se > 59 then
  begin
    minPlus := se div 60;
    fSec := se - (minPlus * 60);
  end
  else
    fSec := se;

  if (mi + minPlus) > 59 then
  begin
    hourPlus := (mi + minPlus) div 60;
    FMin := (mi + minPlus) - (hourPlus * 60);
  end
  else
    FMin := mi + minPlus;

  FHour := hr + hourPlus;
end;


procedure TTimeSetting.SetHour(Value: Integer);
begin
  if FHour <> Value then
  begin
    SetValue(Value, FMin, fSec);
  end;
end;

procedure TTimeSetting.SetMin(Value: Integer);
begin
  if FMin <> Value then
  begin
    SetValue(FHour, Value, fSec);
  end;
end;

procedure TTimeSetting.SetSec(Value: Integer);
begin
  if fSec <> Value then
  begin
    SetValue(FHour, FMin, Value);
  end;
end;


procedure TAbOpHourCounter.SetIndicate(Value: TOpHrIndicate);
begin
  if FIndicate <> Value then
  begin
    FIndicate := Value;
    Invalidate;
  end;
end;

procedure TAbOpHourCounter.IncSec(var h, m, s: Integer);
begin
  if s >= 59 then
  begin
    s := 0;
    if m >= 59 then
    begin
      m := 0;
      Inc(h);
    end
    else
      Inc(m);
  end
  else
    Inc(s);
end;

procedure TAbOpHourCounter.DecSec(var h, m, s: Integer);
begin
  if s <= 0 then
  begin
    s := 59;
    if m <= 0 then
    begin
      m := 59;
      Dec(h);
    end
    else
      Dec(m);
  end
  else
    Dec(s);
end;

procedure TAbOpHourCounter.CheckTime;
begin
  isZero := false;
  {check for 0 or negative time}
  if ((hr <= 0) and (mi <= 0) and (se <= 0)) or
    ((hr < 0) or (mi < 0) or (se < 0)) then
  begin
    isZero := true;
    if (opPresetOnZero in Options) then
      SetTime(FPresetValue.Hour, FPresetValue.Min, FPresetValue.Sec)
    else
    begin
      DelControl(self);
      hr := 0;
      mi := 0;
      se := 0;
    end;
    if Assigned(FOnZero) then FOnZero(self);
  end;
  {check for limit-time}
  if (hr >= FLimit.FHour) and (mi >= FLimit.FMin) and (se >= FLimit.fSec) then
  begin
    if not isLimit then
    begin
      if Assigned(FOnLimit) then FOnLimit(self);
      if (opResetOnLimit in Options) then
      begin
        hr := 0;
        mi := 0;
        se := 0;
        isZero := true;
      end;
      if (opStopOnLimit in Options) then DelControl(self);
    end;
    isLimit := true;
  end
  else
    isLimit := false;
end;

procedure TAbOpHourCounter.SetCountDown(Value: Boolean);
begin
  if FCountDown <> Value then
  begin
    FCountDown := Value;
    if FCount and not FCountDown then AddControl(self, SyncOneSec);  {Start timer events}
  end;
end;

procedure TAbOpHourCounter.SetCount(Value: Boolean);
begin
  if FCount <> Value then
  begin
    FCount := Value;
    if not (csDesigning in Componentstate) then
    begin
      if Count {and not CountDown and not isZero} then
      begin
        AddControl(self, SyncOneSec);         {Start timer events}
      end
      else
      begin
        DelControl(self);               {stop timer events}
      end;
    end;
  end;
end;


procedure TAbOpHourCounter.SetTime(Hour, Min, Sec: Integer);
var
  minPlus, hourPlus : Integer;
begin
  minPlus := 0;
  hourPlus := 0;

  if Sec > 59 then
  begin
    minPlus := Sec div 60;
    se := Sec - (minPlus * 60);
  end
  else
    se := Sec;

  if (Min + minPlus) > 59 then
  begin
    hourPlus := (Min + minPlus) div 60;
    mi := (Min + minPlus) - (hourPlus * 60);
  end
  else
    mi := Min + minPlus;

  hr := Hour + hourPlus;
  CheckTime;
  PaintTime(Canvas, sTime.cx, sTime.cy);
end;

constructor TAbOpHourCounter.Create(AOwner: TComponent);
begin
  BeginUpdate;
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  ComponentInit := true;

  FCount := false;
  FCountDown := false;

  Width := 113;
  Height := 24;

  FOptions := [];
  FIndicate := oiHourMinSec;
  FLimit := TTimeSetting.Create;
  FPresetValue := TTimeSetting.Create;

  FIniSettings := TIniSettings.Create;
  FIniSettings.FileName := 'AbksApp.ini';

  FSeparatorHour := 'h';
  FSeparatorMin := 'm';
  FSeparatorSec := 's';
  FSeparatorChar := ':';
  FHourDigits := 4;
  hr := 0;
  mi := 0;
  se := 0;

  FBevelOuter := TAbSBevel.Create;
  FBevelOuter.Spacing := 2;
  FBevelOuter.Width := 1;

  FBevelInner := TAbSBevel.Create;
  FBevelInner.Spacing := 0;
  FBevelInner.Width := 1;
  FBevelInner.Style := bsLowered;
  FBevelInner.Color := clBlack;

  Font.Color := clLime;
  Font.Name := 'System';
  Font.Size := 10;

  if (csDesigning in Componentstate) then Loaded;

end;

procedure TAbOpHourCounter.Loaded;
begin
  inherited Loaded;
  FIniSettings.OnHandleIniEvent := HandleIni;

  FBevelOuter.OnChange := ParamChange;

  FBevelInner.OnChange := ParamChange;

  EndUpdate;
end;

procedure TAbOpHourCounter.BeforeFirstPaint;
begin
  if FIniSettings.Section = '' then
    FIniSettings.Section := Name;       {component Name}

  if not (csDesigning in Componentstate) then
    FIniSettings.AutoHandle(true);      {load from ini-file}
  ComponentInit := false;
end;

destructor TAbOpHourCounter.Destroy;
begin
  DelControl(self);
  if not (csDesigning in Componentstate) then
    FIniSettings.AutoHandle(false);     {save to ini-file}

  FIniSettings.Free;
  FLimit.Free;
  FPresetValue.Free;
  FBevelInner.Free;
  FBevelOuter.Free;
  inherited Destroy;
end;

procedure TAbOpHourCounter.HandleIni(Ini: TIniFile; Read: Boolean);
begin
  { virtual procedure to override, do not call this procedure directly
  use Handle() or AutoHandle() !}

  with Ini do
  begin
    if Read then
    begin                               {read from ini}
      hr := ReadInteger(FIniSettings.Section, 'h', 0);
      mi := ReadInteger(FIniSettings.Section, 'm', 0);
      se := ReadInteger(FIniSettings.Section, 's', 0);
    end
    else
    begin                               {write to ini}
      WriteInteger(FIniSettings.Section, 'h', hr);
      WriteInteger(FIniSettings.Section, 'm', mi);
      WriteInteger(FIniSettings.Section, 's', se);
    end;
  end;
end;

procedure TAbOpHourCounter.SetSeparatorHour(Value: string);
begin
  if FSeparatorHour <> Value then
  begin
    FSeparatorHour := Value;
    Change;
  end;
end;

procedure TAbOpHourCounter.SetSeparatorMin(Value: string);
begin
  if FSeparatorMin <> Value then
  begin
    FSeparatorMin := Value;
    Change;
  end;
end;

procedure TAbOpHourCounter.SetSeparatorSec(Value: string);
begin
  if FSeparatorSec <> Value then
  begin
    FSeparatorSec := Value;
    Change;
  end;
end;

procedure TAbOpHourCounter.SetSeparatorChar(Value: string);
begin
  if FSeparatorChar <> Value then
  begin
    FSeparatorChar := Value;
    Change;
  end;
end;

procedure TAbOpHourCounter.SetHourDigits(Value: Integer);
begin
  if FHourDigits <> Value then
  begin
    FHourDigits := Value;
    Change;
  end;
end;


procedure TAbOpHourCounter.ParamChange(Sender: TObject);
begin
  Repaint;
end;

procedure TAbOpHourCounter.Paint;
var
  t, f              : string;
begin

  if ComponentInit then BeforeFirstPaint; {init. this component}

  if (not (csDesigning in Componentstate) and not Visible) then Exit;
  Canvas.Font := Font;
  f := '';

  if (Indicate = oiHour) then
    f := '%.' + IntToStr(FHourDigits) + 'd' + FSeparatorHour
  else
    if (Indicate = oiHourMin) then
      f := '%.' + IntToStr(FHourDigits) + 'd' + FSeparatorHour +
        FSeparatorChar + '%.2d' + FSeparatorMin
    else
      f := '%.' + IntToStr(FHourDigits) + 'd' + FSeparatorHour +
        FSeparatorChar + '%.2d' + FSeparatorMin +
        FSeparatorChar + '%.2d' + FSeparatorSec;

  t := Format(f, [0, 0, 0]);

  sTime.cx := Canvas.TextWidth(t);

  sTime.cy := Canvas.Textheight(t);

  min_h := sTime.cy + BevelOuter.TotalWidth * 2
    + BevelInner.TotalWidth * 2;
  min_w := sTime.cx + BevelOuter.TotalWidth * 2
    + BevelInner.TotalWidth * 2
    + sTime.cy div 3;

  if Align = alNone then
  begin
    if Width < min_w then
    begin
      Width := min_w;
    end;
    if Height < min_h then
    begin
      Height := min_h;
    end;
  end;

  rClock := ClientRect;
  FBevelOuter.PaintFilledBevel(Canvas, rClock);
  FBevelInner.PaintFilledBevel(Canvas, rClock);
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := FBevelInner.Color;
  PaintTime(Canvas, sTime.cx, sTime.cy);
end;

procedure TAbOpHourCounter.PaintTime(can: TCanvas; w, h: Smallint);
var
  TempBmp           : TBitmap;
  x, y              : Smallint;
  t, f              : string;
begin
  if (w < 1) or (h < 1) or
    (not (csDesigning in Componentstate)) and not Visible then Exit;
  TempBmp := TBitmap.Create;
  TempBmp.Width := w;
  TempBmp.Height := h;
  TempBmp.Canvas.Font := Font;

  if (Indicate = oiHour) then
    f := '%.' + IntToStr(FHourDigits) + 'd' + FSeparatorHour
  else
    if (Indicate = oiHourMin) then
      f := '%.' + IntToStr(FHourDigits) + 'd' + FSeparatorHour +
        FSeparatorChar + '%.2d' + FSeparatorMin
    else
      f := '%.' + IntToStr(FHourDigits) + 'd' + FSeparatorHour +
        FSeparatorChar + '%.2d' + FSeparatorMin +
        FSeparatorChar + '%.2d' + FSeparatorSec;

  t := Format(f, [hr, mi, se]);

  with TempBmp.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := FBevelInner.Color;
    textout(0, 0, t);
  end;

  x := rClock.Left + (((rClock.Right - rClock.Left) - w) div 2);
  y := rClock.Top + (((rClock.Bottom - rClock.Top) - h) div 2);
  can.Draw(x, y, TempBmp);
  TempBmp.Free;
end;

procedure TAbOpHourCounter.WMFlash(var Message: TMessage);
begin
  with Message do
  begin
    if (FCountDown and not isZero) then
      DecSec(hr, mi, se)
    else
      if not FCountDown then IncSec(hr, mi, se);
    CheckTime;
    if Visible then PaintTime(Canvas, sTime.cx, sTime.cy);
  end;
end;

end.