Points de différents diamètres et couleurs avec la méthode ellipse de tcanvas

Soyez le premier à donner votre avis sur cette source.

Vue 5 108 fois - Téléchargée 357 fois

Description

Tracer un point de diamètre 1 à 255 sur un Canvas : utilisation de la méthode Ellipse de TCanvas qui dessine une ellipse circonscrite dans un rectangle.
Ici l'ellipse est circulaire puisque circonscrite dans un carré.
Les propriétés Pen et Brush sont de couleur identique.
Il s'agit ensuite de déterminer le diamètre ("épaisseur") de ce point.
On obtient donc bien la représentation graphique d'un point.

En réponse à une question posée ici :

http://www.delphifr.com/forum.v2.aspx?ID=446412&nb=4

j'ai fait quelques essais qui ont donné ce code.

Je le poste afin d'en faire profiter le plus grand nombre.

Je ne l'ai pas encore commenté, je le ferai plus tard.
Mais je pense qu'il est assez élémentaire et facile à comprendre, même pour un débutant.

Quelques précisions néanmoins :

J'ai utilisé un type Record (APoint = record) pour stocker les informations relatives au point qui vient d'être dessiné.

Ce Record est ensuite lui-même stocké dans un tableau dynamique de Record (TTabPoints: array of APoint). Sa longueur sera augmentée à chaque ajout de données.

Cela nous servira pour redessiner les points à chaque évènement OnRepaint du Canvas. Sinon nos points ne seraient pas redessinés au réaffichage de notre Form.
Pour le vérifier, il suffit de supprimer le code dans cette procédure, et de minimiser ou de masquer (en partie ou totalement) notre Form... ;-)

D'ailleurs, la réinitialisation de ce Tableau dynamique à 0, suivie d'un Refresh, provoque l'effacement de tous les points.

Voilà.
Ce ne sont pas là des choses bien compliquées, mais je pense que ça peut être utile.

Bonne prog' à tou(te)s :-p

Code ci-dessous pour ceux qui ne veulent pas télécharger le zip.

Source / Exemple :


unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    btnClear: TButton;
    GroupBox1: TGroupBox;
    seWidth: TSpinEdit;
    btnColorDialog: TButton;
    ColorDialog: TColorDialog;
    Label1: TLabel;
    Label2: TLabel;
    pnlNumPoints: TPanel;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnColorDialogClick(Sender: TObject);
  end;

type
  APoint = record
    Cnvs: TCanvas;
    X, Y: Word;
    D: Byte;
    Col: TColor;
  end;

var
  Form1: TForm1;
  TTabPoints: array of APoint;
  LongTab: Word;
  CurrentColor: TColor;

implementation

{$R *.DFM}

procedure InitialiseTTabPoints;
begin
  with TForm1 do
  begin
    SetLength(TTabPoints, 0);
    LongTab := 0;
  end;
end;

procedure StockeTTabPoints(Cnvs: TCanvas; X, Y: Word; D: Byte; Col: TColor);
begin
  with TForm1 do
  begin
    Inc(LongTab);
    SetLength(TTabPoints, LongTab);
    TTabPoints[LongTab -1].Cnvs := Cnvs;
    TTabPoints[LongTab -1].X := X;
    TTabPoints[LongTab -1].Y := Y;
    TTabPoints[LongTab -1].D := D;
    TTabPoints[LongTab -1].Col := Col;
  end;
end;

procedure DessinePoint(Cnvs: TCanvas; X, Y: Word; D: Byte; Col: TColor;
  const Add: Bool = False);
var R: Byte;
begin
  if D < 1 then Exit;
  if D > 1 then
  begin
    R := D div 2;
    Cnvs.Pen.Color := Col;
    Cnvs.Brush.Color := Col;
    Cnvs.Ellipse(X - R, Y - R, X - R + D, Y - R + D);
  end
  else
    Cnvs.Pixels[X, Y] := Col;
  if Add then
    StockeTTabPoints(Cnvs, X, Y, D, Col);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var E: Byte;
begin
  E := seWidth.Value;
  DessinePoint(Canvas, X, Y, E, CurrentColor, True);
  pnlNumPoints.Caption := IntToStr(LongTab);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitialiseTTabPoints;
end;

procedure TForm1.FormPaint(Sender: TObject);
var i: Integer;
begin
  for i := 0 to LongTab -1 do
    with TTabPoints[i] do
      DessinePoint(Cnvs, X, Y, D, Col, False);
end;

