Discussion :

[Archimède]

Question simple:
comment dessiner un petit disque coloré en rouge par exemple qui soit le plus régulier possible. sans cannelures. et sans sortir non plus la batterie anti-aliasing. les methodes du canvas ne sont jamais nickel.

merci

[Droïde Système7]

Tu veux sans doute parler de quelque chose de mieux qu'un simple TShape en stCircle ?

[Archimède]

Tu veux sans doute parler de quelque chose de mieux qu'un simple TShape en stCircle ?

c'est surtout pour l'utiliser dans un canvas.

[Archimède]

même en utilisant le GDI, ce n'est propre :

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
 
unit Ugraph;
 
interface
uses Windows,graphics,Extctrls,types,classes,controls,math;
 
type reel=extended;
 
type Trpoint=record
 x,y:reel;
end;
 
 
 
type Tgraph=class(Tbitmap)
 public
  constructor Create(w,h:integer);reintroduce;overload;
end;
 
type Tgraphique=class(Timage)
 private
  xmin,ymin,xmax,ymax:reel;
  graph:Tgraph;
 public
  constructor Create(w,h:integer;x1,x2,y1,y2:reel;par:Twincontrol;aowner:Tcomponent);reintroduce;overload;
  destructor Destroy;override;
  procedure obturation(cl:Tcolor);
  procedure disque(xo,yo,R:reel;cl:Tcolor);
  procedure initransfo;
  procedure charge;
end;
 
 
implementation
 
const M:integer=1000000;
 
constructor Tgraph.Create(w,h:integer);
begin
 inherited create;
 width:=w;
 height:=h;
end;
 
constructor Tgraphique.Create(w,h:integer;x1,x2,y1,y2:reel;par:Twincontrol;aowner:Tcomponent);
begin
 inherited create(aowner);
 parent:=par;
 visible:=false;
 width:=w;
 height:=h;
 xmin:=x1;
 xmax:=x2;
 ymin:=y1;
 ymax:=y2;
 graph:=Tgraph.create(w,h);
end;
 
procedure Tgraphique.initransfo;
var XFrm:XForm;
begin
 xFrm.eM11 :=width/(M*(xmax-xmin));
 xFrm.eM22 :=-height/(M*(ymax-ymin));
 xFrm.eM12 := 0;
 xFrm.eM21 := 0;
 xFrm.eDx :=-width*xmin/(xmax-xmin);
 xFrm.eDy :=ymax*height/(ymax-ymin);
 SetGraphicsMode(graph.Canvas.Handle, GM_ADVANCED);
 setworldtransform(graph.canvas.handle,xFrm);
end;
 
 
 
procedure Tgraphique.obturation(cl:Tcolor);
var r:Trect;
begin
 with r do
 begin
  left:=round(M*xmin);
  top:=round(M*ymax);
  right:=round(M*xmax);
  bottom:=round(M*ymin);
 end;
 
 with graph.canvas do
 begin
  brush.Color:=cl;
  fillrect(r);
 end;
end;
 
 
procedure Tgraphique.charge;
Begin
 picture.Bitmap:=graph;
end;
 
procedure TGraphique.disque(xo,yo,R:reel;cl:Tcolor);//si orthonormé
var pt:Tpoint;
begin
  pt:=point(round(M*xo),round(M*yo));
 with graph.canvas do
 begin
  pen.Color:=cl;
  brush.Color:=cl;
  ellipse(rect(pt.X-round(R*M),pt.Y-round(R*M),pt.X+round(R*M),pt.Y+round(R*M)));
 end;
end;
 
destructor TGraphique.Destroy;
begin
 graph.Free;
 inherited;
end;
 
end.

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,UGraph;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
  private
    { Déclarations privées }
    mondessin:Tgraphique;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 mondessin.destroy;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 setbounds(0,0,screen.Width div 2,screen.Width div 2);
 position:=poscreencenter;
 formstyle:=fsstayontop;
 mondessin:=TGraphique.Create(clientwidth,clientheight,-5,5,-5,5,self,self);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
 with mondessin do
 begin
   initransfo;
   obturation(clwhite);
   disque(0,0,3,clred);
   charge;
 end;
 
 canvas.Draw(0,0,mondessin.Picture.bitmap);
end;
 
end.

