1 unit Unit1;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Spin,
9   ExtCtrls, StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,
10   BGRACanvas2D;
11 
12 const
13   timeGrain = 15/1000/60/60/24;
14 
15 type
16 
17   { TForm1 }
18 
19   TForm1 = class(TForm)
20     Button_toDataURL: TButton;
21     CheckBox_Antialiasing: TCheckBox;
22     CheckBox_PixelCentered: TCheckBox;
23     Panel1: TPanel;
24     SaveDialog1: TSaveDialog;
25     SpinEdit1: TSpinEdit;
26     VirtualScreen: TBGRAVirtualScreen;
27     Timer1: TTimer;
28     procedure Button_toDataURLClick(Sender: TObject);
29     procedure CheckBox_AntialiasingChange(Sender: TObject);
30     procedure CheckBox_PixelCenteredChange(Sender: TObject);
31     procedure FormCreate(Sender: TObject);
32     procedure FormDestroy(Sender: TObject);
33     procedure FormMouseLeave(Sender: TObject);
34     procedure FormMouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
35     procedure FormPaint(Sender: TObject);
36     procedure SpinEdit1Change(Sender: TObject);
37     procedure Timer1Timer(Sender: TObject);
38     procedure VirtualScreenMouseLeave(Sender: TObject);
39     procedure VirtualScreenMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
40       Y: Integer);
41     procedure VirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
42   private
43     { private declarations }
44     mx,my: integer;
45     lastTime: TDateTime;
46     timeGrainAcc: double;
47     test4pos, test5pos, Test13pos, test16pos, test17pos, test18pos, test19pos, test23pos: integer;
48     img,abelias: TBGRABitmap;
49     procedure UpdateIn(ms: integer);
50     procedure UseVectorizedFont(ctx: TBGRACanvas2D; AUse: boolean);
51   public
52     { public declarations }
53     procedure Test1(ctx: TBGRACanvas2D);
54     procedure Test2(ctx: TBGRACanvas2D);
55     procedure Test3(ctx: TBGRACanvas2D);
56     procedure Test4(ctx: TBGRACanvas2D; grainElapse: integer);
57     procedure Test5(ctx: TBGRACanvas2D; grainElapse: integer);
58     procedure Test6(ctx: TBGRACanvas2D);
59     procedure Test7(ctx: TBGRACanvas2D);
60     procedure Test8(ctx: TBGRACanvas2D);
61     procedure Test9(ctx: TBGRACanvas2D);
62     procedure Test10(ctx: TBGRACanvas2D);
63     procedure Test11(ctx: TBGRACanvas2D);
64     procedure Test12(ctx: TBGRACanvas2D);
65     procedure Test13(ctx: TBGRACanvas2D);
66     procedure Test14(ctx: TBGRACanvas2D);
67     procedure Test15(ctx: TBGRACanvas2D);
68     procedure Test16(ctx: TBGRACanvas2D; grainElapse: integer);
69     procedure Test17(ctx: TBGRACanvas2D; grainElapse: integer);
70     procedure Test18(ctx: TBGRACanvas2D; grainElapse: integer);
71     procedure Test19(ctx: TBGRACanvas2D; grainElapse: integer);
72     procedure Test20(ctx: TBGRACanvas2D; AVectorizedFont: boolean);
73     procedure Test22(ctx: TBGRACanvas2D);
74     procedure Test23(ctx: TBGRACanvas2D; grainElapse: integer);
75   end;
76 
77 var
78   Form1: TForm1;
79 
80 implementation
81 
82 uses BGRAGradientScanner, Math, BGRASVG, BGRAVectorize;
83 
84 {$R *.lfm}
85 
86 { TForm1 }
87 
88 procedure TForm1.FormPaint(Sender: TObject);
89 begin
90 end;
91 
92 procedure TForm1.FormCreate(Sender: TObject);
93 begin
94   img := TBGRABitmap.Create(ExtractFilePath(Application.ExeName)+'pteRaz.jpg');
95   abelias := TBGRABitmap.Create(ExtractFilePath(Application.ExeName)+'abelias.png');
96   mx := -1000;
97   my := -1000;
98   lastTime := Now;
99 end;
100 
101 procedure TForm1.CheckBox_PixelCenteredChange(Sender: TObject);
102 begin
103   VirtualScreen.DiscardBitmap;
104 end;
105 
106 procedure TForm1.Button_toDataURLClick(Sender: TObject);
107 var html: string;
108     t: textfile;
109 begin
110   if SaveDialog1.Execute then
111   begin
112     html := '<html><body><img src="';
113     html += VirtualScreen.Bitmap.Canvas2D.toDataURL;
114     html += '"/></body></html>';
115     assignfile(t,SaveDialog1.FileName);
116     rewrite(t);
117     write(t,html);
118     closefile(t);
119     MessageDlg('toDataURL','Output: '+ SaveDialog1.FileName,mtInformation,[mbOK],0);
120   end;
121 end;
122 
123 procedure TForm1.CheckBox_AntialiasingChange(Sender: TObject);
124 begin
125   VirtualScreen.DiscardBitmap;
126 end;
127 
128 procedure TForm1.FormDestroy(Sender: TObject);
129 begin
130   img.Free;
131   abelias.free;
132 end;
133 
134 procedure TForm1.FormMouseLeave(Sender: TObject);
135 begin
136 
137 end;
138 
139 procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
140   Y: Integer);
141 begin
142 
143 end;
144 
145 procedure TForm1.SpinEdit1Change(Sender: TObject);
146 begin
147   VirtualScreen.DiscardBitmap;
148 end;
149 
150 procedure TForm1.Timer1Timer(Sender: TObject);
151 begin
152   Timer1.Enabled := false;
153   VirtualScreen.DiscardBitmap;
154 end;
155 
156 procedure TForm1.VirtualScreenMouseLeave(Sender: TObject);
157 begin
158   mx := -1000;
159   my := -1000;
160 end;
161 
162 procedure TForm1.VirtualScreenMouseMove(Sender: TObject; Shift: TShiftState; X,
163   Y: Integer);
164 begin
165   mx := X;
166   my := Y;
167   if (SpinEdit1.Value = 1) and not Timer1.Enabled then UpdateIn(10);
168 end;
169 
170 procedure TForm1.VirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
171 var ctx: TBGRACanvas2D;
172   grainElapse: integer;
173   newTime: TDateTime;
174 begin
175   newTime := Now;
176   timeGrainAcc += (newTime - lastTime)/timeGrain;
177   lastTime := newTime;
178   if timeGrainAcc < 1 then timeGrainAcc := 1;
179   if timeGrainAcc > 50 then timeGrainAcc := 50;
180   grainElapse := trunc(timeGrainAcc);
181   timeGrainAcc -= grainElapse;
182 
183   ctx := Bitmap.Canvas2D;
184   ctx.antialiasing := CheckBox_Antialiasing.Checked;
185   ctx.pixelCenteredCoordinates := CheckBox_PixelCentered.Checked;
186   ctx.save;
187   case SpinEdit1.Value of
188     1: Test1(ctx);
189     2: Test2(ctx);
190     3: Test3(ctx);
191     4: Test4(ctx, grainElapse);
192     5: Test5(ctx, grainElapse);
193     6: Test6(ctx);
194     7: Test7(ctx);
195     8: Test8(ctx);
196     9: Test9(ctx);
197    10: Test10(ctx);
198    11: Test11(ctx);
199    12: Test12(ctx);
200    13: Test13(ctx);
201    14: Test14(ctx);
202    15: Test15(ctx);
203    16: Test16(ctx, grainElapse);
204    17: Test17(ctx, grainElapse);
205    18: Test18(ctx, grainElapse);
206    19: Test19(ctx, grainElapse);
207    20: Test20(ctx,false);
208    21: Test20(ctx,true);
209    22: Test22(ctx);
210    23: Test23(ctx,grainElapse);
211   end;
212   ctx.restore;
213 end;
214 
215 procedure TForm1.UpdateIn(ms: integer);
216 begin
217   Timer1.Interval := ms;
218   Timer1.Enabled := false;
219   Timer1.Enabled := true;
220 end;
221 
222 procedure TForm1.UseVectorizedFont(ctx: TBGRACanvas2D; AUse: boolean);
223 begin
224   if AUse and not (ctx.fontRenderer is TBGRAVectorizedFontRenderer) then
225     ctx.fontRenderer := TBGRAVectorizedFontRenderer.Create;
226   if not AUse and (ctx.fontRenderer is TBGRAVectorizedFontRenderer) then
227     ctx.fontRenderer := nil;
228 end;
229 
230 procedure TForm1.Test1(ctx: TBGRACanvas2D);
231 
232   procedure DrawShape(colors: TBGRACustomGradient);
233   begin
234     ctx.fillStyle('rgb(1000,1000,1000)');  //out of bounds so it is saturated to 255,255,255
235     ctx.fillRect (0, 0, ctx.Width, ctx.Height);
236     ctx.fillStyle(ctx.createLinearGradient(0,0,20,0,colors));
237     ctx.shadowOffset := PointF(10,10);
238     ctx.shadowColor('rgba(0,0,0,0.5)');
239     ctx.shadowBlur := 4;
240     ctx.fillRect (mx-100, my-100, 200, 200);
241   end;
242 
243 var
244   colors: TBGRACustomGradient;
245 
246 
247 begin
248   if (mx < 0) or (my < 0) then
249   begin
250     mx := ctx.Width div 2;
251     my := ctx.height div 2;
252   end;
253 
254   ctx.save;
255   ctx.beginPath;
256   ctx.moveTo(0,0);
257   ctx.lineTo(ctx.Width,0);
258   ctx.lineTo(0,ctx.Height);
259   ctx.clip;
260   colors := TBGRAMultiGradient.Create([BGRA(0,255,0),BGRA(0,192,128),BGRA(0,255,0)],[0,0.5,1],True,True);
261   DrawShape(colors);
262   colors.Free;
263   ctx.restore;
264 
265   ctx.save;
266   ctx.beginPath;
267   ctx.moveTo(ctx.Width,ctx.Height);
268   ctx.lineTo(0,ctx.Height);
269   ctx.lineTo(ctx.Width,0);
270   ctx.clip;
271   colors := TBGRAMultiGradient.Create([BGRA(0,255,255),BGRA(0,192,128),BGRA(0,255,255)],[0,0.5,1],True,True);
272   DrawShape(colors);
273   colors.Free;
274   ctx.restore;
275 end;
276 
277 procedure TForm1.Test2(ctx: TBGRACanvas2D);
278 var layer: TBGRABitmap;
279 begin
280   layer := TBGRABitmap.Create(ctx.width,ctx.height);
281   with layer.Canvas2D do
282   begin
283     pixelCenteredCoordinates:= ctx.pixelCenteredCoordinates;
284     antialiasing:= ctx.antialiasing;
285 
286     fillStyle('rgb(1000,0,0)'); // fond de couleur rouge
287     beginPath;
288     roundRect(25,25,Width-50,Height-50,25); // remplissage d un carré 250x250
289     fill;
290 
291     clearRect(Width-mx-25,Height-my-25,50,50); // effacement d un carré
292 
293     beginPath;
294     arc(mx,my,30,0,2*Pi);
295     clearPath;
296 
297     strokeStyle ('rgb(0,0,1000)'); // contour de couleur bleue
298     strokeRect(100,100,20,20); // contour d un carré
299 
300     shadowOffset := PointF(3,3);
301     shadowColor('rgba(0,0,0,0.5)');
302     shadowBlur := 4;
303 
304     beginPath;
305     lineWidth := 3;
306     moveTo(20,160);
307     lineTo(200,160);
308     lineStyle([3,1]);
309     stroke;
310 
311     beginPath;
312     moveTo(20,180);
313     lineTo(220,180);
314     lineTo(240,160);
315     lineStyle([1,1,2,2]);
316     stroke;
317   end;
318   ctx.surface.PutImage(0,0,layer,dmDrawWithTransparency);
319   layer.Free;
320   UpdateIn(10);
321 end;
322 
323 procedure TForm1.Test3(ctx: TBGRACanvas2D);
324 begin
325   ctx.fillStyle ('rgb(1000,1000,1000)');
326   ctx.fillRect (0, 0, ctx.width, ctx.height);
327   // Triangle plein sans bordure
328   ctx.beginPath();
329   ctx.moveTo(100,100);
330   ctx.lineTo(150,30);
331   ctx.lineTo(230,150);
332   ctx.closePath();
333   if ctx.isPointInPath(mx+0.5,my+0.5) then
334     ctx.fillStyle ('rgb(1000,192,192)')
335   else
336     ctx.fillStyle ('rgb(1000,0,0)');
337   ctx.fill();
338   // Triangle plein avec bordure
339   ctx.fillStyle ('rgb(0,1000,0)');
340   ctx.strokeStyle ('rgb(0,0,1000)');
341   ctx.lineWidth := 8;
342   ctx.beginPath();
343   ctx.moveTo(50,100);
344   ctx.lineTo(50,220);
345   ctx.lineTo(210,200);
346   ctx.closePath();
347   if ctx.isPointInPath(mx+0.5,my+0.5) then
348     ctx.fillStyle ('rgb(192,1000,192)')
349   else
350     ctx.fillStyle ('rgb(0,1000,0)');
351   ctx.fill();
352   ctx.stroke();
353   // Triangle plein avec bordure
354   UpdateIn(50);
355 end;
356 
357 procedure TForm1.Test4(ctx: TBGRACanvas2D; grainElapse: integer);
358 var angle: single;
359     p0,p1,p2: TPointF;
360 begin
361   inc(test4pos, grainElapse);
362   angle := test4pos*2*Pi/400;
363   ctx.translate((ctx.Width-300)/2,(ctx.height-300)/2);
364   ctx.skewx( sin(angle) );
365 
366   ctx.beginPath;
367   ctx.rect (0, 0, 300, 300);
368   ctx.fillStyle (CSSYellow);
369   ctx.strokeStyle(CSSRed);
370   ctx.lineWidth := 5;
371   ctx.strokeOverFill;
372 
373   ctx.beginPath();
374   // coord. centre 150,150  rayon : 50 angle départ 0 fin 2Pi, sens
375   ctx.arc(150,150,50,0,PI*2,true); // Cercle
376   ctx.moveTo(100,150); // aller au pt de départ de l arc
377   ctx.arc(100,100,50,PI/2,PI,false); // Arc sens aig. montre
378   ctx.moveTo(150,150); // aller au pt de départ de l arc
379   ctx.arc(200,150,50,2*PI/2,0,false);  // Autre cercle
380   ctx.lineWidth := 1;
381   ctx.strokeStyle(BGRABlack);
382   ctx.stroke();
383 
384   ctx.lineJoin := 'round';
385 
386   angle := test4pos*2*Pi/180;
387   p0 := PointF(150,50);
388   p1 := pointF(150+50,50);
389   p2 := pointF(150+50+cos(sin(angle)*Pi/2)*40,50+sin(sin(angle)*Pi/2)*40);
390   ctx.beginPath;
391   ctx.moveTo(p0);
392   ctx.arcTo(p1, p2, 30);
393   ctx.lineTo(p2);
394   ctx.lineWidth := 5;
395   ctx.strokeStyle( BGRA(240,170,0) );
396   ctx.stroke();
397 
398   ctx.beginPath;
399   ctx.moveTo(p0);
400   ctx.lineTo(p1);
401   ctx.lineTo(p2);
402   ctx.strokeStyle( BGRA(0,0,255) );
403   ctx.lineWidth := 2;
404   ctx.stroke();
405 
406   UpdateIn(10);
407 end;
408 
409 procedure TForm1.Test5(ctx: TBGRACanvas2D; grainElapse: integer);
410 var svg: TBGRASVG;
411 begin
412   inc(test5pos, grainElapse);
413 
414   svg := TBGRASVG.Create;
415   svg.LoadFromFile(ExtractFilePath(Application.ExeName)+'Amsterdammertje-icoon.svg');
416   svg.StretchDraw(ctx, taCenter,tlCenter, 0,0,ctx.Width/3,ctx.Height);
417 
418   svg.LoadFromFile(ExtractFilePath(Application.ExeName)+'BespectacledMaleUser.svg');
419   svg.StretchDraw(ctx, ctx.Width/3,0,ctx.Width*2/3,ctx.Height/2);
420 
421   ctx.save;
422   ctx.beginPath;
423   ctx.rect(ctx.Width/3,ctx.Height/2,ctx.Width*2/3,ctx.Height/2);
424   ctx.clip;
425   svg.LoadFromFile(ExtractFilePath(Application.ExeName)+'Blue_gyroelongated_pentagonal_pyramid.svg');
426   svg.Draw(ctx, taCenter,tlCenter, ctx.Width*2/3,ctx.Height*3/4);
427   ctx.restore;
428 
429   svg.Free;
430 
431   ctx.beginPath;
432   ctx.lineWidth:= 1;
433   ctx.strokeStyle(BGRABlack);
434   ctx.moveTo(ctx.Width/3,0);
435   ctx.lineTo(ctx.Width/3,ctx.Height);
436   ctx.moveTo(ctx.Width/3,ctx.Height/2);
437   ctx.lineTo(ctx.Width,ctx.Height/2);
438   ctx.stroke;
439 
440   UpdateIn(20);
441 end;
442 
443 procedure TForm1.Test6(ctx: TBGRACanvas2D);
444 begin
445   ctx.fillStyle ('rgb(1000,1000,1000)');
446   ctx.fillRect (0, 0, 300, 300);
447 // Exemple de courbes de Bézier
448   ctx.fillStyle ( 'yellow');
449   ctx.lineWidth := 15;
450   ctx.lineCap := 'round'; // round butt square
451   ctx.lineJoin := 'miter'; // round miter bevel
452   ctx.strokeStyle ('rgb(200,200,1000)');
453   ctx.beginPath();
454   ctx.moveTo(50,150);
455   ctx.bezierCurveTo(50,80,100,60,130,60);
456   ctx.bezierCurveTo(180,60,250,50,260,130);
457   ctx.bezierCurveTo(150,150,150,150,120,280);
458   ctx.bezierCurveTo(50,250,100,200,50,150);
459   ctx.fill();
460   ctx.stroke();
461 end;
462 
463 procedure TForm1.Test7(ctx: TBGRACanvas2D);
464 var
465   i: Integer;
466 begin
467   ctx.fillStyle('black');
468   ctx.fillRect(0, 0, 300, 300);
469   // Dessin du fond
470   ctx.fillStyle ('red');
471   ctx.fillRect(0, 0, 150, 150);
472   ctx.fillStyle ('blue');
473   ctx.fillRect(150, 0, 150, 150);
474   ctx.fillStyle ('yellow');
475   ctx.fillRect(0, 150, 150, 150);
476   ctx.fillStyle ('green');
477   ctx.fillRect(150, 150, 150, 150);
478   ctx.fillStyle ('#FFF');
479   // Définition de la valeur de transparence
480   ctx.globalAlpha := 0.1;
481   // Dessin de carrés semi transparents
482   for i := 0 to 9 do
483   begin
484       ctx.beginPath();
485       ctx.fillRect(10*i, 10*i, 300-20*i, 300-20*i);
486       ctx.fill();
487   end;
488 end;
489 
490 procedure TForm1.Test8(ctx: TBGRACanvas2D);
491 begin
492   ctx.drawImage(img, 0, 0);
493   ctx.globalAlpha:= 0.5;
494   ctx.drawImage(img, 100, 100);
495   ctx.globalAlpha := 0.9;
496   ctx.translate(100,100);
497   ctx.beginPath;
498   ctx.moveTo(50,50);
499   ctx.lineTo(300,50);
500   ctx.lineTo(500,200);
501   ctx.lineTo(50,200);
502   ctx.fillStyle(img);
503   ctx.fill;
504 end;
505 
506 procedure TForm1.Test9(ctx: TBGRACanvas2D);
507 var
508   i: Integer;
509   j: Integer;
510 begin
511   ctx.translate(ctx.Width/2 -15*10, ctx.Height/2 -15*10);
512   ctx.strokeStyle ('#000');
513   ctx.lineWidth :=4;
514   for i := 0 to 14 do
515     for j := 0 to 14 do
516     begin
517       ctx.fillStyle (BGRA ( 255-18*i, 255-18*j, 0) );
518       ctx.strokeStyle (BGRA( 20+10*j, 20+8*i, 0) );
519       ctx.fillRect(j*20, i*20, 20, 20);
520       ctx.strokeRect(j*20, i*20, 20, 20)
521     end;
522 end;
523 
524 procedure TForm1.Test10(ctx: TBGRACanvas2D);
525 var
526   i: Integer;
527   j: Integer;
528 begin
529   ctx.translate(ctx.Width/2, ctx.Height/2);  // centre 0 0 maintenant en position centrale
530   for i := 1 to 9 do
531   begin
532     ctx.save(); // contrebalancé par un restore
533     ctx.fillStyle ( BGRA(25*i,255-25*i,255) );
534     for j := 0 to i*5 do
535     begin
536       ctx.rotate(PI*2/(1+i*5)); //
537       ctx.beginPath();
538       ctx.arc(0, i*16, 6, 0, PI*2, true);
539       ctx.fill();
540     end;
541     ctx.restore();
542   end;
543 end;
544 
545 procedure TForm1.Test11(ctx: TBGRACanvas2D);
546 const sc=20;  // nb de pixels pour une unité
547 
548 var
549   H: LongInt;
550   W: LongInt;
551   i: Integer;
552   x,u: Single;
553 
fnull554   function f(x: single): single; // fonction à tracer
555   begin
556     result := 3*sin(x)*(cos(x)+1/2*cos(x/2)+1/3*cos(x/3)+1/4*cos(x/4));
557   end;
558 begin
559   H := ctx.height;
560   W := ctx.width;
561    // tracé du quadrillage
562    ctx.strokeStyle ('#666');
563    ctx.beginPath();
564    ctx.lineWidth:=0.5;
565    // lignes horizontales
566    for i := -trunc(H/2/sc) to trunc(H/2/sc) do
567    begin
568      ctx.moveTo(0, H/2-sc*i);
569      ctx.lineTo(W, H/2-sc*i);
570    end;
571    // lignes verticales
572    for i := 0 to trunc(W/sc) do
573    begin
574      ctx.moveTo(sc*i,H-0);
575      ctx.lineTo(sc*i, H-H);
576    end;
577    ctx.stroke();
578    // tracé de la fonction
579      ctx.strokeStyle ('#ff0000');
580      ctx.lineWidth:=1.5;
581      ctx.beginPath();
582      x:=0;
583      u:=f(x);
584      ctx.moveTo(0, H/2-u*sc);
585      while x < W/sc do
586      begin
587        u := f(x);
588        ctx.lineTo(x*sc, H/2-u*sc);
589        x += 1/sc;
590      end;
591    ctx.stroke();
592 end;
593 
594 procedure TForm1.Test12(ctx: TBGRACanvas2D);
595 var
596   W: LongInt;
597   H: LongInt;
598   i: Integer;
599   j: Integer;
600 
colornull601   function color(): TBGRAPixel;
602   begin
603     result := BGRA(random(256),random(256),random(256));
604   end;
605 
606   procedure drawSpirograph(R2: single; r: single; O: single);
607   var
608     x0,x1,x2: single;
609     y0,y1,y2: single;
610     i: integer;
611   begin
612     x0 := R2-O;
613     y0 := 0;
614     i  := 1;
615     ctx.beginPath();
616     x1 := x0;
617     y1 := y0;
618     ctx.moveTo(x1, y1);
619     repeat
620       if (i > 1000) then break;
621       x2 := (R2+r)*cos(i*PI/72) - (r+O)*cos(((R2+r)/r)*(i*PI/72));
622       y2 := (R2+r)*sin(i*PI/72) - (r+O)*sin(((R2+r)/r)*(i*PI/72));
623       ctx.lineTo(x2, y2);
624       x1 := x2;
625       y1 := y2;
626       inc(i);
627     until (abs(x2-x0) < 1e-6) and (abs(y2-y0) < 1e-6);
628     ctx.stroke();
629   end;
630 
631 begin
632   W := ctx.width;
633   H := ctx.height;
634   ctx.fillRect(0, 0, W, H);
635   for i := 0 to 1 do
636     for j := 0 to 2 do
637     begin
638       ctx.save();
639       ctx.strokeStyle ( color() );
640       ctx.translate(110+j*200, 100+i*160);
641       drawSpirograph(40*(j+2)/(j+1), -(3+random(11))*(i+3)/(i+1), 35);
642       ctx.restore();
643     end;
644 
645   UpdateIn(3000);
646 end;
647 
648 procedure TForm1.Test13(ctx: TBGRACanvas2D);
649 const vitesse = 1;
650 begin
651   ctx.fillStyle ('#000');
652   ctx.fillRect (0, 0, 800, 400);
653   ctx.clearRect(0, 0, 800, 400);
654   ctx.fillRect (0, 0, 800, 400);
655   ctx.setTransform(-0.55, 0.85, -1, 0.10, 100, 50+img.width*0.5);
656   ctx.rotate(PI*2*(Test13pos/360)*vitesse );
657   ctx.drawImage(img, img.width*(-0.5)-200, img.height*(-0.8));
658   inc(Test13pos);
659   if (Test13pos=360) then Test13pos := 0;
660   UpdateIn(10);
661 end;
662 
663 procedure TForm1.Test14(ctx: TBGRACanvas2D);
664   procedure pave();
665   begin
666     ctx.save();
667     ctx.fillStyle ('rgb(130,100,800)');
668     ctx.strokeStyle ('rgb(0,0,300)');
669     ctx.beginPath();
670     ctx.lineWidth:=2;
671     ctx.moveTo(5,5);ctx.lineTo(20,10);ctx.lineTo(55,5);ctx.lineTo(45,18);ctx.lineTo(30,50);
672     ctx.closePath();
673     ctx.stroke();
674     ctx.fill();
675     ctx.fillStyle ('rgb(300,300,100)');
676     ctx.lineWidth:=5;
677     ctx.strokeStyle ('rgb(0,300,0)');
678     ctx.beginPath();
679     ctx.moveTo(20,18);ctx.lineTo(40,16);ctx.lineTo(35,26); ctx.lineTo(25,30);
680     ctx.closePath();
681     ctx.stroke();
682     ctx.fill();
683     ctx.restore();
684   end;
685   // dessins d un hexagone à partir de six pavés par rotation
686   procedure six();
687   var
688     i: Integer;
689   begin
690      ctx.save();
691      for i := 0 to 5 do
692      begin
693         ctx.rotate(2*PI/6);
694         pave();
695      end;
696      ctx.restore();
697   end;
698   // pavage utilisant des translations selon deux vecteurs non colinéaires
699   // 0,60*Math.sqrt(3)     et     60*3/2, 60*Math.sqrt(3)/2
700   procedure draw();
701   var
702     i: Integer;
703     j: Integer;
704   begin
705       ctx.fillStyle ('rgb(800,100,50)');
706       ctx.fillRect (0, 0, ctx.Width, ctx.Height);
707       for j := 0 to (ctx.Width+60) div 90 do
708       begin
709         ctx.save();
710         ctx.translate(0,(-j div 2)*60*sqrt(3));
711         for i := 0 to round(ctx.Height / (60*sqrt(3))) do
712         begin
713           six();
714           ctx.translate(0,60*sqrt(3));
715         end;
716 
717         ctx.restore();
718         ctx.translate(90, sqrt(3)*60/2);
719       end;
720   end;
721 
722 begin
723   draw();
724 end;
725 
726 procedure TForm1.Test15(ctx: TBGRACanvas2D);
727 const cote = 190;
728 
729   procedure pave();
730   begin
731     ctx.drawImage(abelias,0,0);
732   end;
733 
734   procedure refl();
735   begin
736      ctx.save();
737      pave();
738      ctx.transform(1,0,0,-1, 0, 0);
739      pave();
740      ctx.restore();
741   end;
742 
743   // dessins d un hexagone à partir de six pavés par rotation
744   procedure trois();
745   var
746     i: Integer;
747   begin
748      ctx.save();
749      for i := 0 to 2 do
750      begin
751         ctx.rotate(4*PI/6);
752         refl();
753      end;
754      ctx.restore();
755   end;
756 
757   // pavage utilisant des translations selon deux vecteurs non colinéaires
758   // 0,cote*Math.sqrt(3)     et     cote*3/2, cote*Math.sqrt(3)/2
759   procedure draw();
760   var
761     i: Integer;
762     j: Integer;
763   begin
764     ctx.fillStyle ('#330055');
765     ctx.fillRect (0, 0, ctx.width, ctx.height);
766     ctx.translate(140,140);
767     for j := 0 to trunc(ctx.Width /(cote*3/2)) do
768     begin
769       ctx.save();
770       ctx.translate(0,-(1/2 + j div 2)*cote*sqrt(3));
771       for i := 0 to trunc(ctx.Height / (cote*sqrt(3)))+1 do
772       begin
773         trois();
774         ctx.translate(0,cote*sqrt(3));
775       end;
776       ctx.restore();
777       ctx.translate(cote*3/2, sqrt(3)*cote/2);
778     end;
779   end;
780 
781 begin
782   draw();
783 end;
784 
785 procedure TForm1.Test16(ctx: TBGRACanvas2D; grainElapse: integer);
786 var center: TPointF;
787     angle,zoom: single;
788 begin
789   inc(test16pos, grainElapse);
790   center := pointf(ctx.width/2,ctx.height/2);
791   angle := test16pos*2*Pi/300;
792   zoom := (sin(test16pos*2*Pi/400)+1.1)*min(ctx.width,ctx.height)/300;
793   with ctx do
794   begin
795     translate(center.X,center.Y);
796     scale(zoom,zoom);
797     rotate(angle);
798     translate(-93,-83);
799     beginPath();
800     moveTo(89.724698,11.312043);
801     bezierCurveTo(95.526308,14.494575,100.52322000000001,18.838808,102.75144,24.966412);
802     bezierCurveTo(114.24578,26.586847,123.07072,43.010127999999995,118.71826,54.504664);
803     bezierCurveTo(114.77805000000001,64.910473,93.426098,68.10145299999999,89.00143800000001,59.252123);
804     bezierCurveTo(86.231818,53.712894999999996,90.877898,48.213108999999996,88.853498,42.139906999999994);
805     bezierCurveTo(87.401408,37.78364299999999,82.208048,33.87411899999999,85.595888,27.098436999999993);
806     bezierCurveTo(87.071858,24.146481999999992,94.76621800000001,25.279547999999995,94.863658,23.444067999999994);
807     bezierCurveTo(95.066728,19.618834999999994,92.648878,18.165403999999995,90.221828,15.326465999999995);
808     closePath();
809     moveTo(53.024288,20.876975);
810     bezierCurveTo(50.128958,26.827119000000003,48.561707999999996,33.260252,50.284608,39.548662);
811     bezierCurveTo(41.840728,47.513997,44.130318,66.017003,54.325338,72.88213300000001);
812     bezierCurveTo(63.554708000000005,79.09700300000002,82.823918,69.36119300000001,81.320528,59.58223300000001);
813     bezierCurveTo(80.379498,53.461101000000006,73.409408,51.65791100000001,71.551608,45.53168800000001);
814     bezierCurveTo(70.219018,41.13739400000001,72.197818,34.94548700000001,65.517188,31.373877000000007);
815     bezierCurveTo(62.606638000000004,29.817833000000007,56.98220800000001,35.18931200000001,55.841908000000004,33.74771500000001);
816     bezierCurveTo(53.465478000000004,30.743354000000007,54.598668,28.159881000000006,54.938648,24.44039800000001);
817     closePath();
818     moveTo(16.284108,78.650993);
819     bezierCurveTo(16.615938,85.259863,18.344168,91.651623,22.885208,96.330453);
820     bezierCurveTo(19.327327999999998,107.37975,30.253377999999998,122.48687000000001,42.495058,123.58667);
821     bezierCurveTo(53.577238,124.58229,65.765908,106.76307,59.734438,98.920263);
822     bezierCurveTo(55.959047999999996,94.01106300000001,48.983098,95.791453,44.402058,91.319753);
823     bezierCurveTo(41.116108,88.112233,39.864737999999996,81.73340300000001,32.289848,81.824883);
824     bezierCurveTo(28.989708,81.864783,26.651538,89.282293,24.957518,88.569003);
825     bezierCurveTo(21.427108,87.08246299999999,21.174458,84.272723,19.679208,80.85010299999999);
826     closePath();
827     moveTo(152.77652,37.616125);
828     bezierCurveTo(156.68534,42.955439,159.37334,49.006564,158.79801,55.501293);
829     bezierCurveTo(168.5256,61.835313,169.5682,80.450283,160.75895,89.021463);
830     bezierCurveTo(152.78409,96.780823,132.08894,90.63274299999999,131.82654,80.742363);
831     bezierCurveTo(131.6623,74.551503,138.19976,71.535693,138.93671,65.17653299999999);
832     bezierCurveTo(139.46532,60.615162999999995,136.41531,54.87470199999999,142.35299,50.170306999999994);
833     bezierCurveTo(144.93985,48.12074299999999,151.43107,52.404562999999996,152.29636,50.78291599999999);
834     bezierCurveTo(154.09968999999998,47.403324999999995,152.52446999999998,45.062994999999994,151.52745,41.463536999999995);
835     closePath();
836     moveTo(139.65359,109.38478);
837     bezierCurveTo(179.13505,123.79982000000001,142.51298,146.31478,119.19800000000001,151.55864);
838     bezierCurveTo(95.883018,156.8025,41.93790800000001,157.82316,75.508908,123.02183);
839     bezierCurveTo(78.980078,119.42344999999999,79.61785800000001,104.19731999999999,82.074898,99.283253);
840     bezierCurveTo(86.361158,93.329663,106.23528,86.908083,113.13709,88.929193);
841     bezierCurveTo(128.23085,93.960443,125.96716,106.89633,139.65359,109.38478);
842     closePath();
843     if isPointInPath(mx+0.5,my+0.5) then
844       fillStyle ('#6faed9')
845     else
846       fillStyle ('#3f5e99');
847     fill();
848   end;
849   UpdateIn(10);
850 end;
851 
852 procedure TForm1.Test17(ctx: TBGRACanvas2D; grainElapse: integer);
853 var
854   grad: IBGRACanvasGradient2D;
855   angle: single;
856 begin
857   inc(test17pos, grainElapse);
858   angle := test17pos*2*Pi/1000;
859 
860   ctx.translate(ctx.Width/2,ctx.Height/2);
861   ctx.scale(min(ctx.Width,ctx.Height)/2-10);
862   ctx.rotate(angle);
863 
864   grad := ctx.createLinearGradient(-1,-1,1,1);
865   grad.addColorStop(0.3, '#ff0000');
866   grad.addColorStop(0.6, '#0000ff');
867   ctx.fillStyle(grad);
868 
869   grad := ctx.createLinearGradient(-1,-1,1,1);
870   grad.addColorStop(0.3, '#ffffff');
871   grad.addColorStop(0.6, '#000000');
872   ctx.strokeStyle(grad);
873   ctx.lineWidth := 5;
874 
875   ctx.beginPath;
876   ctx.moveto(0,0);
877   ctx.arc(0,0,1,Pi/6,-Pi/6,false);
878   ctx.fill();
879   ctx.stroke();
880 
881   UpdateIn(10);
882 end;
883 
884 procedure TForm1.Test18(ctx: TBGRACanvas2D; grainElapse: integer);
885 var pat: TBGRABitmap;
886 begin
887   inc(test18pos, grainElapse);
888   ctx.translate(ctx.width div 2, ctx.height div 2);
889   ctx.rotate(test18pos*2*Pi/360);
890   ctx.scale(3,3);
891   pat := TBGRABitmap.Create(8,8);
892   pat.GradientFill(0,0,8,8,BGRABlack,BGRAWhite,gtLinear,PointF(0,0),PointF(8,8),dmSet);
893 //  ctx.surface.CreateBrushTexture(bsDiagCross,BGRA(255,255,0),BGRA(255,0,0)) as TBGRABitmap;
894   ctx.fillStyle(ctx.createPattern(pat,'repeat-x'));
895   ctx.fillRect(pat.width,0,ctx.width,pat.height);
896   ctx.fillStyle(ctx.createPattern(pat,'repeat-y'));
897   ctx.fillRect(0,0,pat.width,ctx.height);
898 
899   ctx.rotate(Pi);
900   ctx.globalAlpha:= 0.25;
901   ctx.fillStyle(ctx.createPattern(pat,'repeat-x'));
902   ctx.fillRect(0,0,ctx.width,ctx.height);
903   ctx.fillStyle(ctx.createPattern(pat,'repeat-y'));
904   ctx.fillRect(0,0,ctx.width,ctx.height);
905   pat.free;
906 
907   UpdateIn(10);
908 end;
909 
910 procedure TForm1.Test19(ctx: TBGRACanvas2D; grainElapse: integer);
911 var i: integer;
912     tx,ty: single;
913 begin
914   inc(test19pos, grainElapse);
915   ctx.save;
916   ctx.translate(ctx.width div 2, ctx.height div 2);
917   ctx.rotate(test19pos*2*Pi/500);
918   ctx.scale(ctx.height / 2,ctx.height / 2);
919   ctx.beginPath;
920   ctx.moveto(1,0);
921   for i := 1 to 8 do
922   begin
923     ctx.rotate(2*Pi/8);
924     ctx.lineto(1,0);
925   end;
926   ctx.restore;
927   ctx.clip;
928 
929   tx := ctx.width div 2;
930   ty := ctx.height div 2;
931   ctx.fillStyle ('red');
932   ctx.fillRect(0, 0, tx, ty);
933   ctx.fillStyle ('blue');
934   ctx.fillRect(tx, 0, tx, ty);
935 
936   ctx.globalAlpha := 0.75;
937   ctx.fillStyle ('yellow');
938   ctx.fillRect(0, ty, tx, ty);
939   ctx.fillStyle ('green');
940   ctx.fillRect(tx, ty, tx, ty);
941 
942   test18(ctx, grainElapse);
943 end;
944 
945 procedure TForm1.Test20(ctx: TBGRACanvas2D; AVectorizedFont: boolean);
946 var
947   i: Integer;
948   grad: IBGRACanvasGradient2D;
949 begin
950   UseVectorizedFont(ctx,AVectorizedFont);
951   ctx.save;
952 
953   ctx.fontName:= 'default';
954   ctx.fontEmHeight:= ctx.height/10;
955   ctx.textBaseline:= 'alphabetic';
956 
957   ctx.shadowBlur:= 5;
958   ctx.shadowOffset := PointF(5,5);
959   ctx.shadowColor(BGRABlack);
960 
961   ctx.beginPath;
962   if AVectorizedFont then
963     ctx.text('Vectorized font',ctx.fontEmHeight*0.2,ctx.fontEmHeight)
964   else
965     ctx.text('Raster font',ctx.fontEmHeight*0.2,ctx.fontEmHeight);
966   ctx.lineWidth := 5;
967   ctx.lineJoin:= 'round';
968   ctx.strokeStyle(BGRA(0,192,0));
969   ctx.fillStyle(clBlack);
970   ctx.fillOverStroke;
971 
972   ctx.shadowNone;
973 
974   grad := ctx.createLinearGradient(0,0,ctx.width,ctx.height);
975   grad.addColorStop(0.3, '#000080');
976   grad.addColorStop(0.7, '#00a0a0');
977   ctx.fillStyle(grad);
978 
979   ctx.translate(ctx.width/2, ctx.height/2);
980 
981   for i := 0 to 11 do
982   begin
983     ctx.beginPath;
984     ctx.moveTo(0,0);
985     ctx.lineTo(ctx.width+ctx.height,0);
986     ctx.strokeStyle(clRed);
987     ctx.lineWidth := 1;
988     ctx.stroke;
989 
990     ctx.beginPath;
991     ctx.text('hello',ctx.width/10,0);
992     ctx.fill;
993     ctx.rotate(Pi/6);
994   end;
995   ctx.restore;
996   ctx.fontRenderer := nil;
997 end;
998 
999 procedure TForm1.Test22(ctx: TBGRACanvas2D);
1000 var layer: TBGRABitmap;
1001 begin
1002   layer := TBGRABitmap.Create(ctx.width,ctx.height, CSSRed);
1003   UseVectorizedFont(layer.Canvas2D,true);
1004   with layer.Canvas2D do
1005   begin
1006     pixelCenteredCoordinates:= ctx.pixelCenteredCoordinates;
1007     antialiasing:= ctx.antialiasing;
1008     fontName:= 'default';
1009     fontStyle := [fsBold];
1010     fontEmHeight:= min(ctx.height/2, ctx.width/4);
1011     textBaseline:= 'middle';
1012     textAlign := 'center';
1013 
1014     beginPath;
1015     text('hole', width/2,height/2);
1016     clearPath;
1017   end;
1018   ctx.surface.DrawCheckers(rect(0,0,ctx.width,ctx.height), CSSWhite,CSSSilver);
1019   ctx.surface.PutImage(0,0,layer,dmDrawWithTransparency);
1020 end;
1021 
1022 procedure TForm1.Test23(ctx: TBGRACanvas2D; grainElapse: integer);
1023 begin
1024   UseVectorizedFont(ctx,true);
1025   with ctx do
1026   begin
1027     save;
1028     fontName:= 'default';
1029     fontStyle := [fsBold];
1030     fontEmHeight:= min(height/2, width/6);
1031     textBaseline:= 'middle';
1032     textAlign := 'center';
1033 
1034     translate(width/2,height/2);
1035     transform(cos(test23pos*Pi/60),sin(test23pos*Pi/60),0,1,0,0);
1036     beginPath;
1037     text('distort', 0,0);
1038     fillStyle(clBlack);
1039     fill;
1040     restore;
1041   end;
1042   inc(test23pos, grainElapse);
1043   UpdateIn(10);
1044 end;
1045 
1046 end.
1047 
1048