abclock.pas

来自「著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行」· PAS 代码 · 共 250 行

unit AbClock;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                            Component TAbClock                                }
{                                                                              }
{******************************************************************************}
{        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,
  {****** Abakus VCL - Units ******}
  _GClass,
  _AbInfo,
  _AbProc,
  AbFlashT;

type
  TClockOption = (coDate, coTime, coDateTime);

  TAbClock = class(TAbGraphicControl)
  private
    FBevelOuter: TAbSBevel;
    FBevelInner: TAbSBevel;
    FClockOption: TClockOption;
    FAutoHint: Boolean;
    rClock: TRect;
    min_h: Smallint;
    min_w: Smallint;
    sTime: TSize;
  protected
    procedure SetClockOption(Value: TClockOption);
    procedure PaintTime;
    procedure Paint; override;
    procedure ParamChange(Sender: TObject); override;
    procedure WMFlash(var Message: TMessage); message WM_FLASH;
  public
    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 Height default 24;
    property Width default 69;
    property ClockOption: TClockOption read FClockOption write SetClockOption
    default coTime;
    property BevelInner: TAbSBevel read FBevelInner write FBevelInner;
    property BevelOuter: TAbSBevel read FBevelOuter write FBevelOuter;
    property AutoHint: Boolean read FAutoHint write FAutoHint default true;
  end;

implementation


constructor TAbClock.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  BeginUpdate;
  Width := 69;
  Height := 24;

  FClockOption := coTime;

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

  FBevelOuter.OnChange := ParamChange;

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

  FBevelInner.OnChange := ParamChange;

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

  if (csDesigning in Componentstate) then Loaded;

end;

procedure TAbClock.Loaded;
begin
  inherited Loaded;
  EndUpdate;
  AddControl(self, SyncOneSec);
end;

destructor TAbClock.Destroy;
begin
  DelControl(self);
  FBevelInner.Free;
  FBevelOuter.Free;
  inherited Destroy;
end;

procedure TAbClock.SetClockOption(Value: TClockOption);
begin
  if FClockOption <> Value then
  begin
    FClockOption := Value;
    Change;
  end;
end;

procedure TAbClock.ParamChange(Sender: TObject);
begin
  inherited ParamChange(Sender);
  if (UpdateCount = 0) then Invalidate;
end;

procedure TAbClock.Paint;
var
  t                 : string;
begin
  Canvas.Font := Font;

  if FClockOption = coTime then
    t := TimeToStr(Now)
  else
    if FClockOption = coDate then
      t := DateToStr(Now)
    else
      if FClockOption = coDateTime then
        t := DateTimeToStr(Now);

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

  min_h := sTime.cy;
  min_w := sTime.cx + sTime.cy div 3;

   // BevelOuter
  min_h := min_h + BevelOuter.TotalWidth * 2
    + BevelOuter.Offset.Top + BevelOuter.Offset.Bottom;
  min_w := min_w + BevelOuter.TotalWidth * 2
    + BevelOuter.Offset.Left + BevelOuter.Offset.Right;
   // BevelInner
  min_h := min_h + BevelInner.TotalWidth * 2
    + BevelInner.Offset.Top + BevelOuter.Offset.Bottom;
  min_w := min_w + BevelInner.TotalWidth * 2
    + BevelInner.Offset.Left + BevelOuter.Offset.Right;

  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);

  rClock.Left := rClock.Left + (((rClock.Right - rClock.Left) - sTime.cx) div
    2);
  rClock.Right := rClock.Left + sTime.cx;

  rClock.Top := rClock.Top + (((rClock.Bottom - rClock.Top) - sTime.cy) div 2);
  rClock.Bottom := rClock.Top + sTime.cy;

  PaintTime;
end;

procedure TAbClock.PaintTime;
var
  TempBmp           : TBitmap;
  t                 : string;
begin

  TempBmp := TBitmap.Create;
  TempBmp.Width := rClock.Right - rClock.Left;
  TempBmp.Height := rClock.Bottom - rClock.Top;

  TempBmp.Canvas.Brush.Color := FBevelInner.Color;
  TempBmp.Canvas.Rectangle(-1, -1, Width + 1, Height + 1);


  TempBmp.Canvas.Font := Font;


  if FClockOption = coTime then
    t := TimeToStr(Now)
  else
    if FClockOption = coDate then
      t := DateToStr(Now)
    else
      if FClockOption = coDateTime then
        t := DateTimeToStr(Now);


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

  Canvas.Draw(rClock.Left, rClock.Top, TempBmp);

  TempBmp.Free;

  if AutoHint and not (csDesigning in Componentstate) then
    Hint := DateToStr(Now);
end;

procedure TAbClock.WMFlash(var Message: TMessage);
begin
  with Message do
  begin
    if Visible or (csDesigning in Componentstate) then PaintTime;
  end;
end;

end.