Je suis passé en coordonnées réelles en dessinant dans le bitmap d'un TImage. Je n'arrive pas à utiliser le GDI directement en dérivant un TBitmap.
ça ne marche pas...

et même en faisant ça, c'est encore cannelé....

[Droïde Système7]

Regarde à : Comment lisser un objet dessiné dans un TBitmap ?
(Un peu plus bas que la moitié de page)

Ça devrait être intéressant je pense.

@+

[Archimède]

Regarde à : Comment lisser un objet dessiné dans un TBitmap ?
(Un peu plus bas que la moitié de page)

Ça devrait être intéressant je pense.

@+

ah oui, là, tu m'intéresses.

merci super je vois ça.

[Paul TOTH]

plusieurs possibilités

Graphics32

GDI+

un bitmap précalculée

une image calculée dynamiquement, pour cela il existe une méthode simple pas très difficile à coder mais peu performante (ça suffit parfois):
- tu veux un disque de 10x10 pixels
- tu crées un bitmap de 20x20 pixels
- tu dessines dessus un disque de 20x20 de façon traditionnelle
- tu créés un bitmap de 10x10 pixels (ou tu réutilises un quart du bitmap existant)
- pour les pixels[x,y] de 0..9 tu calcules leur couleur en faisant la moyenne des 4 pixels [2*x+i,2*y+i] avec i de 0 à 1
- pour cela tu décomposes en R,G,B les pixels et tu fais la moyenne de chaque composante couleur

avec ça tu obtiens une image lissée.

au besoin du place une image de fond dans le bitmap avant opération (doublée en taille évidemment)

[Archimède]

merci, je vais me lancer dans ta méthode. C'est toujours net et précis avec toi

merci à vous deux .

[Paul TOTH]

tient, voici un exemple

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
 
// moyenne de 4 couleurs
function Blend(c1, c2, c3, c4: Integer): Integer;
var
  i : Integer;
  rgb: array[1..3] of Integer;
begin
  for i := 1 to 3 do
  begin
    rgb[i] := c1 and 255 + c2 and 255 + c3 and 255 + c4 and 255;
    c1 := c1 shr 8;
    c2 := c2 shr 8;
    c3 := c3 shr 8;
    c4 := c4 shr 8;
  end;
  Result := (rgb[3] shr 2) shl 16 + (rgb[2] shr 2) shl 8 + (rgb[1] shr 2);
end;
 
// Dessin d'une ellipse sur un canvas
procedure Ellipse(Canvas: TCanvas; x1, y1, x2, y2: Integer; Pen, Brush: TColor);
type
  TIntegers = array[0..1] of Integer;
  PIntegers = ^TIntegers;
var
  b : TBitmap;
  w, h: Integer;
  x, y : Integer;
  p  : PInteger;
  p1 : PIntegers;
  p2 : PIntegers;
begin
  b := TBitmap.Create;
  b.PixelFormat := pf32Bit;
  w := x2 - x1;
  h := y2 - y1;
// on double la taille de l'image
  b.Width := 2 * w;
  b.Height := 2 * h;
// copie de l'existant doublé
  b.Canvas.CopyRect(
    Rect(0, 0, b.Width, b.Height),
    Canvas,
    Rect(x1, y1, x2, y2)
  );
// dessin de l'ellipse (doublée également)
  b.Canvas.Pen.Color := Pen;
  b.Canvas.Pen.Width := 1;
  b.Canvas.Brush.Color := Brush;
  b.Canvas.Ellipse(1, 1, b.Width - 1, b.Height - 1);
// on recalcule le quart supérieur gauche
  for y := 0 to h - 1 do
  begin
    p  := b.ScanLine[y];
    p1 := b.ScanLine[2 * y];
    p2 := b.SCanLine[2 * y + 1];
    for x := 0 to w - 1 do
    begin
    // pixel[x,y] = moyenne(pixel[2*x+i, 2*y+i]), i = 0..1
      p^ := Blend(p1[0], p1[1], p2[0], p2[1]);
      Inc(p); // pixel suivant
      Inc(p1); // 2 pixels suivants
      Inc(p2); // 2 pixels suivants sur la ligne suivante
    end;
  end;
 // dessiner l'image recalculée
  Canvas.CopyRect(
    Rect(x1, y1, x2, y2),
    b.Canvas,
    Rect(0, 0, w, h)
  );
end;

