Как сделать цифровые часы в 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;
