Discussion :

[Roland Chastain]

Bonjour !

J'utilise la fonction FillEllipseAntiAlias() de la bibliothèque BGRABitmap pour dessiner un disque. Je rencontre un problème lorsque je veux dessiner mon disque sur un fond noir. Dans ce cas l'anti-aliasing est sans effet. Connaissez-vous une technique qui permettrait de dessiner avec anti-aliasing sur un fond noir ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
unit Unit1;
 
{$MODE objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  BGRABitmap, BGRABitmapTypes;
 
type
  { TForm1 }
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
  Bitmap1: TBGRABitmap;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Bitmap1 := TBGRABitmap.Create(400, 400);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bitmap1.Free;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
  local: TBGRABitmap;
begin
  with Bitmap1.Canvas do
  begin
    //Pen.Color := clWhite;
    Pen.Color := clBlack;
    Brush.Style := bsSolid;
    //Brush.Color := clWhite;
    Brush.Color := clBlack;
    Rectangle(0, 0, 400, 400);
  end;
 
  local := TBGRABitmap.Create(200, 200);
  local.FillEllipseAntialias(100, 100, 90, 90, CSSDarkBlue);
 
  Bitmap1.PutImage(100, 100, local, dmDrawWithTransparency);
 
  local.Free;
 
  Bitmap1.Draw(Form1.Canvas, 0, 0, True);
end;
 
end.

[Roland Chastain]

Je viens de m'apercevoir que le problème est traité dans l'un des exemples inclus dans les sources de LazPaint (dossier "testbgrafunc", unité "u14.pas").
Voici mon code corrigé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
procedure TForm1.FormPaint(Sender: TObject);
var
  local: TBGRABitmap;
begin
  {
  with Bitmap1.Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Style := bsSolid;
    Brush.Color := clBlack;
    Rectangle(0, 0, 400, 400);
  end;
  }
  Bitmap1.Fill(BGRABlack);
 
  {
  local := TBGRABitmap.Create(200, 200);
  }
  local := TBGRABitmap.Create(200, 200, BGRABlack);
 
  {
  local.FillEllipseAntialias(100, 100, 90, 90, CSSDarkBlue);
  }
  local.FillEllipseAntialias(100, 100 , 90, 90, BGRA(0, 0, 255, 255));
 
  Bitmap1.PutImage(100, 100, local, dmDrawWithTransparency);
 
  local.Free;
 
  Bitmap1.Draw(Form1.Canvas, 0, 0, True);
end;

Elle est vraiment géniale cette bibliothèque. En comparaison d'AggPas (par exemple), le code est d'une simplicité ! Bravo et merci à l'auteur.

[Roland Chastain]

Je vous propose une animation utilisant la bibliothèque BGRABitmap. Ce sont des balles rebondissantes, de tailles et de masses différentes. Je suis parti d'un programme existant : je n'ai fait que remplacer la procédure de dessin des ellipses. J'ai fait un essai du même genre aussi avec Cairo. La procédure BGRABitmap m'a paru être plus rapide que les autres (LCL et Cairo).

[ThWilliam]

Bonsoir Roland.

Tu n'es même pas obligé de passer par "local".

Ceci me donne le même résultat (ou alors c'est une question de version de BGRABitmap).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Bitmap1:= TBGRABitmap.Create(400,400, BGRABlack);
Bitmap1.FillEllipseAntialias(200, 200 , 90, 90, CSSDarkblue);
Bitmap1.Draw(Form1.Canvas, 0, 0, True);

Cordialement
Thierry

[Roland Chastain]

Bonsoir Thierry !

Oui, c'est vrai. Merci pour le test. En fait j'avais une bonne raison, au départ, de passer par cette variable supplémentaire (voir l'animation que je viens de poster).

[ThWilliam]

Bonjour Roland.

Extra ton animation.
Je vais me servir de ton programme comme écran de veille

Cordialement
Thierry

[Roland Chastain]

Merci pour le compliment, qui revient surtout à l'auteur du programme original (son site vaut le détour).

Je vais me servir de ton programme comme écran de veille

Je t'en prie. Il y a peut-être une ou deux choses à revoir, comme cet endroit qui me chagrine (quoique je n'aie constaté visuellement aucune anomalie) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
  for i := 0 to High(Balls) do
    for j := i + 1 to High(Balls) do
      begin
        Balls[i].CollideWithOther(Balls[j]);

[ThWilliam]

Bonsoir Roland.


Le code de la boucle n'est pas erroné, mais quand I= High(Balls), la bloucle for J n'est pas exécutée.
Alors autant écrire : for i := 0 to High(Balls) - 1 do ...

Cordialement
Thierry

[circular17]

Bonjour,

La discussion n'est pas récente, mais je fais un petit up pour proposer une optimisation et un rendu plus joli. Il n'est pas nécessaire de créer l'image de la balle à chaque Render. D'autre part, si on crée l'image en avance, au passage, on peut dessiner de jolies billes.

Voilà l'unite Elements avec cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
 
(*
  http://corpsman.de/index.php?doc=beispiele/pingpong
  http://corpsman.de/klickcounter.php?url=download/pingpong.zip
*)
 
unit Elements;
 
interface
 
uses
  Windows, Graphics,
  BGRABitmap, BGRABitmapTypes;
 
type
  TFPoint = record
    x, y: Single;
  end;
 
  { TBall }
 
  TBall = class
  private
    fVX, fVY, fX, fY, fR, fM: Single;
    fBitmap: TBGRABItmap;
    function GetPos: TFPoint;
    procedure SetPos(aValue: TFPoint);
    function GetSpeed: TFPoint;
    procedure SetSpeed(aValue: TFPoint);
    procedure MakeBitmap;
  public
    property Radius: Single read fR;
    property Position: TFPoint read GetPos write SetPos;
    property SpeedVektor: TFPoint read GetSpeed write SetSpeed;
    property Mass: Single read fM write fM;
    constructor Create(aPosition, aSpeedVektor: TFPoint; aRadius, aMass: Single);
    destructor Destroy; override;
    procedure Render(const aBitmap: TBGRABitmap);
    procedure CalculateMass;
    procedure BorderCollision(CollisionRect: TRect; InsideCollision: Boolean = TRUE);
    procedure CollideWithOther(const aBall: TBall);
    procedure Move;
  end;
 
function Point(x, y: Single): TFPoint;
function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
 
implementation
 
uses BGRAGradients;
 
function Point(x, y: Single): TFPoint;
begin
  result.x := x;
  result.y := y;
end;
 
function Rect(aLeft, aTop, aRight, aBottom: Integer): TRect;
begin
  with result do
  begin
    Left := aLeft;
    Right := aRight;
    Top := aTop;
    bottom := aBottom;
  end;
end;
 
constructor TBall.Create(aPosition, aSpeedVektor: TFPoint; aRadius, aMass: Single);
begin
  inherited Create;
  fX := aPosition.x;
  fY := aPosition.y;
  fR := aRadius;
  fM := aMass;
  fVX := aSpeedVektor.x;
  fVY := aSpeedVektor.y;
  MakeBitmap;
end;
 
destructor TBall.Destroy;
begin
  fBitmap.Free;
  inherited Destroy;
end;
 
function TBall.GetPos: TFPoint;
begin
  result.x := fX;
  result.y := fY;
end;
 
procedure TBall.SetPos(aValue: TFPoint);
begin
  fX := aValue.x;
  fY := aValue.y;
end;
 
function TBall.GetSpeed: TFPoint;
begin
  result.x := fVX;
  result.y := fVY;
end;
 
procedure TBall.SetSpeed(aValue: TFPoint);
begin
  fVX := aValue.x;
  fVY := aValue.y;
end;
 
procedure TBall.MakeBitmap;
var map: TBGRABitmap;
  phong: TPhongShading;
begin
  map := CreateSpherePreciseMap(round(fR*2),round(fR*2));
  fBitmap := TBGRABitmap.Create(round(fR*2),round(fR*2));
  phong := TPhongShading.Create;
  phong.Draw(fBitmap,map,round(fR),0,0,BGRA(0, 0, 255, 255));
  phong.Free;
  map.Free;
end;
 
procedure TBall.Move;
begin
  fX := fX + fVX;
  fY := fY + fVY;
end;
 
function Tan(X: Extended): Extended;
begin
  result := Sin(X) / Cos(X);
end;
 
function Hypot(X, Y: Extended): Extended;
begin
  result := Sqrt(X * X + Y * Y);
end;
 
function DegToRad(aDegrees: Extended): Extended;
begin
  result := aDegrees * (PI / 180);
end;
 
function RadToDeg(aRadians: Extended): Extended;
begin
  result := aRadians * (180 / PI);
end;
 
function Tangens(aValue: Extended): Extended;
begin
  result := Tan(DegToRad(aValue));
end;
 
function Sinus(E: Extended): Extended;
begin
  result := Sin(DegToRad(E));
end;
 
function Cosinus(E: Extended): Extended;
begin
  result := Cos(DegToRad(E));
end;
 
procedure Tausche(var i1, i2: integer);
var
  i3: integer;
begin
  i3 := i1;
  i1 := i2;
  i2 := i3;
end;
 
function ArcTangens(x, y: Extended): Extended;
begin
  if x = 0 then
  begin
    if (y >= 0) then
      result := 90
    else
      result := 270;
  end else
  begin
    result := RadToDeg(ArcTan(Y / X));
    if x < 0 then
      result := 180 + result
    else
      if Y < 0 then
        result := 360 + result;
  end;
end;
 
function EllipseRechteckCollision(e1, r1: TRect): Boolean;
type
  TPunkt = record
    X, Y: Extended;
  end;
var
  sn1, sn2, x, alpha: Extended;
  p1, p2: TPoint;
  n1, n2: TPunkt;
  radius1, radius2: Integer;
begin
  result := FALSE;
 
  if e1.Left > e1.Right then Tausche(e1.Left, e1.Right);
  if e1.Top > e1.Bottom then Tausche(e1.Top, e1.Bottom);
  if r1.Left > r1.Right then Tausche(r1.Left, r1.Right);
  if r1.Top > r1.Bottom then Tausche(r1.Top, r1.Bottom);
 
  p1.x := e1.Left + (e1.Right - e1.Left) div 2;
  p1.y := e1.Top + (e1.Bottom - e1.Top) div 2;
  p2.x := r1.Left + (r1.Right - r1.Left) div 2;
  p2.y := r1.Top + (r1.Bottom - r1.Top) div 2;
 
  alpha := ArcTangens(p1.x - p2.x, p1.y - p2.y);
 
  x := Hypot(p1.x - p2.x, p1.y - p2.y);
 
  radius1 := p1.x - e1.Left;
  radius2 := p1.y - e1.Top;
 
  n1.x := Cosinus(alpha) * radius1 + P1.x;
  n1.Y := Sinus(alpha) * radius2 + P1.Y;
 
  sn1 := Hypot(p1.x - n1.x, p1.y - n1.y);
 
  case Round(alpha) of
    0..45:
      begin
        n2.x := r1.Right;
        n2.y := Round(Tangens(alpha) * ((r1.Bottom - p2.y) / 2)) + p2.y;
      end;
    46..90:
      begin
        n2.y := r1.Top;
        n2.x := Round(Tangens(alpha - 45) * ((r1.Right - p2.x) / 2)) + p2.x;
      end;
    91..135:
      begin
        n2.y := r1.Top;
        n2.x := Round(Tangens(alpha - 90) * ((r1.Right - p2.x) / 2)) + p2.x;
      end;
    136..225:
      begin
        n2.x := r1.Left;
        n2.y := Round(Tangens(alpha) * ((r1.Bottom - p2.y) / 2)) + p2.y;
      end;
    226..270:
      begin
        n2.y := r1.Bottom;
        n2.x := Round(Tangens(alpha - 225) * ((r1.Right - p2.x) / 2)) + p2.x;
      end;
    271..315:
      begin
        n2.y := r1.Bottom;
        n2.x := Round(Tangens(alpha - 270) * ((r1.Right - p2.x) / 2)) + p2.x;
      end;
    316..360:
      begin
        n2.x := r1.Right;
        n2.y := Round(Tangens(alpha) * ((r1.Bottom - p2.y) / 2)) + p2.y;
      end;
  end;
  sn2 := Hypot(p2.x - n2.x, p2.y - n2.y);
  if x <= (sn1 + sn2) then
    result := TRUE;
end;
 
procedure TBall.BorderCollision(CollisionRect: TRect; InsideCollision: Boolean = TRUE);
begin
  if InsideCollision then
  begin
    if ((fX - fR < CollisionRect.Left) and (fVX < 0))
    or ((fX + fR > CollisionRect.Right) and (fVX > 0)) then
      fVX := -fVX;
    if ((fY - fR < CollisionRect.Top) and (fVY < 0))
    or ((fY + fR > CollisionRect.Bottom) and (fVY > 0)) then
      fVY := -fVY;
  end
  else
    if EllipseRechteckCollision(
      Rect(Round(fX - fR), Round(fY - fR), Round(fX + fR), Round(fY + fR)),
      CollisionRect
    ) then
    begin
      if ((fY < CollisionRect.Top) and (fVY > 0))
      or ((fY > CollisionRect.Bottom) and (fVY < 0)) then
        fVY := -fVY;
      if ((fX < CollisionRect.Left) and (fVX > 0))
      or ((fX > CollisionRect.Right) and (fVX < 0)) then
        fVX := -fVX;
    end;
end;
 
procedure TBall.CollideWithOther(const aBall: TBall);
var
  a, b, c, d, e, f, g, h, i, j, k, l, m: Single;
begin
  a := aBall.Position.x - fX;
  b := aBall.Position.y - fY;
 
  c := a * a + b * b;
 
  d := fR + aBall.Radius;
 
  if c <= d * d then
  begin
    d := Sqrt(c);
 
    e := a / d;
    f := b / d;
 
    g := fVX * e + fVY * f;
 
    h := aBall.SpeedVektor.x * e + aBall.SpeedVektor.y * f;
 
    if g - h < 0 then
      exit;
 
    i := fVY * e - fVX * f;
 
    j := aBall.SpeedVektor.y * e - aBall.SpeedVektor.x * f;
 
    k := fM + aBall.Mass;
 
    l := (fM - aBall.Mass) / k * g + 2 * aBall.Mass / k * h;
 
    m := (aBall.Mass - fM) / k * h + 2 * fM / k * g;
 
    fVX := l * e - i * f;
    fVY := l * f + i * e;
 
    aBall.SpeedVektor := Point(m * e - j * f, m * f + j * e);
  end;
end;
 
procedure TBall.CalculateMass;
begin
  fM := 4 / 3 * fR * fR * fR * PI;
end;
 
procedure TBall.Render(const aBitmap: TBGRABitmap);
begin
  aBitmap.PutImage(
    Round(fX - (fBitmap.Width-1)/2),
    Round(fY - (fBitmap.Height-1)/2),
    fBitmap,
    dmDrawWithTransparency
  );
end;
 
end.

[Roland Chastain]

Très joli, et l'animation est maintenant d'une fluidité époustouflante ! Chapeau et merci.

[circular17]

Contribuer est ma joie.

Merci aussi pour le partage du programme !

Au sujet des bords avec antialiasing sur fond noir, l'explication est la suivante.

La propriété Canvas donne acces aux fonctions de dessin du systeme, qui ne permettent pas de spécifier de transparence. La couleur clBlack est donc utilisée comme couleur transparente. Si l'on veut faire une couleur noire, il y a la constante clBlackOpaque, qui a une valeur 1 pour le canal bleu, ce qui ne se voit pas mais qui permet de différencier.

Cela dit, il est préférable d'utiliser seulement les fonctions natives de BGRABitmap pour une question de rapidité. Ce n'est pas vraiment qu'elles soient plus rapides en tant que tel, mais cela évite d'avoir a effectuer des traitements intermédiaires quand on passe des fonctions de dessin du systeme aux fonctions de BGRABitmap.

Si l'on utilise la couleur clBlack avec Canvas, cela efface. Donc au final, tu obtiens une image avec un fond transparent. Quand une telle image est dessinée en tant qu'opaque, les bords avec la transparence n'ont pas d'antialiasing. Ce qui n'est pas completement transparent est dessiné opaque, et ce qui est transparent est dessiné en noir.