Dessiner un disque

Version imprimable

1 pièce(s) jointe(s)

Dessiner un disque

Bonjour !

J'aimerais faire une interface graphique pour un Puissance 4, et je cherche le moyen de dessiner de beaux disques. Vos exemples seraient les bienvenus.

Pour commencer, je suis allé regarder du côté de la librairie AggPas. Les exemples sont impressionnants, mais un peu compliqués je trouve. J'ai fait un extrait de l'exemple alpha_gradient. (Il y a peut-être des choses en trop dans le code, notamment dans la liste des unités.)

Code:

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
 
// AggPas 2.3 RM1
 
program alpha_gradient2;
 
uses
  agg_basics,
  agg_platform_support,
  agg_color,
  agg_pixfmt,
  agg_pixfmt_rgb,
  agg_ctrl,
  agg_spline_ctrl,
  agg_renderer_base,
  agg_renderer_scanline,
  agg_rasterizer_scanline_aa,
  agg_scanline,
  agg_scanline_u,
  agg_render_scanlines,
  agg_array,
  agg_ellipse,
  agg_vcgen_stroke,
  agg_trans_affine,
  agg_math;
 
{$I agg_mode.inc}
 
const
  flip_y = true;
 
type
  the_application = object(platform_support)
    m_x, m_y: array[0..2] of double;
    m_dx, m_dy: double;
    m_idx: int;
    m_alpha: spline_ctrl;
    constructor Construct(format_: pix_format_e; flip_y_: boolean);
    destructor Destruct;
    procedure fill_color_array(array_: pod_auto_array_ptr; begin_, middle_, end_: aggclr_ptr);
    procedure on_draw; virtual;
  end;
 
constructor the_application.Construct;
begin
  inherited Construct(format_, flip_y_);
  m_alpha.Construct(2, 2, 200, 30, 6, not flip_y_);
  m_idx:= -1;
  m_x[0 ]:= 257;
  m_y[0 ]:= 60;
  m_x[1 ]:= 369;
  m_y[1 ]:= 170;
  m_x[2 ]:= 143;
  m_y[2 ]:= 310;
  m_alpha.point_(0, 0.0, 0.0);
  m_alpha.point_(1, 1.0/5.0, 1.0-4.0/5.0);
  m_alpha.point_(2, 2.0/5.0, 1.0-3.0/5.0);
  m_alpha.point_(3, 3.0/5.0, 1.0-2.0/5.0);
  m_alpha.point_(4, 4.0/5.0, 1.0-1.0/5.0);
  m_alpha.point_(5, 1.0, 1.0);
  m_alpha.update_spline;
  add_ctrl(@m_alpha);
end;
 
destructor the_application.Destruct;
begin
  inherited Destruct;
  m_alpha.Destruct;
end;
 
procedure the_application.fill_color_array;
var
  i: unsigned;
begin
  i:= 0;
  while i < 128 do
  begin
    aggclr_ptr(array_.array_operator(i))^:= begin_.gradient(middle_, i/128.0);
    inc(i);
  end;
  while i < 256 do
  begin
    aggclr_ptr(array_.array_operator(i))^:= middle_.gradient(end_, (i-128)/128.0);
    inc(i);
  end;
end;
 
procedure the_application.on_draw;
var
  pf: pixel_formats;
  rgba, rgbb, rgbc: aggclr;
  ren_base: renderer_base;
  ren_solid: renderer_scanline_aa_solid;
  sl: scanline_u8;
  ras: rasterizer_scanline_aa;
  ell: ellipse;
  i,w,h: unsigned;
begin
  pixfmt_bgr24(pf, rbuf_window);
  ren_base.Construct(@pf);
  ren_solid.Construct(@ren_base);
  rgba.ConstrDbl(1, 1, 1);
  ren_base.clear(@rgba);
  sl.Construct;
  ras.Construct;
  ell.Construct;
  RandSeed := 1234;
  w := trunc(_width);
  h := trunc(_height);
  for i := 0 to 99 do
  begin
    ell.init(
      Random($7fff) mod w,
      Random($7fff) mod h,
      Random($7fff) mod 60 + 5,
      Random($7fff) mod 60 + 5,
      50
    );
    rgba.ConstrDbl(
      Random($7fff)/$7fff,
      Random($7fff)/$7fff,
      Random($7fff)/$7fff,
      Random($7fff)/$7fff/2.0
    );
    ren_solid.color_(@rgba);
    ras.add_path(@ell);
    render_scanlines(@ras, @sl, @ren_solid);
  end;
  sl.Destruct;
  ras.Destruct;
end;
 
var
  app: the_application;
 
