lasarus_compotents/bgrabitmap/test/testbgrafunc/utest32.pas

unit utest32;

{$mode objfpc}

interface

uses
  Classes, SysUtils, utest, Graphics, BGRABitmap, BGRABitmapTypes;

type

  { TTest32 }

  TTest32 = class(TTest)
    virtualScreen,background: TBGRABitmap;
    position,speed,direction: single;

    constructor Create;
    destructor Destroy; override;
    procedure DrawRings(ABitmap: TBGRABitmap; APath: IBGRAPath; ACount: integer; ARadius: single);
    procedure OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer); override;
    procedure OnTimer(Width, Height: Integer; ElapsedSec: Double);
      override;
  end;

implementation

uses BGRAPath, BGRAVectorize, BGRAGradientScanner, BGRAUTF8;

{ TTest32 }

constructor TTest32.Create;
begin
  inherited Create;
  Name := 'Curved text';
  virtualScreen := nil;
  background := nil;
  position := 0;
  speed := 0;
  direction := 1;
end;

destructor TTest32.Destroy;
begin
  virtualscreen.free;
  background.free;
  inherited Destroy;
end;

procedure TTest32.DrawRings(ABitmap: TBGRABitmap;
  APath: IBGRAPath; ACount: integer; ARadius: single);
var
  step: single;
  cursor: TBGRACustomPathCursor;
begin
  cursor := APath.getCursor;
  step := cursor.PathLength/ACount;
  cursor.Position:= 0;
  repeat
    with cursor.CurrentCoordinate do
      ABitmap.FillEllipseAntialias(x,y, ARadius,ARadius, CSSDarkSlateBlue);
  until cursor.MoveForward(step) < 0.5*step;
  cursor.Free;
end;

procedure TTest32.OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer);
var path1: TBGRAPath;
    cursor1: TBGRAPathCursor;
    size: single;

  procedure PrepareBackground;
  var
    path2: TBGRAPath;
    gradient: TBGRAGradientScanner;
    fontRenderer: TBGRAVectorizedFontRenderer;
  begin
    background := TBGRABitmap.Create(Width,Height,CSSLightSteelBlue);
    fontRenderer := TBGRAVectorizedFontRenderer.Create;
    background.FontRenderer := fontRenderer;
    background.FontHeight := round(size*0.09);
    background.FontQuality := fqFineAntialiasing;

    DrawRings(background, path1, 20, size/150);

    path2 := TBGRAPath.Create;
    path2.arc(width/2,height/2,size*0.4, Pi, 0, true);

    fontRenderer.OutlineColor := BGRABlack;
    fontRenderer.OutlineWidth := size/600;
    fontRenderer.OutlineVisible := true;
    background.FontVerticalAnchor := fvaBaseline;

    gradient := TBGRAGradientScanner.Create(CSSYellow, CSSOrange, gtLinear, PointF(0,height/2), PointF(0,height/2+size*0.5));
    background.TextOutCurved(path2, ' Left ...', gradient, taLeftJustify, 0);
    background.TextOutCurved(path2, 'Middle', gradient, taCenter, 0);
    background.TextOutCurved(path2, '... Right ', gradient, taRightJustify, 0);
    gradient.free;

    fontRenderer.OutlineVisible := false;
    background.FontVerticalAnchor := fvaTop;

    path2.Free;
  end;

var
  fontRenderer: TBGRAVectorizedFontRenderer;

begin
  if (virtualscreen <> nil) and ((virtualscreen.width <> width) or (virtualscreen.Height <> height)) then
  begin
    FreeAndNil(virtualScreen);
    FreeAndNil(background);
  end;

  if width < height then size := width else size := height;
  path1 := TBGRAPath.Create;
  path1.arc(width/2,height/2,size*0.4, Pi, 0);

  if virtualscreen = nil then
  begin
    PrepareBackground;

    virtualscreen := TBGRABitmap.Create(Width,Height);
    fontRenderer := TBGRAVectorizedFontRenderer.Create;
    virtualScreen.FontRenderer := fontRenderer;
  end else
    fontRenderer := virtualScreen.FontRenderer as TBGRAVectorizedFontRenderer;

  virtualScreen.PutImage(0,0, background, dmSet);
  virtualScreen.FontHeight := background.FontHeight;
  virtualScreen.FontQuality := background.FontQuality;

  cursor1 := path1.CreateCursor;
  speed := size/4/cursor1.PathLength;
  if position < 0 then
  begin
    position := 0;
    direction := 1;
  end;
  cursor1.Position := position*cursor1.PathLength;
  virtualScreen.TextOutCurved(cursor1, 'Curved text '+UTF8_ARABIC_LAM+UTF8_ARABIC_ALEPH, BGRABlack, taLeftJustify, virtualScreen.FontFullHeight/8);
  if cursor1.Position = cursor1.PathLength then direction := -1;
  cursor1.Free;

  path1.Free;

  //draw virtualscreen opaque on canvas
  virtualscreen.Draw(Canvas,Left,Top,True);
end;

procedure TTest32.OnTimer(Width, Height: Integer;
  ElapsedSec: Double);
begin
  position += ElapsedSec*speed*direction;
end;

end.