Имитировать на экране работу электронных часов

label1.caption:=TimeToStr(Time);

unit Unit1;
 
interface
 
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;
 
type
 TForm1 = class(TForm)
  Timer1: TTimer;
  Label1: TLabel; // время
  Label2: TLabel; // дата и день недели
  procedure Timer1Timer(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure FormPaint(Sender: TObject);
  procedure ShowTime;
 private
  { Private declarations }
 public
  { Public declarations }
 end;
 
var
 Form1: TForm1;
 
implementation
 
                                                           
const
  stDay : array[1..7] of string[11] =
    ('воскресенье','понедельник','вторник',
     'среда','четверг','пятница','суббота');
 
  stMonth : array[1..12] of string[8] =
    ('января','февраля','марта',
     'апреля','мая','июня','июля',
     'августа','сентября','октября',
     'ноября','декабря');
 
{$R *.dfm}
procedure TForm1.ShowTime;
var Time : TDateTime; // текущее время
begin
 Time := Now(); // получить системное время
 Label1.Caption := FormatDateTime('hh:mm:ss',Time);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ShowTime; // отобразить время
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
 Present: TDateTime;      // текущая дата и время
 Year, Month, Day : Word; // год, месяц и число, как
                 // отдельные числа
begin
 Present:= Now; // получить текущую дату
 DecodeDate(Present, Year, Month, Day);
 Label2.Caption := 'Сегодня '+IntToStr(Day)+ ' ' +
  stMonth[Month] + ' '+ IntToStr(Year)+
  ' года, '+ stDay[DayOfWeek(Present)];
 
 // настроить и запустить таймер
 Timer1.Interval := 1000; // период сигналов таймера 1 с
 Timer1.Enabled := True; // пуск таймера
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  ShowTime; // отобразить часы
end;
 
end.

Digits: Array[0..9] of String[7] = ('1111110','0110000','1101101' ....);

procedure DigitPaint(Digit: Byte);
Var
  i: Integer;
begin
 PaintBox1.Canvas.Pen.Color := clGray;
 PaintBox1.Canvas.Brush.Color := clMedGray;
 for i := 1 to 7
 do begin
    case i of
     1: PaintBox1.Canvas.Polygon([Point(D,D),Point(D*6,D),Point(D*5,D*2),Point(D*2,D*2)]);
     2: PaintBox1.Canvas.Polygon([Point(D*6+1,D+1),Point(D*6+1,D*6),Point(D*5+1,D*5),Point(D*5+1,D*2+1)]);
...

package slDigitSymbol;
 
{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMPLICITBUILD ON}
 
requires
  rtl,
  vcl,
  designide;
 
contains
  DigitSymbol in 'DigitSymbol.pas';
 
end.

unit DigitSymbol;
 
interface
 
uses
  SysUtils, Classes, Controls, Graphics;
 
type
  TMaskItem = (smTop,smTopRight,smBottomRight,smBottom,smBottomLeft,smTopLeft,smMiddle);
  TSymbolMask = set of TMaskItem;
  TSymbolTemplate = (tmZero,tmOne,tmTwo,tmThree,tmFour,tmFive,tmSix,tmSeven,tmEight,tmNine,tmUser);
 
const
  smZero: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smBottomLeft,smTopLeft];
  smOne: TSymbolMask = [smTopRight,smBottomRight];
  smTwo: TSymbolMask = [smTop,smTopRight,smBottomLeft,smBottom,smMiddle];
  smThree: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smMiddle];
  smFour: TSymbolMask = [smTopRight,smBottomRight,smTopLeft,smMiddle];
  smFive: TSymbolMask = [smTop,smBottomRight,smBottom,smTopLeft,smMiddle];
  smSix: TSymbolMask = [smTop,smBottomRight,smBottom,smTopLeft,smBottomLeft,smMiddle];
  smSeven: TSymbolMask = [smTop,smTopRight,smBottomRight];
  smEight: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smBottomLeft,smTopLeft,smMiddle];
  smNine: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smTopLeft,smMiddle];
 
type
  TDigitSymbol = class(TGraphicControl)
   private
    fTemplate: TSymbolTemplate;
    fMask: TSymbolMask;
    fFillColor: TColor;
    fBorderColor: TColor;
    fBorderWidth: Integer;
    procedure SetSymbolMask(const Value: TSymbolMask);
    procedure SetSymbolTemplate(const Value: TSymbolTemplate);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetColor(Index: Integer; const Value: TColor);
   public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
   published
    property Mask: TSymbolMask read fMask write SetSymbolMask;
    property Template: TSymbolTemplate read fTemplate write SetSymbolTemplate;
    property BorderWidth: Integer read fBorderWidth write SetBorderWidth;
    property FillColor: TColor index 0 read fFillColor write SetColor;
    property BorderColor: TColor index 1 read fBorderColor write SetColor;
  end;
 
procedure Register;
 
implementation
 Uses DesignIntf;
 