begin
  app.Construct(pix_format_bgr24,flip_y);
  app.caption_('AGG Example');
  if app.init(400, 320, window_resize) then
    app.run;
  app.Destruct;
end.

salut,

tu connais le cercle d'Andres ? ça fait pas de l'alpha et autres joyeusetés mais j'ai trouvé l'algorightme amusant

voici une version plus simple à comprendre je pense:

Code:

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
 
// attention, le cercle doit tenir complètement dans le bitmap 32bits
procedure AndresCircle(Bitmap: TBitmap; cx, cy, r: Integer; cl: Cardinal);
type
  TPixels= array[Word] of Cardinal;
  PPixels= ^TPixels;
var
  x, y, d: Integer;
  pixels : PPixels;
begin
  x := 0;
  y := r;
  d := r-1;
  while Y >= X do
  begin
    pixels := Bitmap.ScanLine[cy + y];
    pixels[cx - x] := cl;
    pixels[cx + x] := cl;
    pixels := Bitmap.ScanLine[cy - y];
    pixels[cx - x] := cl;
    pixels[cx + x] := cl;
    pixels := Bitmap.ScanLine[cx + y];
    pixels[cy - x] := cl;
    pixels[cy + x] := cl;
    pixels := Bitmap.ScanLine[cx - y];
    pixels[cy - x] := cl;
    pixels[cy + x] := cl;
    pixels := Bitmap.ScanLine[cy + x];
    pixels[cx - x] := cl;
    pixels[cx + x] := cl;
    pixels := Bitmap.ScanLine[cy - x];
    pixels[cx - y] := cl;
    pixels[cx + y] := cl;
    pixels := Bitmap.ScanLine[cx + x];
    pixels[cy - y] := cl;
    pixels[cy + y] := cl;
    pixels := Bitmap.ScanLine[cx - x];
    pixels[cy - y] := cl;
    pixels[cy + y] := cl;
 
    if d >= x + x then
    begin
      d := d - x - x - 1;
      Inc(X);
    end else
    if d <= r + r - y - y then
    begin
      d := d + Y + Y - 1;
      Dec(Y);
    end else
    begin
      d := d + Y + Y - X - X - 2;
      Dec(Y);
      Inc(X);
    end;
  end;
end;

26/09/2013, 03h56
Roland Chastain

Je ne connaissais pas. Je vais regarder ça de près. Il faut que je prenne le temps d'apprendre à utiliser les bitmaps : pour le moment je n'ai pas été capable d'essayer ton code. :aie:

Citation:

Envoyé par Roland Chastain

Je ne connaissais pas. Je vais regarder ça de près. Il faut que je prenne le temps d'apprendre à utiliser les bitmaps : pour le moment je n'ai pas été capable d'essayer ton code. :aie:

rohhh :)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 var Bitmap: TBitmap; begin Bitmap := TBitmap.Create; Bitmap.PixelFormat := pf32Bit; // nécessaire pour la fonction Bitmap.Width := 512; Bitmap.Height := 512; AndresCircle(Bitmap, 25, 25, 20, clRed); Image1.Picture.Assign(Bitmap); // pour placer l'image dans une Image Canvas.Draw(0,0, Bitmap); // pour dessiner sur le canvas Bitmap.Free; // ou pas s'il faut le redessiner sur le canvas dans OnPaint end;
nb: code tapé de tête sans vérification :)

26/09/2013, 07h11
Roland Chastain

Merci Paul pour l'exemple. :ccool:
26/09/2013, 08h01
Roland Chastain

1 pièce(s) jointe(s)

Un algorithme original pour tracer un cercle, c'est toujours intéressant, mais je cherche le moyen de faire quelque chose de plus esthétique.

Voici en pièce jointe un aperçu d'une grille que j'ai faite en FreeBasic avec la librairie Cairo.

P.-S. Je m'aperçois que Cairo est utilisable aussi avec FreePascal, mais je n'ai pas trouvé d'exemple.

Voici une version WinGraph de l'algorithme d'Andres.

La particularité de cet algorithme, si j'essaie de résumer, c'est qu'il n'utilise que des nombres entiers. Au lieu de passer par un cercle idéal dont on trace un équivalent approximatif sur l'écran, c'est directement le cercle en pixels qu'on trouve, de sorte qu'il n'y a ni trous dans le dessin ni opérations inutiles. C'est à peu près ça, non ?

Code:

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
 
program Andres;
{$APPTYPE GUI}
 
uses
  WinCrt, WinGraph;
// http://pascal.developpez.com/telecharger/detail/id/1809/WinGraph  
// http://math.ubbcluj.ro/~sberinde/wingraph/
 
