Módulo C.P.2017 (y IV): Reloj Analógico.

Buen camino a todos.

Con esta entrada, damos por finalizado el primer bloque de la serie, que contiene actualmente, tres entradas mas la inicial, que nos sirvió de introducción. Este primer bloque nos ha llevado a construir un componente muy sencillo, que representa un reloj analógico y que bien podríamos usar de forma independiente, o bien nos puede servir como punto de partida, -como será nuestro caso-, para abordar el reloj de fichar, que como recordáis era el propósito final de la serie. El objetivo que intentábamos cubrir, que no hay que perder de vista, era tomar aquel código antiguo y volver a plantearlo pero desde la perspectiva que nos da una nueva version de Delphi, donde aparecen nuevas estructuras y nuevas clases que permiten otro diseño. El código de Módulo de Control de Presencia, forma parte de una entrada creada en el 2010 y en ella, se comentaban algunas temas que a mi me parecían destacables:

Por ejemplo, se veía una implementación del patrón singleton, que como sabéis intenta garantizar la creación de una única instancia de clase. Cada vez que se ejecutaba el proceso para el registro de la hora, existía una sola instancia de TEmpleado para gestionarlo. Se creaba al inicio de proceso y se destruía al finalizar el mismo. Y esa instancia durante su corto tiempo de vida, conocía y manipulaba otros objetos necesarios para guardar la información correctamente.

Otro aspecto que era interesante, era la lista de Movimientos, que implementaba el patrón Iterator, para recorrerla. O pongamos por caso, cómo nos era posible guardar el estado de una instancia de TMovimiento para recuperarla posteriormente, cuando era necesaria esa información.

Tenía escritas otras versiones de un código similar, hechas tiempo atrás, pero apoyadas en bases de datos. No obstante, el planteamiento que use en el blog, como ejercicio, daba la oportunidad de reflexionar y aprender, y compensaba no usar los componentes tradicionales de conexión a datos.

Añadiendo algunos adornos…

Despedimos la entrada anterior, añadiendo una propiedad de tipo conjunto, cuyos elementos pertenecían a una enumeración.

TParteAdorno = (paExtra,
 paLogo,
 paDialSegundos,
 paDialMinutos,
 paDialHoras,
 paEsfera,
 paBoton,
 paAutor,
 paMarca);

 TAdornos = Set of TParteAdorno;

Y para nosotros, representaban, un modo sencillo para evaluar si un determinado adorno debía visualizarlo o por el contrario ignorarlo. La representación visual que nos muestra el inspector de objetos, nos permite observar que ya existe un editor por defecto para este tipo de propiedad «conjunto», correspondiente a checks True/False asociados a cada miembro de la enumeración.

Los adornos correspondientes a los valores paExtra, paEsfera y paBoton, no tienen propiedades asociadas y se limitarán a dibujar en ese lienzo que representa el canvas del reloj, el dibujo adecuado.

La referencia a estos métodos los tenemos en el mismo método Paint, sobrescrito. No nos ha hecho falta una propiedad adicional porque van a consistir básicamente en invocar algún método de trazado de linea o de figura geométrica, o similar. Hemos tomado precaución por declararlos virtuales por si se hace necesario en algún momento posterior, sobrescribirlos para modificar detalle de interés: el color del trazo, el grosor, el relleno de fondo.

procedure TMiReloj.Paint;
begin
   inherited;
...
  //pintamos un adorno extra
   PintarAdornoExtra(paExtra in FAdornos);
  //pintamos los diales
  PintarDial(maSegundos, paDialSegundos in FAdornos); 
  PintarDial(maHoras, paDialHoras in FAdornos);
  //dibujamos una linea de esfera exterior
   PintarEsfera(paEsfera in FAdornos);
  //dibujamos el punto central de union de agujas
   PintarBotonCentral(paBoton in FAdornos);
 ...
end;

Podemos ver uno de los tres métodos, dado que todos contienen código muy similar. Por ejemplo el método PintarEsfera( ):

procedure TMiReloj.PintarEsfera(const APintar: Boolean);
var
 fRect: TRectF;
begin
 if not APintar then Exit;

 fRect:= TRectF.Create((width-Min(Width, Height))/2+5,
 (height-Min(Width, Height))/2+5,
 (width+Min(Width, Height))/2-5,
 (height+Min(Width, Height))/2-5);
 Canvas.Stroke.Kind:= TBrushKind.Gradient;
 Canvas.Stroke.Thickness:= 12;
 Canvas.Stroke.Color:= FColorBEsfera;
 Canvas.DrawEllipse(fRect, AbsoluteOpacity);
end;

Si recordáis, anteriormente establecimos una ruta libre de dibujo, a través de la instancia de TPathData para pintar los diales. Ahora es mucho mas sencillo. Definimos un espacio delimitado por el area rectangular asociada a la estructura TRectF, y sobre dicha area, tras modificar las propiedades del trazo (Stroke), dibujamos la figura adecuada, que toma como referencia la superficie. En este caso, hemos dibujado un circulo  al invocar el método DrawEllipse( ) del Canvas. En la documentación podéis encontrar los distintos métodos públicos disponibles: Canvas. Os permitirán dibujar polígonos, rutas, esferas, lineas, textos, imágenes, etc…

