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