procedure Register;
begin
 RegisterComponents('Sufferer Components', [TDigitSymbol]);
 RegisterPropertyEditor(TypeInfo(TCursor),TDigitSymbol,'Cursor',nil);
 RegisterPropertyEditor(TypeInfo(THelpType),TDigitSymbol,'HelpType',nil);
 RegisterPropertyEditor(TypeInfo(TCustomHint),TDigitSymbol,'CustomHint',nil);
 RegisterPropertyEditor(TypeInfo(Boolean),TDigitSymbol,'ParentCustomHint',nil);
 RegisterPropertyEditor(TypeInfo(THelpContext),TDigitSymbol,'HelpContext',nil);
 RegisterPropertyEditor(TypeInfo(String),TDigitSymbol,'HelpKeyword',nil);
 RegisterPropertyEditor(TypeInfo(Integer),TDigitSymbol,'Tag',nil);
end;
 
constructor TDigitSymbol.Create(AOwner: TComponent);
begin
 inherited;
 fMask := smEight;
 fFillColor := clLime;
 fBorderColor := clMoneyGreen;
 fBorderWidth := 1;
 Width := 40;
 Height := 70;
end;
 
procedure TDigitSymbol.Paint;
Var
  Dx,Dy: Integer;
  Brick: TMaskItem;
begin
 inherited;
 Dx := Width div 8;
 Dy := Height div 14;
 Canvas.Pen.Color := fBorderColor;
 Canvas.Pen.Width := fBorderWidth;
 Canvas.Brush.Color := fFillColor;
 for Brick := Low(TMaskItem) to High(TMaskItem)
 do if Brick in Mask then
    case Brick
    of smTop: Canvas.Polygon([Point(Dx*2,0),Point(Dx*6,0),Point(Dx*7,Dy),Point(Dx*6,Dy*2),Point(Dx*2,Dy*2),Point(Dx,Dy)]);
       smTopRight: Canvas.Polygon([Point(Dx*6,Dy*2),Point(Dx*7,Dy),Point(Dx*8,Dy*2),Point(Dx*8,Dy*6),Point(Dx*7,Dy*7),Point(Dx*6,Dy*6)]);
       smBottomRight: Canvas.Polygon([Point(Dx*6,Dy*8),Point(Dx*7,Dy*7),Point(Dx*8,Dy*8),Point(Dx*8,Dy*12),Point(Dx*7,Dy*13),Point(Dx*6,Dy*12)]);
       smBottom: Canvas.Polygon([Point(Dx*2,Dy*12),Point(Dx*6,Dy*12),Point(Dx*7,Dy*13),Point(Dx*6,Dy*14),Point(Dx*2,Dy*14),Point(Dx,Dy*13)]);
       smBottomLeft: Canvas.Polygon([Point(0,Dy*8),Point(Dx,Dy*7),Point(Dx*2,Dy*8),Point(Dx*2,Dy*12),Point(Dx,Dy*13),Point(0,Dy*12)]);
       smTopLeft: Canvas.Polygon([Point(0,Dy*2),Point(Dx,Dy),Point(Dx*2,Dy*2),Point(Dx*2,Dy*6),Point(Dx,Dy*7),Point(0,Dy*6)]);
       smMiddle: Canvas.Polygon([Point(Dx*2,Dy*6),Point(Dx*6,Dy*6),Point(Dx*7,Dy*7),Point(Dx*6,Dy*8),Point(Dx*2,Dy*8),Point(Dx,Dy*7)]);
       end;
end;
 
procedure TDigitSymbol.SetBorderWidth(const Value: Integer);
begin
 if fBorderWidth <> Value
 then begin
      fBorderWidth := Value;
      Invalidate;
      end;
end;
 
procedure TDigitSymbol.SetColor(Index: Integer; const Value: TColor);
begin
 case Index
 of 0: if fFillColor <> Value then fFillColor := Value;
    1: if fBorderColor <> Value then fBorderColor := Value;
    else Exit;
 end;
 Invalidate;
end;
 
procedure TDigitSymbol.SetSymbolMask(const Value: TSymbolMask);
begin
 if fMask <> Value
 then begin
      fMask := Value;
      fTemplate := tmUser;
      if Value = smZero then Template := tmZero;
      if Value = smOne then Template := tmOne;
      if Value = smTwo then Template := tmTwo;
      if Value = smThree then Template := tmThree;
      if Value = smFour then Template := tmFour;
      if Value = smFive then Template := tmFive;
      if Value = smSix then Template := tmSix;
      if Value = smSeven then Template := tmSeven;
      if Value = smEight then Template := tmEight;
      if Value = smNine then Template := tmNine;
      Invalidate;
      end;
end;
 
procedure TDigitSymbol.SetSymbolTemplate(const Value: TSymbolTemplate);
begin
 if Value <> fTemplate
 then begin
      fTemplate := Value;
      case Value
      of tmZero: fMask := smZero;
         tmOne: fMask := smOne;
         tmTwo: fMask := smTwo;
         tmThree: fMask := smThree;
         tmFour: fMask := smFour;
         tmFive: fMask := smFive;
         tmSix: fMask := smSix;
         tmSeven: fMask := smSeven;
         tmEight: fMask := smEight;
         tmNine: fMask := smNine;
         else fTemplate := tmUser;
         end;
      Invalidate;
      end;
end;
 
end.