Recull Components Delphi

SecurityCopy

Permet automatitzar còpies de seguretat de fitxers.

unit SecurityCopy;

interface

uses Windows, Classes, SysUtils, Forms, IniFiles, FileCtrl,
DsgnIntf, ShellAPI, ExtCtrls, Consts, TtLogFile, TtDBFilePathEd;

type
  TDebugOptions = class(TPersistent)
    private
      FActive: boolean;
      FFileName: string;
      FSaveDate: boolean;
      FSaveHour: boolean;
    public
      constructor Create;
    published
      property Active: boolean read FActive write FActive;
      property FileName: string read FFileName write FFileName;
      property SaveDate: boolean read FSaveDate write FSaveDate;
      property SaveHour: boolean read FSaveHour write FSaveHour;
  end;

type
  TSecurityCopy = class(TComponent)
    private
      FTimer: TTimer;
      FActive: boolean;
      FOverwrite: boolean;
      FOnlyModified: boolean;
      FSourcePath: string;
      FTargetPath: string;
      FExtension: string;
      FInterval: integer; //in seconds
      FLogFile: TTtLogFile;
      FDebugOptions: TDebugOptions;
      FIncludeSubfolders: boolean;
      procedure SetActive(AActive: boolean);
      procedure SetInterval(AInterval: integer);
      procedure SetDebugOptions(ADebugOptions: TDebugOptions);
      procedure OnTimer(Sender: TObject); virtual;
      procedure DoSecurityCopy(Source: string; Target: string);
    public
      constructor Create(AOwner:TComponent); override;
      destructor Destroy; override;
      procedure Loaded; override;
      procedure ExecuteSecurityCopy;
    published
      property Active: boolean read FActive write SetActive;
      property Overwrite: boolean read FOverwrite write FOverwrite;
      property OnlyModified: boolean read FOnlyModified write FOnlyModified;
      property Interval: integer read FInterval write SetInterval;
      property SourcePath: string read FSourcePath write FSourcePath;
      property TargetPath: string read FTargetPath write FTargetPath;
      property Extension: string read FExtension write FExtension;
      property DebugOptions: TDebugOptions read FDebugOptions write SetDebugOptions;
      property IncludeSubfolders: boolean read FIncludeSubfolders write FIncludeSubfolders;
  end;
type
  TSecurityCopy = class(TSecurityCopy);

procedure Register;

implementation

constructor TDebugOptions.Create;
begin
  FActive := False;
  FSaveDate := False;
  FSaveHour := False;
  FFileName := 'noname.log';
end;

constructor TSecurityCopy.Create(AOwner:TComponent);
begin
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FInterval := 60000;
  FActive := False;
  FOverwrite := True;
  FExtension := '*.*';
  FOnlyModified := True;
  FIncludeSubfolders := False;
  FTimer.OnTimer := OnTimer;
  FDebugOptions := TDebugOptions.Create;
  FLogFile := TTtLogFile.Create(Self);
  inherited Create(AOwner);
end;

procedure TSecurityCopy.Loaded;
begin
  SetDebugOptions(FDebugOptions);
  inherited Loaded;
end;

procedure TSecurityCopy.SetActive(AActive: boolean);
begin
  FActive := AActive;
  FTimer.Enabled := AActive;
  FTimer.Interval := FInterval;
end;

procedure TSecurityCopy.SetInterval(AInterval: integer);
begin
  FInterval := AInterval;
  FTimer.Interval := AInterval;
end;

procedure TSecurityCopy.SetDebugOptions(ADebugOptions: TDebugOptions);
begin
  FDebugOptions.Active := ADebugOptions.Active;
  FDebugOptions.SaveDate := ADebugOptions.SaveDate;
  FDebugOptions.SaveHour := ADebugOptions.SaveHour;
  FDebugOptions.FileName := ADebugOptions.FileName;
  FLogFile.SaveDate := FDebugOptions.SaveDate;
  FLogFile.SaveHour := FDebugOptions.SaveHour;
  FLogFile.FileName := FDebugOptions.FileName;
  FLogFile.Active := FDebugOptions.Active;
end;

function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
var
  SysTime: TSystemTime;
