I have created an analog clock for my app using the Lazarus and the BGRABitmap methods and I thought I should share. I have created a thread on the Lazarus forum about this.

Analog Clock

Basically, two bgrabitmap objects are created. First the clock face and frame on start up and second the moving parts on a timer event. Then the two images are combined to create the complete clock. On the next timer event, moving part are erased and recreated and combined with the clock face again. The clock body and face will be redrawn when the form is resized.

I got the idea from http://libregraphicsworld.org/blog/entry/drawing-mac-like-clock-in-inkscape. I use the bgrabitmapmethods to generate the gradients and filled shapes.

A further improvement will be to create a component where the size is predetermined and lock faces designed and saved in a res file to speed up performance.

Here is the code:

unit umain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, BGRAVirtualScreen, Forms, Controls,
  Graphics, Dialogs, ExtCtrls,
  BGRABitmap, BGRABitmapTypes, bgrasamples, BGRATextFX, BGRAGradients;

type

  { TForm1 }
  TForm1 = class(TForm)
    vsClock: TBGRAVirtualScreen;
    Timer1: TTimer;
    procedure FormClose(Sender : TObject; var CloseAction : TCloseAction);
    procedure FormCreate(Sender : TObject);
    procedure FormResize(Sender : TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure vsClockRedraw(Sender: TObject; Bitmap: TBGRABitmap);
  private
    { private declarations }
  public
    { public declarations }
    ClockBody, MovingParts : TBGRABitmap;
    procedure Initialize;
    procedure CreateClockBody;
    procedure CreateMovingParts;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.vsClockRedraw(Sender: TObject; Bitmap: TBGRABitmap);
begin
  //Bitmap.PutImage(0, 0, ClockBody, dmDrawWithTransparency);
  Bitmap.BlendImage(0, 0, ClockBody, boLinearBlend);
  Bitmap.BlendImage(0, 0, MovingParts, boLinearBlend);
end;

procedure TForm1.Initialize;
begin

end;

procedure TForm1.CreateClockBody;
var
  img : TBGRABitmap;
  txt: TBGRACustomBitmap;
  A : Integer;
  w, h, r, Xo, Yo, X, Y, Xt, Yt: integer;
  phong: TPhongShading;
begin

  w := vsClock.Width;
  h := vsClock.Height;

  img := TBGRABitmap.Create(w,h);

  { Set center point }
  Xo := w div 2;
  Yo := h div 2;

  // Determine radius. If canvas is rectangular then r = shortest length w or h
  r := yo;

  if xo > yo then
    r := yo;

  if xo < yo then
    r := xo;

  // Draw Bitmap frame
  img.FillEllipseAntialias(Xo, Yo, r * 0.99, r * 0.99, BGRA(175, 175, 175));

  // Draw Rounded/RIng type border using shading
  phong := TPhongShading.Create;
  phong.LightPosition := point(Xo, Yo);
  phong.DrawSphere(img, rect(round(Xo - r * 0.98), round(Yo - r * 0.98),
                   round(Xo + r * 0.98) + 1,
                   round(Yo + r * 0.98) + 1), 4, BGRA(245, 245, 245));
  phong.Free;

  img.FillEllipseLinearColorAntialias(Xo, Yo, r * 0.88, r * 0.88, BGRA(0, 58, 81),
                                      BGRA(2, 94, 131));

  // Draw Face frame
  img.FillEllipseAntialias(Xo, Yo, r * 0.90, r * 0.90, BGRA(175, 175, 175));

  // Draw face background
  img.FillEllipseLinearColorAntialias(Xo, Yo, r * 0.88, r * 0.88, BGRA(0, 58, 81),
                                      BGRA(2, 94, 131));

  // Draw Bitmap face
  for A := 1 to 12 do
  begin
    X := Xo + Round(r * 0.80 * Sin(30 * A * Pi / 180));
    Y := Yo - Round(r * 0.80 * Cos(30 * A * Pi / 180));
    Xt := Xo + Round(r * 0.70 * Sin(30 * A * Pi / 180));
    Yt := Yo - Round(r * 0.70 * Cos(30 * A * Pi / 180));
    img.EllipseAntialias(x, y, (r * 0.02), (r * 0.02),
                         BGRA(255, 255, 255, 200),
2, BGRA(2, 94, 131));

    img.FontName := 'Calibri';
    img.FontHeight := r div 8;
    img.FontQuality := fqFineAntialiasing;
    img.TextOut(Xt, Yt - (img.FontHeight / 1.7), IntToStr(A),
                BGRA(245, 245, 245), taCenter);
  end;

  // Draw text
  txt := TextShadow(w, h, 'www.Digeotek.com', trunc(r * 0.12),
                    ColorToBGRA(clWhite), BGRABlack, 4, 4, 10, [], 'Calibri');
  img.BlendImage(0, 0 - (r div 3), txt, boLinearBlend);
  txt.Free;

  ClockBody.Assign(img);

  img.Free;

end;

procedure TForm1.CreateMovingParts;
var
  img : TBGRABitmap;
  w, h, r, Xo, Yo : integer;
  Xs, Ys, Xm, Ym, Xh, Yh: integer;
  th, tm, ts, tn: word;
begin

  w := vsClock.Width;
  h := vsClock.Height;

  img := TBGRABitmap.Create(w,h);

  { Set center point }
  Xo := w div 2;
  Yo := h div 2;

  // Determine radius. If canvas is rectangular then r = shortest length w or h
  r := yo;

  if xo > yo then
    r := yo;

  if xo < yo then
    r := xo;

  //// Convert current time to integer values
  decodetime(Time, th, tm, ts, tn);

  //{ Set coordinates (length of arm) for seconds }
  Xs := Xo + Round(r * 0.78 * Sin(ts * 6 * Pi / 180));
  Ys := Yo - Round(r * 0.78 * Cos(ts * 6 * Pi / 180));

  //{ Set coordinates (length of arm) for minutes }
  Xm := Xo + Round(r * 0.68 * Sin(tm * 6 * Pi / 180));
  Ym := Yo - Round(r * 0.68 * Cos(tm * 6 * Pi / 180));

  //{ Set coordinates (length of arm) for hours }
  Xh := Xo + Round(r * 0.50 * Sin((th * 30 + tm / 2) * Pi / 180));
  Yh := Yo - Round(r * 0.50 * Cos((th * 30 + tm / 2) * Pi / 180));

  // Draw time hands
  img.DrawLineAntialias(xo, yo, xs, ys, BGRA(255, 0, 0), r * 0.02);
  img.DrawLineAntialias(xo, yo, xm, ym, BGRA(245, 245, 245), r * 0.03);
  img.DrawLineAntialias(xo, yo, xh, yh, BGRA(245, 245, 245), r * 0.07);
  img.DrawLineAntialias(xo, yo, xh, yh, BGRA(2, 94, 131), r * 0.04);

  // Draw Bitmap centre dot
  img.EllipseAntialias(Xo, Yo, r * 0.04, r * 0.04, BGRA(245, 245, 245, 255),
                       r * 0.02, BGRA(210, 210, 210, 255));

  MovingParts.Assign(img);

  img.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  CreateMovingParts;
  vsClock.RedrawBitmap;
end;

procedure TForm1.FormCreate(Sender : TObject);
begin
  ClockBody := TBGRABitmap.Create;
  MovingParts := TBGRABitmap.Create;
  CreateClockBody;
end;

procedure TForm1.FormClose(Sender : TObject; var CloseAction : TCloseAction);
begin
  ClockBody.Free;
  MovingParts.Free;
end;

procedure TForm1.FormResize(Sender : TObject);
begin
  CreateClockBody;
  CreateMovingParts;
end;

end.
Leave a Reply


+ five = 12