...
DrawArc 
DrawBitmap 
DrawDashRect 
DrawEllipse 
DrawLine 
DrawPath 
DrawPolygon 
DrawRect 
DrawRectSides 
...

Tres de los adornos, el logo, el autor y la marca, pueden necesitar ser modificados en tiempo de diseño. La solución mas inmediata puede ser añadir 3 propiedades a nuestro reloj que nos permitan modificar el valor por defecto desde el inspector de objetos.

Para ello, podríamos añadirla en la parte publicada del componente.

 property Autor: String read FAutor write SetAutor;
 property Image: TBitmap read FImage write SetFImage;
 property Marca: String read FMarca write SetMarca;

Sencillo, ¿no?

Esto, que no es incorrecto, haría que aparecieran repartidas entre el resto de propiedades. Pero quizás, por su naturaleza, porque están íntimamente ligadas a los adornos, pudiéramos querer que aparecieran juntas. Ese apunte me lo hizo German, tras ojear una de las versiones. De esa forma improvisé sobre la marcha, ese pequeño cambio.

Una de las formas en que podemos hacer esto, es simplemente crear una clase  que represente estos adornos y que yo he venido a llamar TAdornosProp. No necesitamos que sea descendiente de ningún componente avanzado, y nos vale retrotraernos a uno de los ascendientes base que maneja la persistencia, TPersistent, para no recargar el componente con propiedades o métodos innecesarios. A fin de cuentas, lo único que necesitábamos era la persistencia.

Podemos hacer pues:

 TAdornosProp = class(TPersistent)
...
 published
   property DistanceToCenterAutor: Integer read FDistanceToCenterAutor write SetDistanceToCenterAutor default 115;
   property DistanceToCenterMarca: Integer read FDistanceToCenterMarca write SetDistanceToCenterMarca default 75;
   property Autor: String read FAutor write SetAutor;
   property Image: TBitmap read FImage write SetFImage;
   property Marca: String read FMarca write SetMarca;
 end;

Lo cual nos permitirá visualizar desde el inspector de objetos tal que así, tras añadir la nueva clase al reloj, en forma de una nueva propiedad publicada AdornosProp, de tipo TAdornosProp:

Ahora el editor de propiedades, nuestro inspector de objetos, nos muestra agrupadas en torno a esa propiedad.

Incluso nos beneficiamos del editor de propiedades al haber asociado la imagen a la clase TBitmap, que nos permitirá sin esfuerzo alguno tener la posibilidad de cambiarla en tiempo de diseño. Esta es la ventana de edición, vinculada a la propiedad, el Bitmap Editor. Al pulsar sobre los puntos suspensivos del inspector de objetos, abría la ventana de edición y nos permitirá cargar una nueva imagen y adecuarla al tamaño deseado o bien recortarla. ¡Delphi nos ahorra mucho trabajo!.

Siempre que te sea posible, no reinventes la rueda.

O bien agrupo el código…

Esto no tiene que ver propiamente con el código del reloj, sino con el modo en el que trabajamos en el editor del entorno. Delphi también nos proporciona ayuda para que nuestro trabajo sea lo mas satisfactorio posible. Y el Code Folding, es una de las características que sí contiene nuestra version starter de Delphi y que podemos aprovechar para estructurar algunas areas que, en determinado momento, podemos desear ocultar a la vista, que no ocupen espacio visual en el código del editor para que no nos distraigan. Ese espacio que se puede ocultar visualmente se denomina «region» y se delimita con las directivas $REGION y $ENDREGION, como aparece en el texto inferior.

{$REGION 'Metodos de escritura campos'} 
procedure TMiReloj.SetColorBEsfera(const Value: TAlphaColor); 
begin 
  if Value <> FColorBEsfera then 
  begin 
    FColorBEsfera := Value; 
    Repaint; 
  end; 
end; 

...
...
{$ENDREGION}

Yo por ejemplo, para que vierais esta posibilidad, he agrupado todas los métodos de escritura del reloj de esa forma. Una vez definida la región, los símbolos (+/-) nos permitirán ocultar el contenido o que permanezca visible. Por ello el termino que se traduce literalmente como Código plegado, que representa esa idea.

Una imagen como recurso

Antes de seguir, permitirme que demos un vistazo al enlace que nos lleva a una parte de la documentación que aborda el compilador de recursos: BRCC32.exe, ubicado en el directorio Bin de la ruta de instalación del IDE. Literalmente podemos leer:

BRCC32 is the command-line version of the resource compiler. It accepts a resource script file (.RC) as input and produces a resource object file (.RES) as output.

Aunque se indican mas detalles, nos quedamos con esa linea que es indicativa. Dice mas o menos: BRCC32 es la version en linea de comandos del compilador de recursos. Acepta un fichero script de texto (.RC) como input y produce un fichero  compilado de recursos (.RES) como output.

