www.pudn.com > d4psp31.zip > cmpTimeDisplay.pas, change:1998-06-22,size:4746b


unit cmpTimeDisplay; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; 
 
type 
  TTimeDisplay = class(TCustomControl) 
  private 
    fTime : Integer; 
    fHours, fMins, fSecs, fCs : Integer; 
 
    fBevelInner : TPanelBevel; 
    fBevelOuter : TPanelBevel; 
    fBorderStyle : TBorderStyle; 
    fAlignment : TAlignment; 
 
    r : TRect; 
 
    procedure SetTime (value : Integer); 
    procedure SetBevelInner (value : TPanelBevel); 
    procedure SetBevelOuter (value : TPanelBevel); 
    procedure SetBorderStyle (value : TBorderStyle); 
    procedure SetAlignment (value : TAlignment); 
 
    procedure UpdateDisplay; 
 
    { Private declarations } 
  protected 
    procedure Paint; override; 
    procedure CreateWnd; override; 
 
  public 
    constructor Create (AOwner : TComponent); override; 
    { Public declarations } 
  published 
    property Time : Integer read fTime write SetTime; 
    property Hours : Integer read fHours; 
    property Mins : Integer read fMins; 
    property Secs : Integer read fSecs; 
    property CS : Integer read fCs; 
 
    property BevelInner : TPanelBevel read fBevelInner write SetBevelInner; 
    property BevelOuter : TPanelBevel read fBevelOuter write SetBevelOuter; 
    property BorderStyle : TBorderStyle read fBorderStyle write SetBorderStyle; 
    property Alignment : TAlignment read fAlignment write SetAlignment; 
 
    property Font; 
    property Color; 
    property Align; 
    property Ctl3D; 
 
    property ParentColor; 
    property ParentFont; 
    property TabOrder; 
  end; 
 
implementation 
 
constructor TTimeDisplay.Create (AOwner : TComponent); 
begin 
  inherited Create (AOwner); 
  Width := 100; 
  Height := 20; 
end; 
 
procedure TTimeDisplay.SetTime (value : Integer); 
begin 
  if value <> fTime then 
  begin 
    fTime := value; 
    fCs := fTime mod 1000 div 10; 
    fSecs := fTime div 1000; 
    fMins := fSecs div 60; 
    fSecs := fSecs mod 60; 
    fHours := fMins div 60; 
    fMins := fMins mod 60; 
    UpdateDisplay 
  end 
end; 
 
procedure TTimeDisplay.SetBevelInner (value : TPanelBevel); 
begin 
  if fBevelInner <> value then 
  begin 
    fBevelInner := value; 
    Refresh 
  end 
end; 
 
procedure TTimeDisplay.SetBevelOuter (value : TPanelBevel); 
begin 
  if fBevelOuter <> value then 
  begin 
    fBevelOuter := value; 
    Refresh 
  end 
end; 
 
procedure TTimeDisplay.SetBorderStyle (value : TBorderStyle); 
begin 
  if fBorderStyle <> value then 
  begin 
    fBorderStyle := value; 
    Refresh 
  end 
end; 
 
procedure TTimeDisplay.SetAlignment (value : TAlignment); 
begin 
  if value <> fAlignment then 
  begin 
    fAlignment := value; 
    Refresh 
  end 
end; 
 
procedure TTimeDisplay.UpdateDisplay; 
var 
  st : string; 
  x, w : Integer; 
begin 
  st := Format ('%02d:%02.2d:%02.2d.%02.2d', [fHours, fMins, fSecs, fCS]); 
  if Alignment = taLeftJustify then 
    x := r.left + 1 
  else 
  begin 
    w := Canvas.TextWidth (st); 
    if Alignment = taRightJustify then 
      x := r.right - w - 1 
    else 
      x := r.left + (r.right - r.left - w) div 2 
  end; 
  Canvas.FillRect (r); 
  Canvas.TextOut (x, 1, st); 
//  Canvas.TdextRect (r, x, 1, st); 
end; 
 
procedure TTimeDisplay.Paint; 
var 
  BevelWidth : Integer; 
 
  procedure DrawBevel (x, y, w, h : Integer; tp : TPanelBevel); 
  begin 
    case tp of 
      bvRaised : 
        with Canvas do 
        begin 
          Pen.Color := clBtnHighlight; 
          MoveTo (x, y + h); 
          LineTo (x, y); 
          LineTo (x + w + 1, y); 
 
          Pen.Color := clBtnShadow; 
          MoveTo (x + w, y + 1); 
          LineTo (x + w, y + h); 
          LineTo (x, y + h); 
        end; 
      bvLowered : 
        with Canvas do 
        begin 
          Pen.Color := clBtnShadow; 
          MoveTo (x, y + h); 
          LineTo (x, y); 
          LineTo (x + w + 1, y); 
 
          Pen.Color := clBtnHighlight; 
          MoveTo (x + w, y + 1); 
          LineTo (x + w, y + h); 
          LineTo (x, y + h); 
        end; 
    end; 
  end; 
 
begin 
  Canvas.Pen.Width := 1; 
  Canvas.Font := Font; 
  Canvas.Brush.Color := Color; 
  if BevelInner <> bvNone then 
    BevelWidth := 2 
  else 
    if BevelOuter <> bvNone then 
      BevelWidth := 1 
    else 
      BevelWidth := 0; 
 
  DrawBevel (0, 0, ClientWidth - 1, ClientHeight - 1, BevelOuter); 
  DrawBevel (1, 1, ClientWidth - 3, ClientHeight - 3, BevelInner); 
 
  with r do 
  begin 
    left := BevelWidth; 
    top := BevelWidth; 
    right := ClientWidth - bevelWidth * 2; 
    bottom := ClientHeight - bevelWidth * 2 
  end; 
 
  UpdateDisplay 
end; 
 
procedure TTimeDisplay.CreateWnd; 
begin 
  inherited; 
end; 
 
end.