NB: tu peux utiliser la même méthode avec un facteur x3 ou x4, le résultat est d'autant plus lissé, mais d'autant plus long à calculer et gourmand en mémoire

EDIT: résultat en image

Code :

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

1
2
3
4
5
6
7
8
9
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, Image1.Picture.Graphic);
  Ellipse(Canvas, 10, 10, 60, 60, clRed, clRed);
  Canvas.Pen.Color := clRed;
  Canvas.Brush.Color := clRed;
  Canvas.Ellipse(100,10,150,60);
end;

[Archimède]

Ah! que demande le peuple...
Merci impec

[Archimède]

j'avais commencé avec la méthode du lien de droîde system7...
Sans scanline, c'est plus lent :

ci-joint :

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Types;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Déclarations privées }
    C:Tpoint;
    Rectdisque:TRect;
    mondessin:TBitmap;
    procedure Blend(recta:Trect;cancan:TCanvas);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
const Ra=15;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Mondessin.Free;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 C:=point(100,100);
 
 with Rectdisque do
 begin
  Top := C.Y-Ra-1;
  Left := C.X-Ra-1;
  Right := C.X+Ra+1;
  Bottom := C.Y+Ra+1;
 end;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var i,j:integer;
begin
 with mondessin.Canvas do
 begin
   brush.Color:=clwhite;
   fillrect(cliprect);
   pen.color:=clred;
   brush.Color:=clred;
   ellipse(C.x-Ra,C.Y-Ra,C.x+Ra,C.Y+Ra);
 end;
 
  Blend(rectdisque,mondessin.canvas);
  Canvas.Draw(0,0,mondessin);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
 mondessin:=TBitmap.Create;
 with mondessin do
 begin
  width:=form1.ClientWidth;
  height:=form1.ClientHeight;
 end;
 
end;
 
procedure TForm1.Blend(recta:Trect;cancan:TCanvas);
var i,j,R,V,B:integer;
    bmp:Tbitmap;
begin
 try
  bmp:=Tbitmap.Create;
  with bmp do
  begin
   width:=recta.right-recta.Left;
   height:=recta.Bottom-recta.Top;
  end;
 
  with Bmp do Canvas.CopyRect(Rect(0,0,width,height),Cancan,Recta);
  for i := 1 to bmp.width do
  begin
   for j := 1 to bmp.height do
   begin
    with bmp.canvas do
     begin
      B :=(GetBValue(Pixels[I,J])+GetBValue(Pixels[I-1,J])+GetBValue(Pixels[I+1,J])+GetBValue(Pixels[I,J-1])+GetBValue(Pixels[I,J+1])) div 5;
      V :=(GetGValue(Pixels[I,J])+GetGValue(Pixels[I-1,J])+GetGValue(Pixels[I+1,J])+GetGValue(Pixels[I,J-1])+GetGValue(Pixels[I,J+1])) div 5;
      R :=(GetRValue(Pixels[I,J])+GetRValue(Pixels[I-1,J])+GetRValue(Pixels[I+1,J])+GetRValue(Pixels[I,J-1])+GetRValue(Pixels[I,J+1])) div 5;
    end;
    Cancan.Pixels[recta.left-1+i,recta.top-1+j] := rgb(R,V,B);
   end;
  end;
 
  finally
   bmp.Free;
  end;
 end;
 
end.

et plus lourd, moins efficace et le rendu est moins bon...

merci encore à vous deux.
Je conserve la routine de Paul Toth...

[Paul TOTH]

j'avais commencé avec la méthode du lien de droîde system7...
Sans scanline, c'est plus lent [...] et plus lourd, moins efficace et le rendu est moins bon...

merci encore à vous deux.
Je conserve la routine de Paul Toth...

logique, l'algo est le même, bien que moins bien codé, et il ne double pas la taille de l'image, on obtient donc un flou au lieu d'un antialiasing

[Archimède]

logique, l'algo est le même, bien que moins bien codé, et il ne double pas la taille de l'image, on obtient donc un flou au lieu d'un antialiasing

Effectivement

[Archimède]

Petite remarque, il faudrait peut-être rajouter un try finally pour libérer b à la fin dans ellipse. Un oubli...

[Paul TOTH]

Petite remarque, il faudrait peut-être rajouter un try finally pour libérer b à la fin dans ellipse. Un oubli...

bien vu