Veréis, cuando decidimos incluir la imagen del logo, acompañando del reloj, nos descubrió una pequeña dificultad añadida. Con las cadenas de texto, el autor y la marca, no existe problema, en el sentido de que son cadenas literales, que asignamos mediante una linea de código. Ahora bien… si deseamos incluir una imagen por defecto en nuestro componente, a modo de logo, debemos disponerla de una forma o de otra. Es decir, ahora no existe esa ayuda que recibimos durante el diseño de nuestra aplicación, bien desde nuestro editor, bien desde inspector de objetos, ayudas que nos permiten diseñar y configurar cada componente, y que el formulario, gracias a la persistencia, guarde los valores deseados.

Una opción, siguiendo esta lógica, podría ser invocar una o varias rutinas que carguen dinámicamente el contenido del fichero, pero esta opción nos obligaría a portarlo junto al código fuente, para que pueda ser localizado y cargado adecuadamente. O… ¡claro…! Nos queda otra alternativa. También podemos crear un recurso o recursos, compilados, embebidos en la librería (bpl) que encapsula el componente, de forma que nos permita recrear también mediante código el contenido binario pero eso sí, ahora no haría falta distribuir el fichero. En eso nos ayudará el compilador de recursos.

Dejadme que os guie sobre como podeis generar vuestro propio fichero «.res». Y la mejor guía puede ser acudir a una entrada del blog de un MVP hispano, compañero nuestro y amigo, que aborda este tema. Hablo de Xavier Martinez, Cadetil y de su entrada Cargar un png desde fichero de recursos. Básicamente, crearemos un fichero de texto, con la extensión «.rc», conteniendo una linea que identifica al recurso que se va a compilar y un texto asociado para identificarlo desde las llamadas. También le indicamos la naturaleza de este recurso, RC_Data (raw o formato en bruto, por decirlo en alguna forma, como almacén de bytes). Desde la consola, compilamos el fichero rc con nuestra herramienta y si tiene éxito el proceso, obtendremos un fichero de extension RES, que puede ser enlazado al código mediante una directiva de compilación:

{$R shapereloj.res}

Ese es el nombre que le di al fichero rc y el nombre que ha generado como archivo compilado que contiene uno o varios recursos. Estos archivos nos permiten guardar cadenas de texto, imagenes, logos, etc…

Ahora nos falta, recrear la imagen, que podemos incluir en el método constructor de TAdornoProp.

constructor TAdornosProp.Create;
var
 InStream: TResourceStream;
begin
  inherited;
  InStream := TResourceStream.Create(HInstance, 'RES_LOGO_150X150', RT_RCDATA);
  try
    FImage:= TBitmap.CreateFromStream(InStream);
  finally
    InStream.Free;
  end;
  FAutor:= 'Salvador Jover';
  FMarca:= '© 2017 El blog de Delphi Básico';
  FDistanceToCenterAutor:= 115;
  FDistanceToCenterMarca:= 75;
end;

La mecánica tiene una lógica. Primero cargamos en memoria el contenido de la imagen compilada y posteriormente, utilizamos un método de clase para asignar a la referencia FImage, la instancia del bitmap. Una vez que no necesitamos el stream, liberamos la memoria. Siempre intentamos proteger esta reserva de memoria asociada a la creación de un objeto, en un estructura, Try… Finally, que nos asegure que pase lo que pase, la memoria se libera. Igualmente, el campo FImage, debe liberar la memoria asociada al bitmap, cuando se destruya el componente reloj, en el método destructor. Allí hacemos la llamada a Free.

destructor TAdornosProp.Destroy;
begin
 FImage.Free;
 FImage:= Nil;
 FAutor:= '';
 FMarca:= '';
end;

Casi todo esta resuelto, salvo alguna cosa…

La imaginación al poder

Que desciende TAdornosProp, de TPersistent, tiene algunas ventajas y también algun inconveniente.

Ventajas las citadas anteriormente. Inconveniente, uno: la implementación inicial de los métodos de escritura, supongamos que hubiéramos hecho:

 procedure TAdornosProp.SetMarca(const Value: String);
begin
 if Value <> FMarca then
 begin
   FMarca := Value;
 end;
end;

Al modificar estas propiedades en el inspector de objetos, en la aplicación de test, descubriríamos que no funcionan correctamente, pues los cambios no se trasladan al reloj y permanece inalterado. Así que en mi caso, yo me he inventado un mecanismo de notificación para informar al componente padre, el reloj, que necesita repintarse.

Ahora me permito escribir:

procedure TAdornosProp.SetMarca(const Value: String);
begin
 if Value <> FMarca then
 begin
 FMarca := Value;
 DoNeedParentRepaint;
 end;
end;

Que sigue sin ser perfecto, pues podemos buscar rutinas mas adecuadas para efectuar la comparación entre cadenas, pero he introducido un metodo, con nombre misterioso que acaba siendo una sencilla notificación, de las de toda la vida.

...
protected
  procedure DoNeedParentRepaint; virtual;
public
  constructor Create;
  destructor Destroy; override;
  property OnNeedRepaint: TNotifyEvent read FOnNeedRepaint write SetOnNeedRepaint;
published
...

Donde DoNeedParentRepaint, queda vinculado al evento que es ejecutado en quien puede efectivamente hacer la tarea requerida, el reloj.

procedure TAdornosProp.DoNeedParentRepaint;
begin
 if Assigned(FOnNeedRepaint) then FOnNeedRepaint(Self);
