lasarus_compotents/bgrabitmap/test/testbgrafunc/utest25.pas

unit utest25;

{$mode objfpc}{$H+}

interface

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

type
  { TTest25 }

  TTest25 = class(TTest)
  private
    pacman,virtualScreen: TBGRABitmap;
    alphaFactor: byte;
    time: single;
    pts: array of TPoint;
  public
    constructor Create;
    destructor Destroy; override;
    procedure OnPaint(Canvas: TCanvas; Left,Top,Width,Height: Integer); override;
    procedure OnTimer(Width,Height: Integer; ElapsedSec: Double); override;
    procedure DrawOnCanvas(Canvas: TBGRACanvas);
  end;

implementation

uses BGRAGradientScanner;

{ TTest25 }

constructor TTest25.Create;
begin
  inherited Create;
  Name := 'BGRACanvas test (with aliasing on the left, with anti-aliasing on the right)';
  virtualScreen := nil;
  pacman := TBGRABitmap.Create(ResourceDir+'pac_d1.bmp');
  pacman.ReplaceColor(pacman.GetPixel(0,0),BGRAPixelTransparent);
  time := 0;
end;

destructor TTest25.Destroy;
begin
  virtualScreen.Free;
  pacman.free;
  inherited Destroy;
end;

procedure TTest25.OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer);
var
  i: Integer;
  tx: integer;
begin
  if time=0 then exit;

  tx := (Width+1) div 2;
  if (virtualscreen <> nil) and ((virtualscreen.width <> tx) or (virtualscreen.Height <> height)) then
    FreeAndNil(virtualScreen);

  if virtualscreen = nil then
  begin
    virtualscreen := TBGRABitmap.Create(tx,Height);
    //randseed := 1;
    setlength(pts, 20);
    for i := 0 to high(pts) do
      pts[i] := Point(Random(virtualScreen.Width),random(virtualScreen.Height));
  end;

  virtualScreen.CanvasBGRA.AntialiasingMode := amOff;
  virtualScreen.CanvasBGRA.Font.Quality := fqSystem;
  DrawOnCanvas(virtualScreen.CanvasBGRA);
  virtualscreen.Draw(Canvas,Left,Top,True);

  virtualScreen.CanvasBGRA.AntialiasingMode := amOn;
  virtualScreen.CanvasBGRA.Font.Quality := fqFineClearTypeRGB;
  DrawOnCanvas(virtualScreen.CanvasBGRA);
  virtualscreen.Draw(Canvas,Left+Width div 2,Top,True);
end;

procedure TTest25.OnTimer(Width, Height: Integer; ElapsedSec: Double);
begin
  time := time+ElapsedSec;
  alphaFactor := round((sin(time)+1)/2*255);
end;

procedure TTest25.DrawOnCanvas(Canvas: TBGRACanvas);
var i,k: integer;
    grad: TBGRAGradientScanner;
begin
  for k := 1 to 1 do
  begin
    grad := TBGRAGradientScanner.Create(BGRA(0,150,255),BGRA(0,0,0),gtLinear,PointF(0,0),PointF(0,Canvas.Height/40),True,True);
    With Canvas do
    begin
      Brush.style := bsSolid;
      Brush.Color := clWhite;
      Brush.Opacity := 255;
      FillRect(0,0,Width,Height);

      Font.Orientation := 0;
      Font.Color := clBlack;
      Font.Height := Height div 20;
      Font.Texture := grad;
      TextOut(Font.Height div 2,0,'Font rendering');

      Font.Orientation := -450;
      TextOut(Font.Height,Font.Height,'Text angle');

      pen.width := 2;
      pen.opacity := 255;
      Brush.Color := clGreen;
      brush.Style := bsSolid;
      pen.Style := psDash;
      Ellipse(pts[6].x,pts[6].y,pts[7].x,pts[7].y);

      pen.Style := psSolid;
      pen.width := 1;
      pen.opacity := 255;
      Brush.BGRAColor := BGRA(255,128,0);
      brush.style := bsFDiagonal;
      Ellipse(pts[14].x,pts[14].y,pts[15].x,pts[15].y);

      pen.style := psClear;
      pen.opacity := 64;
      Brush.Color := clBlue;
      Brush.Opacity := 128;
      brush.style := bsCross;
      Rectangle(pts[8].x,pts[8].y,pts[9].x,pts[9].y);

      pen.Style := psSolid;
      pen.width := 1;
      pen.opacity := 128;
      Brush.Color := clRed;
      Brush.Opacity := 64;
      brush.Style := bsSolid;
      RoundRect(pts[10].x,pts[10].y,pts[11].x,pts[11].y,abs(pts[11].x-pts[10].x) div 2,abs(pts[11].y-pts[10].y) div 2);

      brush.style := bsClear;
      pen.width := 2;
      RoundRect(pts[16].x,pts[16].y,pts[17].x,pts[17].y,abs(pts[17].x-pts[16].x) div 2,abs(pts[17].y-pts[16].y) div 2);

      pen.style := psClear;
      Brush.Color := clBlue;
      Brush.Opacity := 192;
      brush.style := bsSolid;
      //Polygon(pts);
      Pie(pts[12].x,pts[12].y,pts[13].x,pts[13].y,pts[6].x,pts[6].y,pts[7].x,pts[7].y);

      Pen.Color := clBlack;
      pen.style := psSolid;
      pen.opacity := 128;
      MoveTo(pts[0]);
      for i := 0 to 5 do
      begin
        Pen.Width := i+1;
        LineTo(pts[i+1]);
      end;

      Font.Texture := nil;
    end;
    Grad.Free;
  end;
end;

end.