Как сделать цифровые часы в delphi7? - PullRequest
9 голосов
/ 28 февраля 2012

Я довольно новичок в Delphi и хотел бы начать с чего-то более легкого. Может кто-нибудь показать мне пример того, как сделать цифровые часы, которые будут переводить «время» (часы, минуты, секунды) на метку? Или что-то в этом роде

Ответы [ 3 ]

42 голосов
/ 28 февраля 2012

Упражнение 1

Удалите TLabel и TButton в вашей форме.

Дважды нажмите кнопку и напишите

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := TimeToStr(Time);
end;

Упражнение 2

Чтобы получить время для автоматического обновления, добавьте TTimer в свою форму и дважды щелкните по нему (вы можете удалить кнопку, если хотите),Затем напишите

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := TimeToStr(Time);
end;

Этот код будет запускаться раз в секунду (интервал по умолчанию для TTimer, который идеально подходит для нас, поэтому нам не нужно его менять).

Упражнение 3

Чтобы сделать часы более раздражающими, вы можете попробовать это: в интерфейсе вашей формы добавьте приватное поле с именем FHighlight, например:

TForm1 = class(TForm)
  Button1: TButton;
  Label1: TLabel;
  Timer1: TTimer;
  procedure Button1Click(Sender: TObject);
  procedure Timer1Timer(Sender: TObject);
private
  { Private declarations }
  FHighlight: boolean;
public
  { Public declarations }
end;

Теперь вы можете сделать

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := TimeToStr(Time);
  if FHighlight then
  begin
    Label1.Color := clWhite;
    Label1.Font.Color := clBlack;
  end
  else
  begin
    Label1.Color := clBlack;
    Label1.Font.Color := clWhite;
  end;
  FHighlight := not FHighlight;
end;

Чтобы этот эффект работал, вам нужно изменить одно из свойств элемента управления TLabel (время разработки).Измените Transparent на false, используя инспектор объектов, если это еще не сделано.

Обновление (упражнение 4)

Поскольку Уоррен П считает, что этоСлишком скучно с простой TLabel, вот как можно получить «настоящие» семисегментные цифровые часы:

procedure TForm1.FormPaint(Sender: TObject);
type
  TDigitData = array[0..6] of boolean;
  TPhysDigit = array[0..7] of TRect;
const
  DIGIT: array[0..9] of TDigitData =
    (
      (true, true, true, true, true, true, false),
      (false, true, true, false, false, false, false),
      (true, true, false, true, true, false, true),
      (true, true, true, true, false, false, true),
      (false, true, true, false, false, true, true),
      (true, false, true, true, false, true, true),
      (true, false, true, true, true, true, true),
      (true, true, true, false, false, false, false),
      (true, true, true, true, true, true, true),
      (true, true, true, true, false, true, true)
    );
var
  PaddingW,
  PaddingH,
  UnitX,
  UnitY,
  DigitWidth,
  DigitHeight,
  BarLengthX,
  BarLengthY,
  DigitSeparation,
  FieldSeparation: integer;
  SEGMENTS: array[0..5] of TPhysDigit;
  i: Integer;

  function TranslatePhysDigit(const PhysDigit: TPhysDigit; const DX: integer; const DY: integer = 0): TPhysDigit;
  var
    i: Integer;
  begin
    for i := 0 to 7 do
    begin
      result[i].Left := PhysDigit[i].Left + DX;
      result[i].Right := PhysDigit[i].Right + DX;
      result[i].Top := PhysDigit[i].Top + DY;
      result[i].Bottom := PhysDigit[i].Bottom + DY;
    end;
  end;

  procedure DrawDigit(const Position, Value: integer);
  var
    i: integer;
  begin
    for i := 0 to 6 do
      if DIGIT[Value, i] then
        Canvas.FillRect(SEGMENTS[Position, i]);
  end;

  procedure DrawColon(const Position: integer);
  var
    ColonRect1: TRect;
    ColonRect2: TRect;
  begin
    ColonRect1 := Rect(PaddingW + Position*UnitX, PaddingH + UnitY,
      PaddingW + (Position+1)*UnitX, PaddingH + 2*UnitY);
    ColonRect2 := Rect(PaddingW + Position*UnitX, PaddingH + 3*UnitY,
      PaddingW + (Position+1)*UnitX, PaddingH + 4*UnitY);
    Canvas.FillRect(ColonRect1);
    Canvas.FillRect(ColonRect2);
  end;

var
  t: string;

