
21.12.2006, 11:12
|
 |
Местный
|
|
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
|
|
Код:
unit TimeLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,ExtCtrls;
type
TTimerType = ( tTime,tDate,tDateTime,tUserDefine);
TTimeLabel = class(TLabel)
private
{ Private declarations }
MyNotify :TNotifyEvent
MyTimer : TTimer;
FLableType : TTimerType;
FLableFormatType : String;
PlaceOnTitleBar : Boolean;
procedure SetLableType( value : TTimerType);
procedure SetLableFormat( Value : string);
procedure SetPlaceOnTitleBar( Value : Boolean);
protected
{ Protected declarations }
constructor Create(Owner : TComponent) ; override;
destructor Destroy; Override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
Procedure UpdateLable( Sender : TObject);
public
{ Public declarations }
published
{ Published declarations }
property LabelType : TTimerType read FLableType write SetLableType ;
property LableFormat : String read FLableFormatType write SetLableFormat;
property CaptionBar : Boolean read PlaceOnTitleBar Write SetPlaceOnTitleBar default False;
Property OnUpdate : TNotifyEvent read MyNotify write MyNotify; // Declaration Of Event
end;
procedure Register;
implementation
constructor TTimeLabel.Create(Owner : TComponent);
begin
inherited create(owner);
If csDesigning in ComponentState Then
LabelType := tDateTime;
UpdateLable(owner);
MyTimer := TTimer.Create(Self);
MyTimer.OnTimer := UpdateLable;
MyTimer.Enabled := True;
end;
destructor TTimeLabel.Destroy;
Begin
MyTimer.Destroy ;
Inherited Destroy;
End;
procedure TTimeLabel.SetLableType(value : TTimerType);
begin
if FLableType <> Value then
FLableType := Value;
UpdateLable(owner);
end;
procedure TTimeLabel.UpdateLable(Sender : TObject);
begin
case FLableType of
tTime:begin
if PlaceOnTitleBar = False then
begin
caption := TimeToStr(Time);
Self.Visible := True;
end
else
begin
SetWindowText(self.Parent.Handle,PChar(TimeToStr(Time)));
Self.Visible := False ;
end;
End;
tDate:Begin
if PlaceOnTitleBar = False then
begin
caption := DateToStr(Date);
Self.Visible := True;
end
else
Begin
SetWindowText(self.Parent.Handle,PChar(DateToStr(Date)));
Self.Visible := False;
end;
End;
tDateTime:Begin
if PlaceOnTitleBar = False then
begin
caption := DateTimeToStr(Now);
Self.Visible := True;
end
else
Begin
SetWindowText(self.Parent.Handle,PChar(DateTimeToStr(Now)));
Self.Visible := False;
end;
End;
tUserDefine:Begin
if PlaceOnTitleBar = False then
begin
caption := FormatDateTime(FLableFormatType, Now);
Self.Visible := True;
end
else
begin
SetWindowText(self.Parent.Handle,PChar(FormatDateTime(FLableFormatType, Now)));
Self.Visible := False;
end;
end;
if Assigned(MyNotify) then
MyNotify(self);
end;
end;
procedure TTimeLabel.SetLableFormat( value : String);
begin
if FLableFormatType <> value then
FLableFormatType := value;
end;
procedure TTimeLabel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbRight) and (ssAlt in Shift ) then MessageDlg(' Component TimeLabe Designed By Kiran N.',mtInformation,[mbOk],0);
inherited MouseDown(Button,Shift,X,Y);
end;
procedure TTimeLabel.SetPlaceOnTitleBar(Value : Boolean);
begin
if PlaceOnTitleBar <> Value then
PlaceOnTitleBar := Value;
if PlaceOnTitleBar = False then
end;
procedure Register;
begin
RegisterComponents('Kiran', [TTimeLabel]); // Registering the Component on to the VCL
end;
end.
Для использования, создай файл текстовый, перекинь вышенаписанное в него, назови файл TimeLabel.pas и добавляй его в uses своей проги...
Еще одна реализация:
Код:
unit TimeLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, extctrls;
type
TTimeLabel = class(TLabel)
private
FTimer: TTimer;
procedure TimerTimer(Sender: TObject);
protected
public
property Timer: TTimer read FTimer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('XYZ', [TTimeLabel]);
end;
{ TTimeLabel }
constructor TTimeLabel.Create(AOwner: TComponent);
begin
inherited;
FTimer := TTimer.Create(Self);
FTimer.OnTimer := TimerTimer;
FTimer.Enabled := False;
end;
destructor TTimeLabel.Destroy;
begin
FTimer.Free;
inherited;
end;
procedure TTimeLabel.TimerTimer(Sender: TObject);
begin
Caption := FormatDateTime('YYYY/MM/DD hh:nn:ss', Now);
end;
end.
И пример использования:
Код:
uses TimeLabel;
procedure TForm1.Button1Click(Sender: TObject);
var myTimeLabel: TTimeLabel;
begin
myTimeLabel := TTimeLabel.Create(Self);
myTimeLabel.Parent := Self;
myTimeLabel.Left := 0;
myTimeLabel.Top := 0;
myTimeLabel.Timer.Interval := 1000;
myTimeLabel.Timer.Enabled := True;
end;
__________________
THE CRACKER IS OUT THERE
|