Recull Components Delphi

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.