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 095 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

japee
Messages postés
1803
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
7 juillet 2019
-
Et merci à Kenavo sans qui j'aurais négligé les chiffres impairs pour le diamètre des points.

Car pourquoi, en effet ?

Je pense que j'étais motivé par d'obscures considérations, tenant plus de l'ostracisme le plus perverti que d'arguments réellement défendables.

J'en demande pardon aux jurés ainsi qu'aux familles des victimes...

(Pardon pour ce délire :-p)
ni69
Messages postés
1529
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
5 juillet 2010
6 -
Objectif parfaitement rempli japee ;)
Bravo !
japee
Messages postés
1803
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
7 juillet 2019
-
Merci, ni69 :-)
cs_Kenavo
Messages postés
759
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
1 octobre 2009
-
Si j'ai pu t'éviter un impair ..... :-))
japee
Messages postés
1803
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
7 juillet 2019
-
Oui, Kenavo, lol ;)

Mais bon, la "pairfection" n'étant pas de ce monde...

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.