bu ingilizceydi ben biraz türkçeleştirdim
d7 de kurdum denedim gayet de güzel çalışıyor
sadece labeli koyuyorsun tarih ve saati kendi sayıyor
kodu popyalayıp Clklbl.pas olarak kaydedin ve component olarak ekleyin
Kod: Tümünü seç
unit Clklbl;
interface
uses Classes, Controls, ExtCtrls, Forms, Graphics, Messages,
Stdctrls, SysUtils, WinProcs, WinTypes;
type
TClockLabel = class(TCustomLabel)
private
{ Private fields of TClockLabel }
FDateFmtUK : Boolean;
FDateStr : String;
FShowDate : Boolean;
FShowTime : Boolean;
FTimeFmt24hr : Boolean;
FTimeSep : String;
FTimeStr : String;
{ Internal timer for updating time display }
Timer : TTimer;
{ Private methods of TClockLabel }
{ Method to set variable and property values and create objects }
procedure AutoInitialize;
{ Method to free any objects created by AutoInitialize }
procedure AutoDestroy;
procedure SetDateFmtUK(Value : Boolean);
function GetDateStr : String;
procedure SetShowDate(Value : Boolean);
procedure SetShowTime(Value : Boolean);
procedure SetTimeFmt24hr(Value : Boolean);
procedure SetTimeSep(Value : String);
function GetTimeStr : String;
{ Returns updated time and date string }
function NewCaption : String;
{ Forces update to label; triggered by Timer's OnTimer events }
procedure Update(Sender : TObject);
protected
{ Protected fields of TClockLabel }
{ Protected methods of TClockLabel }
procedure Paint; override;
public
{ Public fields and properties of TClockLabel }
{ Current date }
property DateStr : String read GetDateStr;
{ Current time }
property TimeStr : String read GetTimeStr;
{ Public methods of TClockLabel }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published properties of TClockLabel }
{ Use U.K. format for date (dd mm, yy)? }
property DateFmtUK : Boolean
read FDateFmtUK write SetDateFmtUK
default True;
{ Publish Font property of parent class }
property Font;
{ Include date in display? }
property ShowDate : Boolean
read FShowDate write SetShowDate
default True;
{ Include time in display? }
property ShowTime : Boolean
read FShowTime write SetShowTime
default True;
{ Display 24-hour time or 12-hour? }
property TimeFmt24hr : Boolean
read FTimeFmt24hr write SetTimeFmt24hr
default False;
{ Field separator for time string }
property TimeSep : String read FTimeSep write SetTimeSep;
{ Publish Visible property of parent class }
property Visible default True;
end;
procedure Register;
implementation
procedure Register;
begin
{ Register TClockLabel with Utilities as its
default page on the Delphi component palette }
RegisterComponents('Standart', [TClockLabel]);
end;
{ Method to set variable and property values and create objects }
procedure TClockLabel.AutoInitialize;
begin
Timer := TTimer.Create(Self);
with Timer do
begin
{ Trigger OnTimer events every 30 seconds }
Interval := 1000;
{ OnTimer events will generate call to Update procedure }
OnTimer := Update;
end;
FDateFmtUK := True;
FShowDate := True;
FShowTime := True;
FTimeFmt24hr := False;
FTimeSep := ':';
Visible := True;
end; { of AutoInitialize }
{ Method to free any objects created by AutoInitialize }
procedure TClockLabel.AutoDestroy;
begin
Timer.Free;
end; { of AutoDestroy }
procedure TClockLabel.SetDateFmtUK(Value : Boolean);
begin
FDateFmtUK := Value;
{ Changing this property affects the appearance of
the component, so ... }
Invalidate;
end;
function TClockLabel.GetDateStr : String;
const
Months : array[1..12] of String[10] =
('OCAK','ŞUBAT','MART','NİSAN','MAYIS','HAZİRAN',
'TEMMUZ','AĞUSTOS','EYLÜL','EKİM','KASIM','ARALIK');
var
Year, Month, Day, Weekday : Word;
DayStr, YearStr : String[10];
begin
(* Obtain the date information *)
DecodeDate(Now, Year, Month, Day);
Str(Day, DayStr);
Str(Year, YearStr);
if FDateFmtUK then
FDateStr := DayStr+ ' ' + Months[Month] + ', ' + YearStr
else
FDateStr := Months[Month] + ' ' + DayStr + ' ' + YearStr;
GetDateStr := FDateStr
end;
procedure TClockLabel.SetShowDate(Value : Boolean);
begin
FShowDate := Value;
{ Changing this value changes the display, so ... }
Invalidate;
end;
procedure TClockLabel.SetShowTime(Value : Boolean);
begin
FShowTime := Value;
{ Changing this value changes the display, so ... }
Invalidate;
end;
procedure TClockLabel.SetTimeFmt24hr(Value : Boolean);
begin
FTimeFmt24hr := Value;
Invalidate
end;
procedure TClockLabel.SetTimeSep(Value : String);
begin
FTimeSep := Value;
{ Changing this value changes the display, so ... }
Invalidate;
end;
function TClockLabel.GetTimeStr : String;
var
Hour, Minute, Seconds, Hundreds : Word;
Secondsstr, HourStr, MinuteStr, AmPm : String[10];
begin
(* Obtain the time information *)
DecodeTime(Now, Hour, Minute, Seconds, Hundreds);
(* Take account of 12-hour time, if necessary *)
if FTimeFmt24hr then
AmPm := ''
else
if Hour > 12 then
begin
Hour := Hour - 12;
AmPm := ' pm'
end
else
AmPm := ' am';
(* Convert the time values to strings *)
Str(Hour, HourStr);
Str(Minute, MinuteStr);
str(Seconds,Secondsstr);
(* Add leading zero if Minute is one digit *)
if Minute < 10 then
MinuteStr := '0' + MinuteStr;
{ Add leading zero if Hour is one digit }
if Hour < 10 then
HourStr := '0' + HourStr;
FTimeStr := HourStr + FTimeSep + MinuteStr +':'+ Secondsstr +AmPm;
GetTimeStr := FTimeStr
end;
constructor TClockLabel.Create(AOwner: TComponent);
begin
{ Call the Create method of the parent class }
inherited Create(AOwner);
{ Set the initial values of variables and properties and }
{ create object for Timer variable. }
{ AutoInitialize procedure is generated by Component Create. }
AutoInitialize;
{ Start timer }
Timer.Enabled := True
end;
destructor TClockLabel.Destroy;
begin
{ AutoDestroy, which is generated by Component Create, frees any }
{ objects created by AutoInitialize. }
AutoDestroy;
{ Free the component by calling the Destroy method of the }
{ parent class. }
inherited Destroy;
end;
{ Returns updated time and date string }
function TClockLabel.NewCaption : String;
var
DisplayLine : String;
begin
if FShowDate then
DisplayLine := GetDateStr
else
DisplayLine := '';
if FShowDate and FShowTime then
DisplayLine := DisplayLine + ' ';
if FShowTime then
DisplayLine := DisplayLine + GetTimeStr;
NewCaption := DisplayLine
end;
procedure TClockLabel.Paint;
begin
{ Update the caption of the label with the current date
and time string, then call the Paint method of the
parent class to re-draw }
Caption := NewCaption;
inherited Paint;
end;
{ Forces update to label; triggered by Timer's OnTimer events }
procedure TClockLabel.Update(Sender : TObject);
{ The component calls Update method periodically to keep
the time display current. Update has been declared with
one argument of type TObject so it can be assigned as the
OnTimer event handler for variable Timer. }
begin
{ Has the time and date display changed? If so, re-draw }
if NewCaption <> Caption then
Invalidate
end;
end.