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
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
Tu veux sans doute parler de quelque chose de mieux qu'un simple TShape en stCircle ?
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.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.
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.
ça ne marche pas...
et même en faisant ça, c'est encore cannelé....
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.
@+
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)
merci, je vais me lancer dans ta méthode. C'est toujours net et précis avec toi
merci à vous deux .
tient, voici un exemple
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
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;
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;
Ah! que demande le peuple...
Merci impec
j'avais commencé avec la méthode du lien de droîde system7...
Sans scanline, c'est plus lent :
ci-joint :
et plus lourd, moins efficace et le rendu est moins bon...
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.
merci encore à vous deux.
Je conserve la routine de Paul Toth...
Petite remarque, il faudrait peut-être rajouter un try finally pour libérer b à la fin dans ellipse. Un oubli...
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager