Analog clock created using BGRABitmap

[digeo]

@picstart
I have updated the code to draw just the necessay graphics. on startup create clockface/frame and moving parts. on form resize clockbody is redrawn and on timer the moving bits is redrawn. On vsClockRedraw, images are blended together to speed up performance.

Can you try on Pi to check performance?

Code: [Select]

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.


[picstart]

@digeo
I used your clock code as an example to test BGRAcontrols in the raspberrypi. My own BGRA stuff is working on the pi with just a few minor tweaks mostly due to running an older version of the lazarus IDE on the pi. I decided to take your code as a further test and just see if it ported and it did except it ran to slow for the second hand's i sec tick. It was never my intention to ask you to speed it up. I just observed how often things can work fine on desktop multi giga hertz multiprocessor massive ram PC's but crawl on a raspberry pi for example. I wanted to emphasize that the future direction is toward android iphone phone and tablet devices so it could be useful if code is tested on less capacious platforms. Anyway you did take the time and congratulations it is working well on the raspberry pi. The second hand ticks once per sec on the pi. Thanks.

[digeo]

I am an electronics guy aswell and a fan of the Raspberry PI. It was also about "knowing" if it would run on the Pi. I am glad it does.

In any case, the code is better optimized now as it should be.

[clinique]

Really nice work. Has to be bundled in a component !

[CaptBill]

@digeo
I used your clock code as an example to test BGRAcontrols in the raspberrypi. My own BGRA stuff is working on the pi with just a few minor tweaks mostly due to running an older version of the lazarus IDE on the pi. I decided to take your code as a further test and just see if it ported and it did except it ran to slow for the second hand's i sec tick. It was never my intention to ask you to speed it up. I just observed how often things can work fine on desktop multi giga hertz multiprocessor massive ram PC's but crawl on a raspberry pi for example. I wanted to emphasize that the future direction is toward android iphone phone and tablet devices so it could be useful if code is tested on less capacious platforms. Anyway you did take the time and congratulations it is working well on the raspberry pi. The second hand ticks once per sec on the pi. Thanks.

Let's not forget that this clock is drawn totally from the ground up. This is showcasing the dynamic drawing capabilities, fully "rendering" a clock, which is cool.
But do realize, this is almost like a script in Gimp which paints with multiple filters/effect and on multiple layers, if it were able to do it all real-time. Which do you think would be faster Gimp or BGRABitmap?

I don't think there is any optimizing in order. Simply use LazPaint, render as much as possible on the design side, pack what you can into a .res file. Just limit the resizing to a smaller range, and scale the background. Only use dynamic drawing for the hands.

I think integrating LazPaint into the design side as a rendering tool is what will really set BGRAbitmap apart from anything out there.

[digeo]

@clinique

I actually was considering creating a component for the analog clock. I was thinking to add drop down boxes in the properties to select different themes/colors and sizes. Using the .res file will reduce the overhead and also make it possible for the user to create custom look.

[digeo]

I am in the process of creating a component for the analog clock. This is my first Lazarus component and are stuck at a point.

I am using a BGRAGraphicControl to draw the draw clock on. The problem I have is when I change settings in the object inspector, it does not automatically happen on the control. When I click on the form the changes happen. The same goes for when I run the app. When I show/hide the app, the changes occur.

I realize this is to do with the paint procedure and I am not sure how to fix this. I have tried invalidate and refresh but then app freezes as the custom control is stuck in paint procedure because of the update.

This what I have so far in a small demo using TGraphicControl:

Code: [Select]

  TCustomDemoControl = class(TGraphicControl)
  private
    FCaption: string;
    FDemoProperties: TDemoProperties;
    FBitmap: TBitmap;
    procedure SetCaption(AValue: string);
    procedure SetDemoProperties(AValue: TDemoProperties);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure DrawTest;
  published
    { Published declarations }
    property DemoProperties : TDemoProperties read FDemoProperties write SetDemoProperties;
    property Caption : string read FCaption write SetCaption;
  end;

// **************************************************************************//

procedure TCustomDemoControl.Paint;
begin
  if (csCreating in FControlState) then
    exit;

  DrawTest;

  inherited Paint;
end;

procedure TCustomDemoControl.DrawTest;
var
  x, y: integer;
begin
  if FDemoProperties.Enabled then
  begin
    // Initializes the Bitmap Size
    FBitmap.Height := Height;
    FBitmap.Width := Width;

    // Draws the background
    FBitmap.Canvas.Pen.Color := clWhite;
    FBitmap.Canvas.Rectangle(0, 0, Width, Height);

    // Draws squares
    FBitmap.Canvas.Pen.Color := FDemoProperties.Color;
    for x := 1 to 8 do
      for y := 1 to 8 do
        FBitmap.Canvas.Rectangle(Round((x - 1) * Width / 8), Round((y - 1) * Height / 8),
          Round(x * Width / 8), Round(y * Height / 8));

    Canvas.Draw(0, 0, FBitmap);
  end;
end;



[circular]

Hello digeo,

I don't know about this update issue, but there is an optimisation that you can do with phong shading. In fact, you only need the contour of the clock to be shaded. So instead of using TPhongShading.DrawSphere, the effect can be done by using CreateSpherePreciseMap, then you erase the middle with TBGRABitmap.EraseEllipseAntialias, and finally you draw it using TPhongShading.Draw.

[lainz]

I am in the process of creating a component for the analog clock. This is my first Lazarus component and are stuck at a point.

I am using a BGRAGraphicControl to draw the draw clock on. The problem I have is when I change settings in the object inspector, it does not automatically happen on the control. When I click on the form the changes happen. The same goes for when I run the app. When I show/hide the app, the changes occur.

I realize this is to do with the paint procedure and I am not sure how to fix this. I have tried invalidate and refresh but then app freezes as the custom control is stuck in paint procedure because of the update.

This what I have so far in a small demo using TGraphicControl:

Code: [Select]

  TCustomDemoControl = class(TGraphicControl)
  private
    FCaption: string;
    FDemoProperties: TDemoProperties;
    FBitmap: TBitmap;
    procedure SetCaption(AValue: string);
    procedure SetDemoProperties(AValue: TDemoProperties);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure DrawTest;
  published
    { Published declarations }
    property DemoProperties : TDemoProperties read FDemoProperties write SetDemoProperties;
    property Caption : string read FCaption write SetCaption;
  end;

// **************************************************************************//

procedure TCustomDemoControl.Paint;
begin
  if (csCreating in FControlState) then
    exit;

  DrawTest;

  inherited Paint;
end;

procedure TCustomDemoControl.DrawTest;
var
  x, y: integer;
begin
  if FDemoProperties.Enabled then
  begin
    // Initializes the Bitmap Size
    FBitmap.Height := Height;
    FBitmap.Width := Width;

    // Draws the background
    FBitmap.Canvas.Pen.Color := clWhite;
    FBitmap.Canvas.Rectangle(0, 0, Width, Height);

    // Draws squares
    FBitmap.Canvas.Pen.Color := FDemoProperties.Color;
    for x := 1 to 8 do
      for y := 1 to 8 do
        FBitmap.Canvas.Rectangle(Round((x - 1) * Width / 8), Round((y - 1) * Height / 8),
          Round(x * Width / 8), Round(y * Height / 8));

    Canvas.Draw(0, 0, FBitmap);
  end;
end;



You need to use TBCGraphicControl, there are a lot of examples (BCButton, BCImageButton)..

Then:

Code: [Select]

    procedure Paint; override; // do not override in descendants!
    // All descendants should use DrawControl method instead of Paint.
    // DrawControl is not called between BeginUpdate and EndUpdate
    procedure DrawControl; virtual;
    // This method is called when control should be rendered (when some
    // general action occur which change "body" e.g. resize)
    procedure RenderControl; virtual; 
Override RenderControl and DrawControl.

And call RenderControl and DrawControl when you change a property.

[digeo]

I have created my first iteration of analog gauge and clock components. I have created a package that includes the source and simple demo.

The colors are inspired by the solarized (http://ethanschoonover.com/solarized) IDE theme.

Future improvements are different types (right angle, etc) of gauge and range indicators. I also want to add a clock and gauge type that uses a bitmap for a background then only the indicators has to be rendered. This will greatly improve performance and customization.

The package still needs some cleaning up as there is still some code that's not needed and I am sure there will be bugs.

[circular]

It looks nice. I appreciate the round caps here.