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

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

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.