Как сделать цифровые часы в delphi7?
Я довольно новичок в delphi, и хотел бы начать с чего-то легкого . Не мог бы кто-нибудь показать мне пример , как сделать цифровые часы , которые будут передавать "время" ( Час, Мин, сек ) на этикетку ? Или что-то в этом роде!--1-->
3 ответов
Упражнение 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
to 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;
семь-сегментный цифровой часы http://privat.rejbrand.se/seven-segment-clock.png
игра с кистями GDI:
семисегментные цифровые часы http://privat.rejbrand.se/seven-segment-clock-brush.png
скачать мой с открытым исходным кодом 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.
теперь опустите такую рамку на свою форму, et voilá:
procedure TForm1.FormCreate(Sender: TObject);
begin
DigitalClock1.Time := Time;
end;
вот мои часы:
- точность времени 100%.
- дата также добавлена.
- это легко сделать и не занимает менее 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;