end;

Ahora el constructor del reloj, ha añadido ambos requerimientos, crear la instancia de TAdornosProp y vincularla con la notificación, como se ve en el siguiente código.

constructor TMiReloj.Create(AOwner: TComponent);
begin
  inherited;
  FAdornosProp:= TAdornosProp.Create;
  FAdornosProp.OnNeedRepaint:= OnNeedRepaint;
 ...

Nos queda probarlo…

Solo unos pocos elegidos son capaces de hacer cosas perfectas y a la primera. La mayoría hacemos cosas…, distantes de ser perfectas y distantes de salir a la primera. Vosotros quizás no.. pero yo sí.

🙂

Necesitamos probar el componente para ver si funciona. Os ahorro un poco de trabajo y para ver que efectivamente hace lo que deseamos, con independencia de que pueda hacer muchas cosas mas, he añadido algo de código sobre el proyecto auxiliar, que acompañaba al componente. Todo está incluido en el enlace que se muestra para descarga, al final del siguiente texto que contiene la unidad MiReloj, incluida para que se pueda seguir los comentarios sin tener que obligar a descargarlo.

unit MiReloj;

interface

uses
  System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Objects,
FMX.Graphics, System.UITypes, System.UIConsts, System.Types;

type
  TTipo = (maSegundos, maMinutos, maHoras);

  TParteAdorno = (paExtra,
                  paLogo,
                  paDialSegundos,
                  paDialMinutos,
                  paDialHoras,
                  paEsfera,
                  paBoton,
                  paAutor,
                  paMarca);

  TAdornos = Set of TParteAdorno;

  TAdornosProp = class(TPersistent)
   private
    FAutor: String;
    FImage: TBitmap;
    FMarca: String;
    FOnNeedRepaint: TNotifyEvent;
    FDistanceToCenterAutor: Integer;
    FDistanceToCenterMarca: Integer;
    procedure SetAutor(const Value: String);
    procedure SetFImage(const Value: TBitmap);
    procedure SetMarca(const Value: String);
    procedure SetOnNeedRepaint(const Value: TNotifyEvent);
    procedure SetDistanceToCenterAutor(const Value: Integer);
    procedure SetDistanceToCenterMarca(const Value: Integer);
   protected
    procedure DoNeedParentRepaint; virtual;
   public
    constructor Create;
    destructor Destroy; override;
    property OnNeedRepaint: TNotifyEvent read FOnNeedRepaint write SetOnNeedRepaint;
   published
    property DistanceToCenterAutor: Integer read FDistanceToCenterAutor write SetDistanceToCenterAutor default 115;
    property DistanceToCenterMarca: Integer read FDistanceToCenterMarca write SetDistanceToCenterMarca default 75;
    property Autor: String read FAutor write SetAutor;
    property Image: TBitmap read FImage write SetFImage;
    property Marca: String read FMarca write SetMarca;
  end;

...

  TMiReloj = class(TCircle)
  private
    { Private declarations }
    FColorBEsfera: TAlphaColor;
    FColorExtra: TAlphaColor;
    FDateTime: TDateTime;
    FRadioEsfera: Single;
    FInternalTimer: TTimer;
    FEnableTimer: Boolean;
    FOnInternalTimer: TNotifyEvent;
    FPath: TPathData;
    FAdornos: TAdornos;
    FAdornosProp: TAdornosProp;
    FMargenEsfera: SmallInt;
    function CreaManecilla(const ATipoManecilla: TTipo;const ANombre: String; APorcentajeRadio: Single): TManecilla;
    function CreaTemporizador(FuncTemporiza: TNotifyEvent): TTimer;   
    procedure SetColorBEsfera(const Value: TAlphaColor);
    procedure SetColorExtra(const Value: TAlphaColor);
    procedure SetEnableTimer(const Value: Boolean);
    procedure TimerOnInternalTimer(Sender: TObject);
    procedure SetAdornos(const Value: TAdornos);
    procedure SetMargenEsfera(const Value: SmallInt);
    procedure SetAdornosProp(const Value: TAdornosProp);
    procedure OnNeedRepaint(Sender: TObject);
  strict protected
    FMHoras: TManecilla;
    FMMinutos: TManecilla;
    FMSegundos: TManecilla;
  protected
    { Protected declarations }
    procedure CreateDial(const ATipoDial: TTipo); virtual;
    procedure Paint; override;
    procedure PintarAdornoExtra(const APintar: Boolean); virtual;
    procedure PintarBotonCentral(const APintar: Boolean); virtual;
    procedure PintarDial(const ATipoDial: TTipo; const APintar: Boolean); virtual;
    procedure PintarEsfera(const APintar: Boolean); virtual;
    procedure PintarLogo(const APintar: Boolean); virtual;
    procedure PintarTextoAutor(const APintar: Boolean); virtual;
    procedure PintarTextoMarca(const APintar: Boolean); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(X,Y, AWidth, AHeight: Single); override;
    procedure SetNewTime(const ANow: TDateTime);
    property DateTimeNow: TDateTime read FDateTime;
  published
    { Published declarations }
    property Fill;
    property Stroke;
    property OnKeyDown;
    property Adornos: TAdornos read FAdornos write SetAdornos default [paDialSegundos, paDialMinutos, paDialHoras] ;
    property AdornosProp: TAdornosProp read FAdornosProp write SetAdornosProp;
    property ColorBEsfera: TAlphaColor read FColorBEsfera write SetColorBEsfera default claBlue;
    property ColorExtra: TAlphaColor read FColorExtra write SetColorExtra default claWhite;
    property EnableTimer: Boolean read FEnableTimer write SetEnableTimer default True;
    property MargenEsfera: SmallInt read FMargenEsfera write SetMargenEsfera default 20;
    property OnInternalTimer: TNotifyEvent read FOnInternalTimer write FOnInternalTimer;
  end;

