lasarus_compotents/bgrabitmap/test/testbgrafunc/utest16.pas

unit utest16;

{$mode objfpc}{$H+}

interface

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

type

  { TTest16 }

  TTest16 = class(TTest)
  private
    phong: TPhongShading;
    chartTime,lightTime: double;
    lightPos1: TPointF;
    RoundCorners : boolean;
    series: array of record
      val1,val2: integer;
    end;
    color1,color2: TBGRAPixel;
    procedure NewChart;
  public
    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 types;

{ TTest16 }

constructor TTest16.Create;
begin
  Name := 'Phong shading primitives';
  lightTime := 0;
  chartTime := 0;

  randomize;
  phong := TPhongShading.Create;
  NewChart;
end;

procedure TTest16.NewChart;
var
  i: Integer;

  procedure RandomSwap(var color: TBGRAPixel);
  var temp: byte;
  begin
    if random(2)= 0 then
    begin
      temp := color.Red;
      color.red := color.Green;
      color.green := temp;
    end;
    if random(2)= 0 then
    begin
      temp := color.green;
      color.green := color.blue;
      color.blue := temp;
    end;
  end;

begin
  setlength(series, 4+random(6));
  for i := 0 to high(series) do
  begin
    series[i].val1 := random(50);
    series[i].val2 := random(50);
  end;
  color1 := BGRA(255,160,0);
  RandomSwap(color1);
  color2 := BGRA(140,180,255);
  RandomSwap(Color2);
  RoundCorners := not RoundCorners;
end;

destructor TTest16.Destroy;
begin
  phong.Free;

  inherited Destroy;
end;

procedure TTest16.OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer);
var
  borderSize: integer;
  barPrecalc: TBGRABitmap;

  procedure DrawBar(image: TBGRABitmap; bounds: TRect; color : TBGRAPixel);
  begin
    if barPrecalc <> nil then
      phong.Draw(image,barPrecalc,borderSize,bounds.Left,bounds.Top,color)
    else
      phong.DrawRectangle(image,bounds,borderSize,borderSize,color,RoundCorners,[rmoNoBottomBorder]);
  end;

const
  chartTitle = 'Chart example';

var
  image: TBGRABitmap;
  i: integer;
  maxVal: integer;
  r: TRect;
  gbounds: TRect;
  s: TSize;

begin
  if lightTime = 0 then exit;
  barPrecalc := nil;

  //create background
  image := TBGRABitmap.Create(Width,Height);
  image.GradientFill(0,0,image.Width,image.Height,BGRA(255,255,255),BGRA(128,128,128),gtLinear,PointF(0,0),PointF(image.Width,Image.Height),dmSet);

  gbounds := rect(round(image.Width*0.1),round(image.Height*0.2),round(image.Width*0.9),round(image.Height*0.98));
  image.Rectangle(gbounds,BGRA(0,0,0,96),dmDrawWithTransparency);
  borderSize := round((gbounds.right-gbounds.left)/length(series)*0.06);
  if borderSize = 0 then borderSize := 1;

  //init phong
  phong.LightPosition := Point(round(lightPos1.X*Width),round(lightPos1.Y*Height));
  phong.LightPositionZ := 2*borderSize;

  //draw title
  image.FontHeight := gbounds.Top div 4;
  s := image.TextSize(chartTitle);
  phong.DrawSphere(image, rect((gbounds.Left+gbounds.Right-s.cx*2) div 2,(gbounds.Top-s.cy*2) div 2,
    (gbounds.Left+gbounds.Right+s.cx*2) div 2,(gbounds.Top+s.cy*2) div 2),10,BGRA(0,255,0,192));
  image.TextOut((gbounds.Left+gbounds.Right) div 2+1, (gbounds.Top-s.cy) div 2+1,ChartTitle,BGRABlack,taCenter);
  image.TextOut((gbounds.Left+gbounds.Right) div 2-1, (gbounds.Top-s.cy) div 2-1,ChartTitle,BGRAWhite,taCenter);

  //compute max value
  maxVal := 1;
  for i := 0 to high(series) do
  begin
    if series[i].val1 > maxVal then maxVal := series[i].Val1;
    if series[i].val2 > maxVal then maxVal := series[i].Val2;
  end;

  if RoundCorners then
    barPrecalc := CreateRoundRectangleMap(round((0.4-0.1)/length(series)*(gbounds.Right-gBounds.Left)),gBounds.Bottom-gBounds.Top,borderSize,[rmoNoBottomBorder])
  else
    barPrecalc := CreateRectangleMap(round((0.4-0.1)/length(series)*(gbounds.Right-gBounds.Left)),gBounds.Bottom-gBounds.Top,borderSize,[rmoNoBottomBorder]);
  image.ClipRect := gBounds;

  //draw bars
  for i := 0 to high(series) do
  begin
    r.Left := gbounds.Left+round((i+0.1)/length(series)*(gbounds.Right-gBounds.Left));
    r.Right := gbounds.Left+round((i+0.4)/length(series)*(gbounds.Right-gBounds.Left));
    r.top := gbounds.Top+round((gbounds.Bottom-gBounds.Top)*(1-series[i].val1/maxVal));
    r.bottom := gbounds.Bottom;
    DrawBar(image,r,color1);

    r.Left := gbounds.Left+round((i+0.43)/length(series)*(gbounds.Right-gBounds.Left));
    r.Right := gbounds.Left+round((i+0.73)/length(series)*(gbounds.Right-gBounds.Left));
    r.top := gbounds.Top+round((gbounds.Bottom-gBounds.Top)*(1-series[i].val2/maxVal));
    r.bottom := gbounds.Bottom;
    DrawBar(image,r,color2);
  end;

  image.NoClip;
  barPrecalc.Free;

  //draw chart
  image.Draw(Canvas,Left,Top,True);

  image.free;
end;

procedure TTest16.OnTimer(Width, Height: Integer;
  ElapsedSec: Double);
begin
  lightTime := lightTime+ElapsedSec*0.2;
  lightPos1 := pointF((sin(lightTime*0.7+1)+1)/2,(cos(lightTime*0.5+2)+1)/4-0.3);

  chartTime := chartTime+ElapsedSec;
  if chartTime > 10 then
  begin
    chartTime := chartTime-10;
    NewChart;
  end;
end;

end.