lasarus_compotents/bgrabitmap/test/testbgrafunc/utest31.pas

unit utest31;

{$mode objfpc}

interface

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

const
  nbPoints=3;

type

  { TTest31 }

  TTest31 = class(TTest)
    virtualScreen: TBGRABitmap;
    pts: array of TPointF;
    dirs: array of TPointF;
    hsla1,hsla2: THSLAPixel;

    textfx: TBGRATextEffect;
    phong: TPhongShading;
    wood: TBGRABitmap;

    textfx_multi: TBGRATextEffect;
    colorArray: array of TBGRAPixel;
    colorTime: double;

    textfx_lightpos: TBGRATextEffect;
    time: double;
    lightPos1: TPointF;

    constructor Create;
    destructor Destroy; override;
    procedure OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer); override;
    procedure OnTimer(Width, Height: Integer; ElapsedSec: Double);
      override;
  end;

implementation

uses utexture;

{ TTest31 }

constructor TTest31.Create;
begin
  inherited Create;
  Name := 'Gradient and text effect';
  virtualScreen := nil;
  hsla1.alpha := $ffff;
  hsla1.hue := 0;
  hsla1.lightness := $8000;
  hsla1.saturation := $C000;
  hsla2 := hsla1;
  hsla2.hue := $2000;

  phong := TPhongShading.Create;
  phong.LightPositionZ := 128;
  phong.SpecularIndex := 10;
  phong.SpecularFactor := 0.6;
  phong.LightSourceIntensity := 300;
  phong.AmbientFactor := 0.45;
  phong.NegativeDiffusionFactor := 0.3;

  setlength(colorArray,6);
  colorArray[0] := BGRA(255,128,128);
  colorArray[1] := BGRA(255,160,0);
  colorArray[2] := BGRA(255,255,0);
  colorArray[3] := BGRA(160,255,0);
  colorArray[4] := BGRA(0,255,160);
  colorArray[5] := BGRA(128,128,255);
end;

destructor TTest31.Destroy;
begin
  phong.free;
  textfx.Free;
  textfx_lightpos.Free;
  textfx_multi.Free;
  wood.free;
  virtualScreen.free;
  inherited Destroy;
end;

procedure TTest31.OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer);
var font: TFont; h, r: integer;
begin
  if pts = nil then exit;

  if (virtualscreen <> nil) and ((virtualscreen.width <> width) or (virtualscreen.Height <> height)) then
  begin
    FreeAndNil(virtualScreen);
    FreeAndNil(textfx);
    FreeAndNil(textfx_lightpos);
    FreeAndNil(textfx_multi);
    FreeAndNil(wood);
  end;

  if virtualscreen = nil then
    virtualscreen := TBGRABitmap.Create(Width,Height);

  if wood = nil then
  begin
    r := round(sqrt(Width*Height)/4);
    if r < 64 then r:= 64;
    wood := CreateWoodTexture(r,r);
  end;

  font := TFont.Create;
  font.Name := 'Arial';
  if textfx = nil then
  begin
    font.Bold := true;
    font.Height := Height div 4;
    textfx := TBGRATextEffect.Create('BGRA text effect',font,True);
    font.Bold := false;
  end;
  if textfx_lightpos = nil then
  begin
    font.Height := Height div 20;
    textfx_lightpos := TBGRATextEffect.Create('Light position',font,True);
  end;
  if textfx_multi = nil then
  begin
    font.Height := Height div 12;
    font.Name := 'Lucida Console';
    font.Bold := true;
    textfx_multi := TBGRATextEffect.Create('Multicolor',font,True);
  end;
  font.Free;

  virtualScreen.GradientFill(0,0,Width,Height,HSLAToBGRA(hsla1),HSLAToBGRA(hsla2),gtLinear,pts[0],pts[1],dmSet);

  phong.LightPositionF := PointF(lightPos1.x * Width, lightPos1.y * Height);
  h := round(textfx.Height *0.07);
  phong.LightPositionZ := h*4;
  textfx.DrawShaded(virtualScreen,Width div 2,Height div 2-textfx.Height div 2, phong, h,wood, taCenter, True);

  r := textfx_lightpos.height div 8;
  textfx_lightpos.DrawShadow(virtualScreen, phong.LightPosition.X+2*r,phong.LightPosition.Y+8+2*r,r,BGRABlack,taCenter);
  textfx_lightpos.DrawOutline(virtualScreen, phong.LightPosition.X,phong.LightPosition.Y+8,BGRABlack,taCenter);
  textfx_lightpos.Draw(virtualScreen, phong.LightPosition.X,phong.LightPosition.Y+8,BGRAWhite,taCenter);
  virtualscreen.FillEllipseLinearColorAntialias(phong.LightPosition.X,phong.LightPosition.Y,4,4,BGRABlack,BGRAWhite);

  textfx_multi.DrawShadow(virtualScreen, round(pts[2].x),round(pts[2].y), round(textfx_multi.Height/8), BGRA(255,255,255,255),taCenter);
  textfx_multi.DrawMulticolored(virtualScreen, round(pts[2].x),round(pts[2].y), colorArray,taCenter);

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

procedure TTest31.OnTimer(Width, Height: Integer;
  ElapsedSec: Double);
var i: integer;
    moveFactor: single;
    c,c2: TBGRAPixel;
begin
  if pts = nil then
  begin
    setlength(pts,nbPoints);
    setlength(dirs,nbPoints);
    for i := 0 to NbPoints-1 do
    begin
      pts[i] := pointf(random(Width),random(Height));
      dirs[i] := pointf((random(Width)-width/2)/20,(random(Height)-height/2)/20);
    end;
    dirs[2].x /= 10;
    dirs[2].y /= 10;
  end;
  moveFactor := ElapsedSec*20;
  for i := 0 to NbPoints-1 do
  begin
    pts[i].x := pts[i].x+dirs[i].x*moveFactor;
    if pts[i].x < 0 then
    begin
      pts[i].x := 0;
      dirs[i].x := abs(dirs[i].x);
    end;
    if pts[i].x > width-1 then
    begin
      pts[i].x := width-1;
      dirs[i].x := -abs(dirs[i].x);
    end;
    pts[i].y := pts[i].y+dirs[i].y*moveFactor;
    if pts[i].y < 0 then
    begin
      pts[i].y := 0;
      dirs[i].y := abs(dirs[i].y);
    end;
    if pts[i].y > height-1 then
    begin
      pts[i].y := height-1;
      dirs[i].y := -abs(dirs[i].y);
    end;
  end;
  inc(hsla1.hue, round(moveFactor*40) );
  inc(hsla2.hue, round(moveFactor*40) );

  time := time+ElapsedSec;
  lightPos1 := pointF((sin(time*0.7+1)+1)/4+0.4,(cos(time*0.5+2)+1)/4+0.3);

  colorTime += ElapsedSec;
  if colorTime > 0.3 then
  begin
    colorTime -= 0.3;
    c := colorArray[high(colorArray)];
    for i := 0 to high(colorArray) do
    begin
      c2 := colorArray[i];
      colorArray[i]:= c;
      c:= c2;
    end;
  end;
end;

end.