1 unit utest26;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, utest, Graphics, BGRABitmap, BGRABitmapTypes;
9 
10 const
11   nbPoints = 9;
12 
13 type
14   { TTest26 }
15 
16   TTest26 = class(TTest)
17   protected
18     virtualScreen,backgroundTile: TBGRABitmap;
19     pts: array of TPointF;
20     dirs: array of TPointF;
21 
22   public
23     constructor Create;
24     destructor Destroy; override;
25     procedure OnPaint(Canvas: TCanvas; Left,Top,Width,Height: Integer); override;
26     procedure OnTimer(Width,Height: Integer; ElapsedSec: Double); override;
27   end;
28 
29 implementation
30 
31 { TTest26 }
32 
33 constructor TTest26.Create;
34 begin
35   inherited Create;
36   Name := 'Gradient shapes (antialiased or not)';
37   backgroundTile := TBGRABitmap.Create(ResourceDir+'diamondback.png');
38   randomize;
39   virtualScreen := nil;
40 end;
41 
42 destructor TTest26.Destroy;
43 begin
44   virtualScreen.Free;
45   backgroundTile.Free;
46   inherited Destroy;
47 end;
48 
49 procedure TTest26.OnPaint(Canvas: TCanvas; Left,Top,Width, Height: Integer);
50 begin
51   if pts = nil then exit;
52 
53   if (virtualscreen <> nil) and ((virtualscreen.width <> width) or (virtualscreen.Height <> height)) then
54     FreeAndNil(virtualScreen);
55 
56   if virtualscreen = nil then
57     virtualscreen := TBGRABitmap.Create(Width,Height);
58 
59   virtualScreen.Fill(backgroundTile);
60 
61   virtualScreen.FillQuadLinearColor(pts[3],pts[4],pts[5],pts[6],BGRA(0,192,0),BGRA(0,128,255),BGRA(255,128,0),BGRA(255,255,255));
62   virtualScreen.FillTriangleLinearColorAntialias(pts[0],pts[1],pts[2],BGRA(255,0,0),BGRA(255,255,0),BGRA(255,0,255));
63   virtualScreen.FillEllipseLinearColorAntialias(pts[7].x,pts[7].y,pts[8].x/4,pts[8].y/4,BGRABlack,BGRAWhite);
64 
65   virtualScreen.draw(Canvas,Left,Top);
66 end;
67 
68 procedure TTest26.OnTimer(Width, Height: Integer; ElapsedSec: Double);
69 var i: integer;
70     moveFactor: single;
71 begin
72   if pts = nil then
73   begin
74     setlength(pts,nbPoints);
75     setlength(dirs,nbPoints);
76     for i := 0 to NbPoints-1 do
77     begin
78       pts[i] := pointf(random(Width),random(Height));
79       dirs[i] := pointf((random(Width)-width/2)/20,(random(Height)-height/2)/20);
80     end;
81   end;
82   moveFactor := ElapsedSec*20;
83   for i := 0 to NbPoints-1 do
84   begin
85     pts[i].x := pts[i].x+dirs[i].x*moveFactor;
86     if pts[i].x < 0 then
87     begin
88       pts[i].x := 0;
89       dirs[i].x := abs(dirs[i].x);
90     end;
91     if pts[i].x > width-1 then
92     begin
93       pts[i].x := width-1;
94       dirs[i].x := -abs(dirs[i].x);
95     end;
96     pts[i].y := pts[i].y+dirs[i].y*moveFactor;
97     if pts[i].y < 0 then
98     begin
99       pts[i].y := 0;
100       dirs[i].y := abs(dirs[i].y);
101     end;
102     if pts[i].y > height-1 then
103     begin
104       pts[i].y := height-1;
105       dirs[i].y := -abs(dirs[i].y);
106     end;
107   end;
108 end;
109 
110 end.
111 
112