procedure Register;

implementation

uses System.Math, DateUtils;

{$R shapereloj.res}

procedure Register;
begin
  RegisterComponents('Samples', [TMiReloj]);
end;

function TMiReloj.CreaManecilla(const ATipoManecilla: TTipo;const ANombre: String; APorcentajeRadio: Single): TManecilla;
begin
  Result:= TManecilla.CreateManecilla(self, ATipoManecilla);
  with Result do
  begin
    Parent:= Self;
    Name:= ANombre;
    PorcentajeSobreRadio:= APorcentajeRadio;
    Stored:= False;
  end;
end;

constructor TMiReloj.Create(AOwner: TComponent);
begin
  inherited;
  FAdornosProp:= TAdornosProp.Create;
  FAdornosProp.OnNeedRepaint:= OnNeedRepaint;
  //ajustamos margenes por defecto
  Margins.Bottom:= 10;
  Margins.Left:= 10;
  Margins.Right:= 10;
  Margins.Top:= 10;

  FMargenEsfera:= 20;

  Width:= 400;
  Height:= 400;

  FMHoras:= CreaManecilla(maHoras, 'manecilla_horas', 40.0);
  FMMinutos:= CreaManecilla(maMinutos, 'manecilla_minutos', 55.0);
  FMSegundos:= CreaManecilla(maSegundos, 'manecilla_segundos', 70.0);

  FAdornos:= [paDialSegundos, paDialMinutos, paDialHoras];

  FPath := TPathData.Create;

  FColorBEsfera:= claBlue;
  FColorExtra:= claWhite;

  FEnableTimer:= True;
  FInternalTimer:= CreaTemporizador(TimerOnInternalTimer);
  TimerOnInternalTimer(nil);
end;

procedure TMiReloj.CreateDial(const ATipoDial: TTipo);

  procedure GoToAVertex(n: Integer; p: Integer; Angle, CircumRadius: Double;
    const ATipoDial: TTipo; IsLineTo: Boolean = True);
  var
    NewLocation: TPointF;
    FLongDial: Integer;
  begin            //punto centro
    NewLocation.X := (Width  / 2) + (Sin(n * Angle) * CircumRadius);
    NewLocation.Y := (Height / 2) - (Cos(n * Angle) * CircumRadius);

    case ATipoDial of
      TTipo.maSegundos: FLongDial:= 5;
      TTipo.maMinutos: FLongDial:= 7;
      TTipo.maHoras: FLongDial:= 10;
    else
      FLongDial:= 0;
    end;

    if IsLineTo then
    begin
      FPath.MoveTo(NewLocation);
      NewLocation.X:= NewLocation.X +  (Sin(n * Angle) * FLongDial);
      NewLocation.Y:= NewLocation.Y -  (Cos(n * Angle) * FLongDial);
      if n <= p then FPath.LineTo(NewLocation);
    end
    else
      NewLocation.X:= NewLocation.X +  (Sin(n * Angle) * FLongDial);
  end;

var
  i: Integer;
  Angle: Double;
  FNumberOfSides: Integer;
begin
  case ATipoDial of
    TTipo.maSegundos: FNumberOfSides:= 60;
    TTipo.maMinutos: FNumberOfSides:= 60;
    TTipo.maHoras: FNumberOfSides:= 12;
  else
    FNumberOfSides:= 1;
  end;
  Angle:=  2 * PI / FNumberOfSides;

  FPath.Clear;

  GoToAVertex(0, FNumberOfSides, Angle, FRadioEsfera, ATipoDial, False);
  for i := 1 to FNumberOfSides + 1 do
    GoToAVertex(i, FNumberOfSides, Angle, FRadioEsfera, ATipoDial);

  FPath.ClosePath;
end;

function TMiReloj.CreaTemporizador(FuncTemporiza: TNotifyEvent): TTimer;
begin
  Result:= TTimer.Create(nil);
  with Result do
  begin
    Enabled:= FEnableTimer;
    OnTimer:= FuncTemporiza;
  end;
end;

destructor TMiReloj.Destroy;
begin
  FAdornosProp.Free;
  FInternalTimer.Free;
  FPath.Free;
  inherited;
end;

procedure TMiReloj.OnNeedRepaint(Sender: TObject);
begin
  Repaint;
end;

{$REGION 'Metodos de escritura campos'}

procedure TMiReloj.SetColorBEsfera(const Value: TAlphaColor);
begin
  if Value  FColorBEsfera then
  begin
    FColorBEsfera := Value;
    Repaint;
  end;