begin
  if not FileTimeToSystemTime(FileTime,SysTime) then
    raise EConvertError.CreateFmt('FileTime to SystemTime failed. Error code %d',[GetLastError]);
  with SysTime do
  begin
    Result := EncodeDate(wYear,wMonth,wDay) + EncodeTime(wHour,wMinute,wSecond,wMilliseconds);
  end;
end;

procedure TSecurityCopy.DoSecurityCopy(Source: string; Target: string);
var
  SearchRec,SRDest: TSearchRec;
  flDate,lastCopyDate: TDateTime;
begin
  //if target directory no exists creates it
  if not DirectoryExists(Target) then
    ForceDirectories(Target);

  if (FindFirst(Source+'\'+FExtension,faAnyFile,SearchRec)=0) then
  begin
    flDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
    try
      if (FindFirst(Target+'\'+SearchRec.Name,faArchive,SRDest)=0) then
      begin
        lastCopyDate := FileTimeToDateTime(SRDest.FindData.ftLastWriteTime);
        if (lastCopyDate<flDate) or (FOnlyModified=False) then
        begin
          CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
          FLogFile.SaveToFile(SearchRec.Name+' copied');
        end;
      end
      else
      begin
        CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
        FLogFile.SaveToFile(SearchRec.Name+' copied');
      end;
      if FIncludeSubFolders then
      begin
        if (shortint(SearchRec.Attr)=faDirectory) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        begin
          DoSecurityCopy(Source+'\'+SearchRec.Name,Target+'\'+SearchRec.Name);
        end;
      end;
    except
      FLogFile.SaveToFile(SearchRec.Name+' failed to copy');
    end;
  while (FindNext(SearchRec)=0) do
  begin
    flDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
    try
      if (FindFirst(Target+'\'+SearchRec.Name,faArchive,SRDest)=0) then
      begin
        lastCopyDate := FileTimeToDateTime(SRDest.FindData.ftLastWriteTime);
        if (lastCopyDate<flDate) or (FOnlyModified=False) then
        begin
          CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
          FLogFile.SaveToFile(SearchRec.Name+' copied');
        end;
      end
      else
      begin
        CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
        FLogFile.SaveToFile(SearchRec.Name+' copied');
      end;
      if FIncludeSubFolders then
      begin
        if (shortint(SearchRec.Attr)=faDirectory) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        begin
          DoSecurityCopy(Source+'\'+SearchRec.Name,Target+'\'+SearchRec.Name);
        end;
      end;
    except
      FLogFile.SaveToFile(SearchRec.Name+' failed to copy');
    end;
  end;
  FindClose(SearchRec);
  end;
end;

procedure TSecurityCopy.ExecuteSecurityCopy;
begin
  DoSecurityCopy(FSourcePath,FTargetPath);
end;

procedure TSecurityCopy.OnTimer(Sender: TObject);
begin

  if ComponentState=[csDesigning] then
    Exit;

  FTimer.Enabled := False;
  DoSecurityCopy(FSourcePath,FTargetPath);
  FTimer.Enabled := True;
end;

destructor TSecurityCopy.Destroy;
begin
  FLogFile.Free;
  FTimer.Free;
  FDebugOptions.Create;
  inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('Components Delphi', [TSecurityCopy]);
end;

end.

Les propietas SourcePath i TargetPath determinen els directoris origen i final de la còpia. Podem, mitjançant la propietat Extension filtrar el tipus de fitxers a copiar. La propietat Active ens permet desactivar la còpia. Interval ens indica cada quan volem fer còpia, en milisegons. Amb OnlyhModified, només copiem si el fitxer s'ha modificat des de l'última còpia. Overwrite indica si reemplaçar el fitxer destí si ja existeix. IncludeSubfolders fa còpia recursiva de directoris continguts en SourcePath. Finalment, amb DebugOptions podem fer que es generi un arxiu que registri les operacions de còpia. A part d'executar-se la còpia cada vegada que es compleixi el temps que hem triat a Interval, la podem forçar amb el mètode ExecuteSecurityCopy.

IntEdit

Aquest component és una caixa d'edicíó que només permet l'entrada de nombre sencers.

unit IntEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DsgnIntf, ShellAPI;

type TIntEditEd = class(TDefaultEditor)
  procedure ExecuteVerb(Index: integer); override;
  function GetVerb(Index: integer): string; override;
  function GetVerbCount: integer; override;
  end;

type
  TIntEdit = class(TCustomEdit)
  private
    { Private declarations }
    FAlignment: TAlignment;
    FValue: LongInt;
    FMaxValue: LongInt;
    lDelPressed: boolean;
    procedure SetAlignment(AAlignment: TAlignment);
    function GetFieldValue: LongInt;
    procedure SetFieldValue(iNewVal: LongInt);
    function GetAsInteger: LongInt;
    procedure SetAsInteger(lnVal: LongInt);
    function GetAsString: string;
    procedure SetAsString(strVal: string);
    procedure SetMaxValue(Value: LongInt);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property AsInteger: LongInt read GetAsInteger write SetAsInteger;
    property AsString: string read GetAsString write SetAsString;
  published
    { Published declarations }
    property Value: LongInt read GetFieldValue write SetFieldValue;
    property MaxValue: LongInt read FMaxValue write SetMaxValue;
    property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify;
    property Anchors;
    property AutoSelect;
    property AutoSize default True;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property Visible;
    (* General events properties *)
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;
type
  TIntEdit = class(TIntEdit);

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Components Delphi', [TIntEdit]);
end;

constructor TIntEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignment := taRightJustify;
  FValue := 0;
  Text := IntToStr(FValue);
  FMaxValue := 2147483647;
  lDelPressed := False;
end;

procedure TIntEdit.SetAlignment(AAlignment: TAlignment);
begin
  if FAlignment <> AAlignment then
  begin
    FAlignment := AAlignment;
    if not (csDesigning in ComponentState) then
      RecreateWnd;
    if Focused then
      SelectAll;
  end;
end;

function TIntEdit.GetFieldValue: LongInt;
begin
  Result := FValue;
end;

procedure TIntEdit.SetFieldValue(iNewVal: LongInt);
begin
    if iNewVal<=FMaxValue then
    begin
      Text := IntToStr(iNewVal);
      FValue := iNewVal;
    end;
    if Focused then
    begin
      SelStart := Length(Text);
      SelectAll;
    end;
end;

procedure TIntEdit.SetMaxValue(Value: LongInt);
begin
  FMaxValue := Value;
end;

procedure TIntEdit.SetAsInteger(lnVal: LongInt);
begin
  Value := lnVal;
end;

function TIntEdit.GetAsInteger: LongInt;
begin
  Result := Value;
end;

procedure TIntEdit.SetAsString(strVal: string);
begin
  Value := StrToInt(strVal);
end;

function TIntEdit.GetAsString: string;
begin
  Result := IntToStr(Value);
end;

procedure TIntEdit.KeyPress(var Key: Char);
begin
    if not (Key in [#27, '0'..'9', #8, #13]) then
    begin
      Key := #0;
      Exit;
    end;
    try
      if not (Key in [#27, #8, #13]) then
        FValue := StrToInt(Text+Key);
      inherited;
    except
      Key := #0;
    end;
  inherited KeyPress(Key);
end;

procedure TIntEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  ClearSelection;
  inherited KeyDown(Key,Shift);
end;

procedure TIntEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key,Shift);
  if Text='' then
  begin
    Text := '0';
    SelStart := Length(Text);
    SelectAll;
  end;
  FValue := StrToInt(Text);
end;


procedure TIntEdit.CreateParams(var Params: TCreateParams);
var
{$ifdef VER120}
  lnStyle: LongWord;
{$else}
  lnStyle: LongInt;
{$endif}
begin
  inherited CreateParams(Params);
  case Alignment of
    taLeftJustify:
      lnStyle := ES_LEFT;
    taRightJustify:
      lnStyle := ES_RIGHT
    else
      lnStyle := ES_CENTER;
  end;
  with Params do
    Style := Style or DWORD(lnStyle);
end;

procedure TIntEdit.CMEnter(var Message: TCMEnter);
begin
  if AutoSelect and not ReadOnly then
    SelectAll
  else
    if not ReadOnly then
    begin
      SelStart := Length(Text);
    end;
  Refresh;
  inherited;
end;

end.

El nombre introduït s'obté en la propietat Value. La propietat MaxValue ens permet limitar el màxim nombre a introduir. Tenim també la propietat Alignment, per alinear el text a la dreta de la caixa d'edició.

WinStartUp

Si posem aquest component en un formulari de l'aplicació podem fer que a l'arrancar Windows s'executi la nostra aplicació.

unit WinStartUp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Registry;

type
  TWinStartUp = class(tcomponent)
  private
    { Private declarations }
    FStartWithWin: boolean;
    FEnabled : boolean;
    procedure SetRegistryData(RootKey: HKEY; Key, Value: string;
      RegDataType: TRegDataType; Data: variant); protected
    function GetRegistryData(RootKey: HKEY; Key, Value: string): variant;
    function ExistRegistryData(RootKey: HKEY; Key, Value: string): boolean;
    procedure DelRegistryData(RootKey: HKEY; Key, Value: string);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure StartWithWindows(yes: boolean);
    function IsInStart: boolean;
  published
    { Published declarations }
    property Enabled: boolean read FEnabled write FEnabled;
    property StartWithWin: boolean read FStartWithWin write FStartWithWin;
  end;

procedure Register;

implementation

constructor TWinStartUp.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FStartWithWin := False;
  FEnabled := False;
end;

procedure TWinStartUp.StartWithWindows(yes: boolean);
begin
  if yes then
  begin
    if not ExistRegistryData(HKEY_LOCAL_MACHINE,
      'Software\Microsoft\Windows\CurrentVersion\Run',
      Application.Title) then
    begin
      SetRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title, rdString, Application.ExeName);
    end;
  end
  else
  begin
    if ExistRegistryData(HKEY_LOCAL_MACHINE,
      'Software\Microsoft\Windows\CurrentVersion\Run',
      Application.Title) then
    begin
      DelRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title);
    end;
  end;
end;

function TWinStartUp.IsInStart: boolean;
begin
  Result := ExistRegistryData(HKEY_LOCAL_MACHINE,
      'Software\Microsoft\Windows\CurrentVersion\Run',
      Application.Title);
end;

procedure TWinStartUp.Loaded;
begin
  inherited Loaded;
  if FEnabled then
  begin
    if FStartWithWin then
    begin
      if not ExistRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title) then
      begin
        SetRegistryData(HKEY_LOCAL_MACHINE,
          'Software\Microsoft\Windows\CurrentVersion\Run',
          Application.Title, rdString, Application.ExeName);
      end;
    end
    else
    begin
      if ExistRegistryData(HKEY_LOCAL_MACHINE,
        'Software\Microsoft\Windows\CurrentVersion\Run',
        Application.Title) then
      begin
        DelRegistryData(HKEY_LOCAL_MACHINE,
          'Software\Microsoft\Windows\CurrentVersion\Run',
          Application.Title);
      end;
    end;
  end;
end;

destructor TWinStartUp.Destroy;
begin
  inherited Destroy;
end;

function TWinStartUp.ExistRegistryData(RootKey: HKEY; Key, Value: string): boolean;
var
  Reg: TRegistry;
  s: string;
  res: boolean;
begin
  res := False;
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, False) then
    begin
      try
        if Reg.ValueExists(Value) then
        begin
          res := True;
        end
      except
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end
    else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
  Result := res;
end;

procedure TWinStartUp.DelRegistryData(RootKey: HKEY; Key, Value: string);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_WRITE);
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then
    begin
      try
        Reg.DeleteValue(Value);
      except
         Reg.CloseKey;
         raise;
      end;
      Reg.CloseKey;
    end
    else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

procedure TWinStartUp.SetRegistryData(RootKey: HKEY; Key, Value: string;
    RegDataType: TRegDataType; Data: variant);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_WRITE);
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then
    begin
      try
        if RegDataType = rdUnknown then
          RegDataType := Reg.GetDataType(Value);
        if RegDataType = rdString then
          Reg.WriteString(Value, Data)
        else if RegDataType = rdExpandString then
          Reg.WriteExpandString(Value, Data)
        else if RegDataType = rdInteger then
          Reg.WriteInteger(Value, Data)
        else if RegDataType = rdBinary then
        begin
          s := Data;
          Reg.WriteBinaryData(Value, PChar(s)^, Length(s));
        end
        else
          raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
      except
         Reg.CloseKey;
         raise;
      end;
      Reg.CloseKey;
    end
    else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

function TWinStartUp.GetRegistryData(RootKey: HKEY; Key, Value: string): variant;
var
  Reg: TRegistry;
  RegDataType: TRegDataType;
  DataSize, Len: integer;
  s: string;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKeyReadOnly(Key) then begin
      try
        RegDataType := Reg.GetDataType(Value);
        if (RegDataType = rdString) or
           (RegDataType = rdExpandString) then
          Result := Reg.ReadString(Value)
        else if RegDataType = rdInteger then
          Result := Reg.ReadInteger(Value)
        else if RegDataType = rdBinary then
        begin
          DataSize := Reg.GetDataSize(Value);
          if DataSize = -1 then
          begin
            raise Exception.Create(SysErrorMessage(ERROR_CANTREAD));
          end
          else
          begin
            SetLength(s, DataSize);
            Len := Reg.ReadBinaryData(Value, PChar(s)^, DataSize);
            if Len <> DataSize then
              raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
            else
              Result := s;
          end
        end
        else
          raise Exception.Create(SysErrorMessage(ERROR_CANTREAD));
      except
        s := '';
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

procedure Register;
begin
  RegisterComponents('Components Delphi', [TWinStartUp]);
end;

end.

Per a que el component actui, la propietat Enabled ha d'estar a True. Una vegada activat el component, si la propietat StartWithWin val True i executem la nostra aplicació, la pròxima vegada que arranquem Windows, arrancarà l'aplicació. Si la propietat està a False, al tornar a arrancar el sistema operatiu, l'aplicació no arrancarà.

VisualTimer

Aquest component és un Timer, però creat a partir d'un TCustomLabel. Té la particularitat de que es veu gràficament com es descompten els segons. El codi és el següent:

unit VisualTimer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, consts;

type
  TVisualTimer = class(TCustomLabel)
  private
    FSeconds: Cardinal;
    FSecondsIni: Cardinal;
    FWindowHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
  procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetSeconds(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Seconds: Cardinal read FSeconds write SetSeconds default 60;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
    property Transparent;
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property Caption;
  end;

procedure Register;

implementation

constructor TVisualTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FSeconds := 60;
  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor TVisualTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  DeallocateHWnd(FWindowHandle);
i nherited Destroy;
end;

procedure TVisualTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
  begin
    if Msg = WM_TIMER then
    try
      Dec(FSeconds);
      Caption := IntToStr(FSeconds);
      if FSeconds=0 then
      begin
        FSeconds := FSecondsIni;
        Timer;
      end;
    except
      Application.HandleException(Self);
    end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  end;
end;

procedure TVisualTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FSeconds <> 0) and FEnabled and Assigned(FOnTimer) then
  begin
    if SetTimer(FWindowHandle, 1, 1000, nil) = 0 then
      raise EOutOfResources.Create(SNoTimers);
    FSecondsIni := FSeconds;
  end;
end;

procedure TVisualTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
   UpdateTimer;
  end;
end;

procedure TVisualTimer.SetSeconds(Value: Cardinal);
begin
  if Value <> FSeconds then
  begin
     FSeconds := Value;
     UpdateTimer;
  end;
end;

procedure TVisualTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
  UpdateTimer;
end;

procedure TVisualTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

procedure Register;
begin
  RegisterComponents('Components Delphi', [TVisualTimer]);
end;

end.

La propietat Seconds indica el temps que trigarà a saltar l'event OnTimer. Tot i que él Timer de Delphi té una resolució de milisegons, això a nivell visual seria poc pràctic, per tant he deixat la resolució en segons.
També és podria modificar el component per si el timer supera els 60 segons poder mostrar minuts i segons, i el mateix en el cas de les hores.