procedure DrawAndresCircle(cx, cy, r, col: integer);
var x, y, d: integer;
begin
  x := 0;
  y := r;
  d := r - 1;
  while y >= x do
  begin
    PutPixel(cx + x, cy + y, col);
    PutPixel(cx + y, cy + x, col);
    PutPixel(cx - x, cy + y, col);
    PutPixel(cx - y, cy + x, col);
    PutPixel(cx + x, cy - y, col);
    PutPixel(cx + y, cy - x, col);
    PutPixel(cx - x, cy - y, col);
    PutPixel(cx - y, cy - x, col);
    if d >= x + x then
    begin
      d := d - x - x - 1;
      Inc(x);
    end else
      if d <= r + r - y - y then
      begin
        d := d + y + y - 1;
        Dec(y);
      end else
      begin
        d := d + y + y - x - x - 2;
        Dec(y);
        Inc(x);
      end;
  end;
end;
 
var
  grDriver, grMode: smallInt;
  radius: integer;
 
begin
  SetWindowSize(320, 320);
  grDriver := d8bit;
  grMode := mCustom;
  InitGraph(grDriver, grMode, 'Algorithme d''Andres');
  SetBkColor(Snow);
  ClearDevice;
 
  for radius := 90 to 150 do
    DrawAndresCircle(160, 160, radius, SlateBlue);
 
  while not(KeyPressed or CloseGraphRequest) do
    Delay(20);
  CloseGraph;
end.

27/09/2013, 10h46
Paul TOTH

tout à fait :)

et tu peux faire varier la couleur du cercle pour obtenir un dégradé radial :)

1 pièce(s) jointe(s)

Voici donc une procédure pour dessiner un disque, basée sur le cercle d'Andres. Le deuxième disque est dessiné avec la procédure standard de l'unité WinGraph.

Code:

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
program Andres2;
{$APPTYPE GUI}
 
uses
  WinCrt, WinGraph;
// http://pascal.developpez.com/telecharger/detail/id/1809/WinGraph  
// http://math.ubbcluj.ro/~sberinde/wingraph/
 
procedure DrawAndresCircle(cx, cy, r, col: longword);
var x, y, d: integer;
begin
  x := 0;
  y := r;
  d := r - 1;
  while y >= x do
  begin
    PutPixel(cx + x, cy + y, col);
    PutPixel(cx + y, cy + x, col);
    PutPixel(cx - x, cy + y, col);
    PutPixel(cx - y, cy + x, col);
    PutPixel(cx + x, cy - y, col);
    PutPixel(cx + y, cy - x, col);
    PutPixel(cx - x, cy - y, col);
    PutPixel(cx - y, cy - x, col);
    if d >= x + x then
    begin
      d := d - x - x - 1;
      Inc(x);
    end else
      if d <= r + r - y - y then
      begin
        d := d + y + y - 1;
        Dec(y);
      end else
      begin
        d := d + y + y - x - x - 2;
        Dec(y);
        Inc(x);
      end;
  end;
end;
 
procedure DrawDisk(cx, cy, radius, col: longword);
var
  i: integer;
begin
  for i := 0 to radius do
  begin
    DrawAndresCircle(cx, cy, i, col);
  end;
end;
 
var
  grDriver, grMode: smallInt;
 
begin
  SetWindowSize(320, 160);
  grDriver := noPalette;
  grMode := mCustom;
  InitGraph(grDriver, grMode, '');
  SetBkColor(Snow);
  ClearDevice;
 
  UpdateGraph(Updateoff);
  DrawDisk(80, 80, 60, SlateBlue);
  UpdateGraph(UpdateOn);
 
  SetColor(Tangerine);
  SetFillStyle(SolidFill, Tangerine);
  FillEllipse(240, 80, 60, 60);
 
  while not(KeyPressed or CloseGraphRequest) do
    Delay(20);
  CloseGraph;
end.

03/10/2013, 09h25
Roland Chastain

1 pièce(s) jointe(s)

Et voici un disque dessiné avec Lazarus et la bibliothèque BGRABitmap. J'ai simplement repris un exemple du tutoriel disponible ici même (le dessin de la lune).

Je pense que je vais choisir cette solution.
07/10/2013, 10h15
Roland Chastain

2 pièce(s) jointe(s)

Elle est vraiment parfaite, cette bibliothèque ! Je ne résiste pas au plaisir de vous montrer le premier état de mon projet.

Je me demande s'il serait possible de faire tomber les pièces pixel par pixel, au lieu de les faire passer de cellule en cellule comme j'ai fait. Est-ce que ça pourrait être joli ? Les essais que j'ai pu faire dans ce sens n'étaient guère convaincants ; mais peut-être que je ne m'y suis pas pris comme il fallait.