procedure TForm1.btnClearClick(Sender: TObject);
begin
  InitialiseTTabPoints;
  pnlNumPoints.Caption := IntToStr(LongTab);
  Refresh;
end;

procedure TForm1.btnColorDialogClick(Sender: TObject);
begin
  if ColorDialog.Execute then
  begin
    CurrentColor := ColorDialog.Color;
    ColorDialog.Color := CurrentColor;
  end;
end;

end.

Conclusion :


Compilable à partir de D4, avant je ne pense pas à cause du tableau dynamique :-(

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_ManChesTer
Messages postés
378
Date d'inscription
vendredi 20 octobre 2000
Statut
Modérateur
Dernière intervention
11 décembre 2013
-
Japee,

Rassure-toi, je me suis douté que c'etais de l'inatention, ca nous arrive à tous, surtout quand on bosse trops, il n'y a pas de honte à ca.

Une bonne astuce pour eviter se genre de probleme est de relire le code à tete reposée, ca permet souvent de trouvé des erreurs idiotes ou des oublis, c'est normal ....

Encore un chipo (pour le fun) :

procedure StockeTTabPoints(Canvas: TCanvas; PX, PY: Word; Diam: Byte; Color: TColor);
begin
SetLength(TTabPoints, Succ(LongTab));
with TTabPoints[LongTab] do
begin
Cnvs := Canvas;
X := PX;
Y := PY;
D := Diam;
Col := Color;
end;
Inc(LongTab);
end;

Bon Coding...

ManChesTer.
japee
Messages postés
1708
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
5 octobre 2019
1 -
Exact !

De même, maintenant que tu as attiré mon attention dessus, pareil ici :

procedure InitialiseTTabPoints;
begin
with TForm1 do // <- inutile !
begin
SetLength(TTabPoints, 0);
LongTab := 0;
end;
end;

Honte à moi, mais bon, j'ai bossé un peu vite sur ce code.

J'essaierai dorénavant à l'avenir de ne plus recommencer...

Sniff...

Si tu continues à chipoter comme ça, je vais être obligé de tout refaire morceau par morceau, lol :-p

Bon coding à toi...

japee
cs_ManChesTer
Messages postés
378
Date d'inscription
vendredi 20 octobre 2000
Statut
Modérateur
Dernière intervention
11 décembre 2013
-
Note aussi que

procedure StockeTTabPoints(Cnvs: TCanvas; X, Y: Word; D: Byte; Col: TColor);
begin
with TForm1 do <== sert a rien....
begin
SetLength(TTabPoints, Succ(LongTab));
TTabPoints[LongTab].Cnvs := Cnvs;
TTabPoints[LongTab].X := X;
TTabPoints[LongTab].Y := Y;
TTabPoints[LongTab].D := D;
TTabPoints[LongTab].Col := Col;
Inc(LongTab);
end;
end;

Mais c'est toujours du chipotage.

Bon Coding....

ManChesTer.
japee
Messages postés
1708
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
5 octobre 2019
1 -
Merci pour ton appréciation, Manchester.

J'aimes bien quand tu chipotes, ça m'apprend toujours quelque chose ;)

Bon coding à toi...

japee
cs_ManChesTer
Messages postés
378
Date d'inscription
vendredi 20 octobre 2000
Statut
Modérateur
Dernière intervention
11 décembre 2013
-
Pas mal japee, cependant,

j'aurais plutot ecrit :

procedure StockeTTabPoints(Cnvs: TCanvas; X, Y: Word; D: Byte; Col: TColor);
begin
with TForm1 do
begin
SetLength(TTabPoints, Succ(LongTab));
TTabPoints[LongTab].Cnvs := Cnvs;
TTabPoints[LongTab].X := X;
TTabPoints[LongTab].Y := Y;
TTabPoints[LongTab].D := D;
TTabPoints[LongTab].Col := Col;
Inc(LongTab);
end;
end;

procedure DessinePoint(Cnvs: TCanvas; X, Y: Word; D: Byte; Col: TColor;
const Add: Bool = False);
var R: Byte;
begin
if D < 1 then Exit;
with cnvs do
begin
R := D shr 1;
Pen.Color := Col;
Brush.Color := Col;
Dec(X,R);
Dec(Y,R);
Ellipse(X, Y, X + D, Y + D);
end;
if Add then
StockeTTabPoints(Cnvs, X, Y, D, Col);
end;

Mais c'est du chipotage, lol

Bon Coding....

ManChesTer.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.