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.
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.
Entries (RSS)