end;

procedure TMiReloj.SetColorExtra(const Value: TAlphaColor);
begin
  if Value  FColorExtra then
  begin
    FColorExtra := Value;
    Repaint;
  end;
end;

procedure TMiReloj.SetAdornos(const Value: TAdornos);
begin
  if FAdornos  Value then
  begin
    FAdornos := Value;
    Repaint;
  end;
end;

procedure TMiReloj.SetAdornosProp(const Value: TAdornosProp);
  function Equals(A, B: TAdornosProp): Boolean;
  begin
    Result:= (CompareStr(A.Autor, B.Autor) = 0) and
             (CompareStr(A.Marca, B.Marca) = 0) and
             A.Image.EqualsBitmap(B.Image);
  end;
begin
  if not Equals(FAdornosProp, Value) then
  begin
    FAdornosProp.Autor := Value.Autor;
    FAdornosProp.Marca:= Value.Marca;
    if Assigned(Value.Image) then
      FAdornosProp.Image.Assign(Value.Image)
    else
     begin
       FAdornosProp.Image.Free;
       FAdornosProp.Image:= Nil;
     end;
  end;
  Repaint;
end;

procedure TMiReloj.SetEnableTimer(const Value: Boolean);
begin
  if FEnableTimer  Value then
  begin
    FEnableTimer := Value;
    FInternalTimer.Enabled:= FEnableTimer;
    Repaint;
  end;
end;

procedure TMiReloj.SetMargenEsfera(const Value: SmallInt);
begin
  if FMargenEsfera  Value then
  begin
    FMargenEsfera := Value;
    Repaint;
  end;
end;

{$ENDREGION}

procedure TMiReloj.SetNewTime(const ANow: TDateTime);
begin
  //actualizamos la hora
  FDateTime:= ANow;
  //comunicamos a cada manecilla para que corrijan al angulo adecuado
  FMSegundos.SetAnguloRotacion(FDateTime);
  FMMinutos.SetAnguloRotacion(FDateTime);
  FMHoras.SetAnguloRotacion(FDateTime);

  Repaint;
end;


{$REGION 'Partes pintadas en el interior del reloj'}

procedure TMiReloj.PintarAdornoExtra(const APintar: Boolean);
var
  fRect: TRectF;
begin
  if not APintar then Exit;

  Canvas.Fill.Color:= FColorExtra;
  Canvas.Stroke.Color:= claGrey;
  fRect:= TRectF.Create((width-Min(Width, Height))/2+10,
                        (height)/2+100,
                        (width+Min(Width, Height))/2-10,
                        (height)/2-100);
   Canvas.DrawRect(fRect, 100, 100, AllCorners, 50);
   Canvas.FillRect(fRect, 100, 100, AllCorners, 50);
end;

procedure TMiReloj.PintarBotonCentral(const APintar: Boolean);
var
  fRect: TRectF;
begin
  if not APintar then Exit;

  //dibujamos el punto central
  fRect:= TRectF.Create(width/2-4,
                        height/2-4,
                        width/2+4,
                        height/2+4);
  Canvas.Stroke.Thickness:= 3;
  Canvas.Stroke.Color:= claBlue;
  Canvas.Fill.Kind:= TBrushKind.Solid;
  Canvas.Fill.Color:= claBlack;
  Canvas.FillEllipse(fRect, AbsoluteOpacity);
  Canvas.DrawEllipse(fRect, AbsoluteOpacity);
end;

procedure TMiReloj.PintarDial(const ATipoDial: TTipo; const APintar: Boolean);
begin
  if not APintar then Exit;

  case ATipoDial of
    maSegundos: begin
                  CreateDial(maSegundos);
                  Canvas.Stroke.Thickness:= 1;
                  Canvas.FillPath(FPath, AbsoluteOpacity);
                  Canvas.DrawPath(FPath, AbsoluteOpacity);
                end;
    maMinutos :;
    maHoras   : begin
                  CreateDial(maHoras);
                  Canvas.Stroke.Thickness:= 4;
                  Canvas.Stroke.Color:= claGrey;
                  Canvas.FillPath(FPath, AbsoluteOpacity);
                  Canvas.DrawPath(FPath, AbsoluteOpacity);
                end;
  end;
end;

procedure TMiReloj.PintarEsfera(const APintar: Boolean);
var
  fRect: TRectF;
begin
  if not APintar then Exit;

  fRect:= TRectF.Create((width-Min(Width, Height))/2+5,
                        (height-Min(Width, Height))/2+5,
                        (width+Min(Width, Height))/2-5,
                        (height+Min(Width, Height))/2-5);
  Canvas.Stroke.Kind:= TBrushKind.Gradient;
  Canvas.Stroke.Thickness:= 12;
  Canvas.Stroke.Color:= FColorBEsfera;
  Canvas.DrawEllipse(fRect, AbsoluteOpacity);
end;

procedure TMiReloj.PintarLogo(const APintar: Boolean);
var
  fRect: TRectF;