begin
  PaddingW := Width div 20;
  PaddingH := Height div 20;
  UnitX := (ClientWidth - 2*PaddingW) div 27;
  UnitY := (ClientHeight - 2*PaddingH) div 5;
  DigitWidth := 3*UnitX;
  DigitHeight := 5*UnitY;
  BarLengthX := 3*UnitX;
  BarLengthY := 3*UnitY;
  DigitSeparation := 4*UnitX;
  FieldSeparation := 6*UnitX;
  SEGMENTS[0, 0] := Rect(0, 0, DigitWidth, UnitY);
  SEGMENTS[0, 1] := Rect(DigitWidth - UnitX, 0, DigitWidth, BarLengthY);
  SEGMENTS[0, 2] := Rect(DigitWidth - UnitX, 2*UnitY, DigitWidth, DigitHeight);
  SEGMENTS[0, 3] := Rect(0, DigitHeight - UnitY, DigitWidth, DigitHeight);
  SEGMENTS[0, 4] := Rect(0, 2*UnitY, UnitX, DigitHeight);
  SEGMENTS[0, 5] := Rect(0, 0, UnitX, BarLengthY);
  SEGMENTS[0, 6] := Rect(0, 2*UnitY, DigitWidth, 3*UnitY);
  SEGMENTS[0] := TranslatePhysDigit(SEGMENTS[0], PaddingW, PaddingH);
  SEGMENTS[1] := TranslatePhysDigit(SEGMENTS[0], DigitSeparation);
  SEGMENTS[2] := TranslatePhysDigit(SEGMENTS[1], FieldSeparation);
  SEGMENTS[3] := TranslatePhysDigit(SEGMENTS[2], DigitSeparation);
  SEGMENTS[4] := TranslatePhysDigit(SEGMENTS[3], FieldSeparation);
  SEGMENTS[5] := TranslatePhysDigit(SEGMENTS[4], DigitSeparation);
  Canvas.Brush.Color := clBlack;
  Canvas.FillRect(ClientRect);
  Canvas.Brush.Color := clBlack;
  Canvas.FillRect(Rect(PaddingW, PaddingH, ClientWidth - PaddingW,
    ClientHeight - PaddingH));
  Canvas.Brush.Color := clRed;
  t := FormatDateTime('hhnnss', Time);

  for i := 0 to 5 do
    DrawDigit(i, StrToInt(Copy(t, i+1, 1)));

  if odd(StrToInt(Copy(t, 6, 1))) then
  begin
    DrawColon(8);
    DrawColon(18);
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Invalidate;
end;

Игра с кистями GDI:

15 голосов
/ 29 февраля 2012

Загрузите мой открытый исходный код NLDDigiLabel компонент из здесь , поместите три из них в форму, поместите две общие метки между ними в качестве разделителей времени и установите цвет фона формы,В этом примере я сделал все это для фрейма для удобства:

unit Unit2;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
  NLDDigiLabel;

type
  TDigitalClock = class(TFrame)
    HoursLabel: TNLDDigiLabel;
    MinsLabel: TNLDDigiLabel;
    SecsLabel: TNLDDigiLabel;
    TimeSeparator1: TLabel;
    TimeSeparator2: TLabel;
    Timer: TTimer;
    procedure TimerTimer(Sender: TObject);
  private
    FTime: TTime;
    procedure SetTime(Value: TTime);
  public
    property Time: TTime read FTime write SetTime;
  end;

implementation

{$R *.dfm}

{ TDigitalClock }

procedure TDigitalClock.SetTime(Value: TTime);
var
  Hours: Word;
  Mins: Word;
  Secs: Word;
  MSecs: Word;
begin
  if FTime <> Value then
  begin
    FTime := Value;
    DecodeTime(FTime, Hours, Mins, Secs, MSecs);
    HoursLabel.Value := Hours;
    MinsLabel.Value := Mins;
    SecsLabel.Value := Secs;
  end;
end;

procedure TDigitalClock.TimerTimer(Sender: TObject);
begin
  SetTime(FTime + 1/SecsPerDay);
end;

end.

Теперь, добавьте такой фрейм в форму, и так далее:

procedure TForm1.FormCreate(Sender: TObject);
begin
  DigitalClock1.Time := Time;
end;

DigitalClock.png

0 голосов
/ 16 мая 2013

Вот особенности моих часов:

  1. Точность времени 100%.
  2. Дата также добавлена.
  3. Это легко сделать и не братьменее 2 минут;просто создайте таймер и 2 метки, и напишите это при реализации:

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Background,Clock's Settings
  form1.Caption:='Digital Clock';
  form1.Height:=260;
  form1.Width:=750;
  form1.BorderStyle:=bsToolWindow;
  form1.Color:=clbackground;

  //Label (Time,Date) Settings
  label1.Font.Size:=72;
  label1.Font.Color:=clred;
  label1.Caption:='Time';
  label1.Top:=0;
  label1.Left:=8;

  label2.Font.Size:=72;
  label2.Font.Color:=clblue;
  label2.Caption:='Date';
  label2.Top:=104;
  label2.Left:=8;
end;

//Create Clock,Calendar
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  label1.Caption:='Time: '+timetostr(time);
  label2.Caption:='Date: '+datetostr(date);

  timer1.Interval:=1; //100% Accuracy
end;

enter image description here

...