begin
  if (not APintar) then Exit;

  if Assigned(FAdornosProp) and Assigned(FAdornosProp.Image) then
  begin
    fRect:= TRectF.Create((width-(AdornosProp.Image.Width/2))/2,
                          (height-(AdornosProp.Image.Height/2))/2,
                          (width+(AdornosProp.Image.Width/2))/2,
                          (height+(AdornosProp.Image.Height/2))/2);
    Canvas.DrawBitmap(FAdornosProp.Image, RectF(0,0,FAdornosProp.Image.Width,FAdornosProp.Image.Height), fRect, 20);
  end;
end;

procedure TMiReloj.PintarTextoAutor(const APintar: Boolean);
var
  fRect: TRectF;
begin
  if not APintar then Exit;

  if Assigned(FAdornosProp) then
  begin
    fRect:= TRectF.Create((width-Min(Width, Height))/2,
                          FAdornosProp.DistanceToCenterAutor + (height-Min(Width, Height))/2,
                          (width+Min(Width, Height))/2,
                          (height+Min(Width, Height))/2);
    Canvas.Stroke.Color:= claBlack;
    Canvas.Fill.Kind:= TBrushKind.Solid;
    Canvas.Fill.Color:= claBlack;
    Canvas.Font.Family:= 'Segoe Print';
    Canvas.Font.Size:= 10;
    Canvas.FillText(fRect, FAdornosProp.Autor, False, AbsoluteOpacity, [], TTextAlign.Center, TTextAlign.Center);
  end;
end;

procedure TMiReloj.PintarTextoMarca(const APintar: Boolean);
var
  fRect: TRectF;
begin
  if not APintar then Exit;

  if Assigned(FAdornosProp) then
  begin
    fRect:= TRectF.Create((width-Min(Width, Height))/2,
                          FAdornosProp.DistanceToCenterMarca + (height-Min(Width, Height))/2,
                          (width+Min(Width, Height))/2,
                          (height+Min(Width, Height))/2);
    Canvas.Stroke.Color:= claBlack;
    Canvas.Fill.Kind:= TBrushKind.Solid;
    Canvas.Fill.Color:= claBlack;
    Canvas.Font.Family:= 'Segoe UI';
    Canvas.Font.Size:= 14;
    Canvas.FillText(fRect, FAdornosProp.Marca, False, AbsoluteOpacity, [], TTextAlign.Center, TTextAlign.Center);
  end;
end;

{$ENDREGION}

procedure TMiReloj.TimerOnInternalTimer(Sender: TObject);
begin
  SetNewTime(Now);
  if Assigned(FOnInternalTimer) then FOnInternalTimer(Self);
end;

procedure TMiReloj.SetBounds(X,Y, AWidth, AHeight: Single);
begin
  inherited SetBounds(X,Y,AWidth,AHeight);

  FRadioEsfera:= Min(ShapeRect.Width / 2, ShapeRect.Height / 2)- MargenEsfera;

  with FMSegundos do
  begin
    AjustarPosicion(AWidth, AHeight);
    Width:= FRadioEsfera * PorcentajeSobreRadio / 100;
    Height:= FRadioEsfera * PorcentajeSobreRadio / 100;
  end;

  with FMMinutos do
  begin
    AjustarPosicion(AWidth, AHeight);
    Width:= FRadioEsfera * PorcentajeSobreRadio / 100;
    Height:= FRadioEsfera * PorcentajeSobreRadio / 100;
  end;

  with FMHoras do
  begin
    AjustarPosicion(AWidth, AHeight);
    Width:= FRadioEsfera * PorcentajeSobreRadio / 100;
    Height:= FRadioEsfera * PorcentajeSobreRadio / 100;
  end;
end;

procedure TMiReloj.Paint;
begin
  inherited;
  //pintamos un adorno extra
  PintarAdornoExtra(paExtra in FAdornos);
  //dibujamos la imagen
  PintarLogo(paLogo in FAdornos);
  //pintamos los diales
  PintarDial(maSegundos, paDialSegundos in FAdornos);
  PintarDial(maHoras, paDialHoras in FAdornos);
  //dibujamos una linea de esfera exterior
  PintarEsfera(paEsfera in FAdornos);
  //dibujamos el punto central de union de agujas
  PintarBotonCentral(paBoton in FAdornos);
  //rellenamos el texto de la marca
  PintarTextoMarca((Trim(FAdornosProp.Marca)  '') and (paMarca in FAdornos));
  //rellenamos el autor
  PintarTextoAutor((Trim(FAdornosProp.Autor)  '') and (paAutor in FAdornos));
end;

{ TAdornosProp }

constructor TAdornosProp.Create;
var
  InStream: TResourceStream;
begin
  inherited;
  InStream := TResourceStream.Create(HInstance, 'RES_LOGO_150X150', RT_RCDATA);
  try
    FImage:= TBitmap.CreateFromStream(InStream);
  finally
    InStream.Free;
  end;
  FAutor:= 'Salvador Jover';
  FMarca:= '© 2017 El blog de Delphi Básico';
  FDistanceToCenterAutor:= 115;
  FDistanceToCenterMarca:= 75;
end;

destructor TAdornosProp.Destroy;
begin
  FImage.Free;
  FImage:= Nil;
  FAutor:= '';
  FMarca:= '';
end;

procedure TAdornosProp.DoNeedParentRepaint;
begin
  if Assigned(FOnNeedRepaint) then FOnNeedRepaint(Self);
end;

procedure TAdornosProp.SetAutor(const Value: String);
begin
  if FAutor <> Value then
  begin
    FAutor := Value;
    DoNeedParentRepaint;
  end;
end;

procedure TAdornosProp.SetDistanceToCenterAutor(const Value: Integer);
begin
  if FDistanceToCenterAutor  Value then
  begin
    FDistanceToCenterAutor := Value;
    DoNeedParentRepaint;
  end;
end;

procedure TAdornosProp.SetDistanceToCenterMarca(const Value: Integer);
begin
  if FDistanceToCenterMarca  Value then
  begin
    FDistanceToCenterMarca := Value;
    DoNeedParentRepaint;
  end;
end;

procedure TAdornosProp.SetFImage(const Value: TBitmap);
begin
  FImage.Assign(Value);
  DoNeedParentRepaint;
end;

procedure TAdornosProp.SetMarca(const Value: String);
begin
  if Value <> FMarca then
  begin
    FMarca := Value;
    DoNeedParentRepaint;
  end;
end;

procedure TAdornosProp.SetOnNeedRepaint(const Value: TNotifyEvent);
begin
  FOnNeedRepaint := Value;
end;

end.

Descarga: Código fuente RelojAnalogico

Los dos conejos… y nos despedimos

Hay una fábula de Tomas Iriarte, Los dos conejos…, que me viene ni pintada al comentario que tenía en mente para finalizar. La última estrofa, nos descubre la moraleja de la historia y que viene a decir, en resumen, que en la vida debemos aprender a distinguir las cosas importantes de las que no lo son. O que a veces perdemos el tiempo con discusiones inútiles e improductivas.

Esa asociación de ideas me ha venido a la cabeza mientras escribía los últimos párrafos de la entrada y observaba el código escrito para ligar la clase TManecilla con el Reloj. En concreto yo había usado una variable ligada al mismo tipo, lo cual, determina ciertamente  algunos aspectos que condicionan una posible evolución del reloj.

Un conejo era la composición por herencia. El otro la composición por delegación de interfaces, discutiendo ambos sobre si eran galgos o podencos quienes les perseguían. Básicamente, ambos, justifican la necesidad de que nuestra aplicación se adapte a nuevos requerimientos, como representación viva de una realidad que es mutable y caduca. El peso recaerá mas sobre el segundo que sobre el primero, pues un interfaz no deja de ser mas que un contrato que obliga a cumplir a quien lo asume y eso implica -per se- mayor libertad. Marteens nos dejo dos libros magnificos en formas de Caras Ocultas. Hay un capítulo en el segundo, en el que habla de esta relación, en su libro La Cara Oculta de Delphi 6 que sencillamente es genial y altamente recomendable a pesar del tiempo transcurrido (La pagina 27 en adelante abre un apartado especifico sobre el tema de las interfaces).

El tema es sin duda complejo, y nos puede llevar a estudiar los grados de acoplamiento entre las distintas clases y el modo en el que las interfaces y el empleo algunos frameworks nos ayudan y preparan para el cambio en los requerimientos. Aquí sin duda hay que acudir a los últimos libros de Nick Hodges, que es el único autor en mi humilde opinión, que se ha atrevido a salirse de la literatura tradicional que nos acompaña. Uno es Coding in Delphi y el otro More Coding in Delphi, dos pequeñas joyas para leer con detenimiento que yo sin duda os recomiendo.

Todos reconocemos que Object Pascal, ha ido enriqueciéndose con los años añadiendo nuevas estructuras y quizás las mas significativas en los últimos años, han venido de la mano de los Genéricos y los Métodos anónimos, que han acompañado los cambios profundos que se han ido sucediendo tanto a nivel de herramienta, editor de texto o plataformas, soportes de nuestro código. Los cambios se han ido sucediendo vertiginosos. De alguna forma, como programadores sentimos también ese vertigo, al vernos obligados a vivir y acompañar esa evolución al tiempo que también cambian los proyectos que hemos creado y mantenemos.

La idea que intento transmitir es la necesidad de concebir esa adaptación, pasada presente o futura, no como una imposición sino como un marco de mayor de libertad, que nos permita tomar mejores decisiones de diseño. Y nuestro conocimiento del lenguaje Object Pascal y de toda su riqueza expresiva, va a ser clave para poder vivir esa adaptación. Poco tiene que ver aquel modulo Classes.pas que estudiaba en 2002, en la serie Objetos Auxiliares, que acompañó la revista Síntesis en los números 3 al 9, al System.Classes actual, donde hoy se colaron conceptos añadidos, como los mencionados Genéricos o la adaptación a Unicode a poco que recorramos con la vista la unidad.

Así que mi consejo va en ese sentido, conoce bien el lenguaje y en la medida que te sea posible, integra sucesivamente aquellos cambios que va imponiendo.

Nos despedimos aquí. El bloque siguiente de la serie nos llevará a convertir el reloj analógico en el reloj de fichar…

Sed felices.

Bibliografia adicional:

DLL’s, BPL’s, Carga dinámica/Estática y “Packages en Runtime” – Delphi-Neftali- (2010)