Ce script lit une image et dessine un cercle.

Soyez le premier à donner votre avis sur cette source.

Vue 993 fois - Téléchargée 155 fois

Description

unit Unit1; {Copyright Beelog Alone Computing written by denis Bertin and probabily never readen!}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg;

type

  Timage_plus = class (TImage)
    {x et y sont des paramètres de ces fonctions pour désigner le centre hypothétique}
    procedure Dessiner_un_disque(x,y,ray:integer);
    {Un cercle est l'ensemble des points qui sont situé à égal distance de son centre}
    procedure Dessiner_un_cercle(x,y,ray,epaisseur,couleur:integer);
    procedure Lire_une_image(nom_de_l_image:string);
    procedure Effacer(couleur:integer);
    end;


type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses math;

procedure TForm1.Button1Click(Sender: TObject);
const k_ray=24;
var time_before:integer;
begin
time_before:=gettickcount;
{Dessin d'un cercle de coordonées Image1.Width div 2,Image1.Height div 2}
//Timage_plus(self.Image1).Dessiner_un_disque(Image1.Width div 2,Image1.Height div 2,k_ray);
//Timage_plus(self.Image1).Dessiner_un_cercle(Image1.Width div 2,Image1.Height div 2,k_ray div 2,5,rgb(0,255,255)); {Cyan}
//Timage_plus(self.Image1).Dessiner_un_cercle(Image1.Width div 2,Image1.Height div 2,k_ray div 4,5,rgb(255,0,255)); {magenta}
//Timage_plus(self.Image1).Dessiner_un_cercle(Image1.Width div 2,Image1.Height div 2,k_ray div 4*3,5,rgb(255,255,0)); {jaune}
Timage_plus(self.Image1).Dessiner_un_cercle(Image1.Width div 2,Image1.Height div 2,math.Min(Image1.Width div 2,Image1.Height div 2),32,rgb(0,255,0)); {jaune}
//Timage_plus(self.Image1).Canvas.Pixels[Image1.Width div 2,Image1.Height div 2]:=rgb(0,255,0);  {Vert}
invalidaterect(Form1.Handle,nil,false);
if false then messagebox(self.Handle,pchar(inttostr((gettickcount-time_before))+' Millisecondes'),'Coucou',mb_ok);
end; {TForm1.Button1Click}

procedure Timage_plus.lire_une_image(nom_de_l_image:string);
  var i,j:integer;
      une_bitmap:tbitmap;
  begin
  if not sysutils.FileExists(nom_de_l_image) then exit;
  une_bitmap:=tbitmap.create;
  une_bitmap.LoadFromFile(nom_de_l_image);
  for i:=0 to pred(une_bitmap.Width) do
    for j:=0 to pred(une_bitmap.height) do
      if true then
        windows.SetPixel(self.Canvas.Handle,i,j,windows.GetPixel(une_bitmap.Canvas.Handle,i,j)) {syntaxe microsoft}
      else
        self.Canvas.Pixels[math.min(i,pred(self.Width)),math.min(j,pred(self.height))]:=
          une_bitmap.Canvas.Pixels[math.min(i,pred(une_bitmap.Width)),math.min(j,pred(une_bitmap.height))]; {syntaxe Borland}
  une_bitmap.free;
  end; {Timage_plus.lire_une_image}

// Hypothénuse r² = (a²+b²); Pythagore 2400 ans avant aujourd'hui C'est Denis.
//             r = racine carré(a²+b²)

procedure Timage_plus.Dessiner_un_cercle(x,y,ray,epaisseur,couleur:integer);
  var i,j:integer;
      distance,maximum:real;
  begin
  for i:=-ray to ray do
    for j:=-ray to ray do
      begin
      distance:=sqrt(i*i+j*j);
      //if (distance<ray) then if (distance>(ray-epaisseur)) then
      if (distance<ray) and (distance>(ray-epaisseur)) then
        begin
        if (i<>0) and (j<>0) then
          self.Canvas.Pixels[x+i,y+j]:=couleur
        else
          self.Canvas.Pixels[x+i,y+j]:=couleur;
        end;
      end;
  end; {Timage_plus.Dessiner_un_cercle}

procedure Timage_plus.Dessiner_un_disque(x,y,ray:integer);
  var i,j:integer;
      distance,maximum:real;
  begin
  maximum:=sqrt(2*ray*ray);
  for i:=-ray to ray do
    for j:=-ray to ray do
      begin
      distance:=sqrt(i*i+j*j);
      if distance<ray then
        begin
        if true then
          begin // La fonction SetPixel de Microsoft temps estimé 375 millisecondes.
          windows.SetPixel(self.Canvas.Handle,x+i,y+j,255);
          end
        else
          begin //Le tableau [x,y] de Borland Delphi The 7 temps estimé 1031 millisecondes.
          if (i<>0) and (j<>0) then
            self.Canvas.Pixels[x+i,y+j]:=
              rgb(255-round(255*(distance/maximum)),0,0)
          else
            self.Canvas.Pixels[x,j]:=rgb(255,255,255);
          end;
        end;
      end;
  end; {Timage_plus.Dessiner_un_disque}

procedure TForm1.FormCreate(Sender: TObject);
begin
Timage_plus(Image1).lire_une_image('C:_Euclide.bmp');
end;

procedure TForm1.Button2Click(Sender: TObject);
  begin
  Timage_plus(self.Image1).Effacer(rgb(0,0,0));
  Timage_plus(self.Image1).Dessiner_un_disque(256,256,100);
  invalidaterect(Form1.Handle,nil,false);
  end;

procedure Timage_plus.effacer(couleur:integer);
  var x,y:integer;
  begin
  for x:=0 to pred(self.Width) do
    for y:=0 to pred(self.Height) do
      Windows.SetPixel(self.Canvas.Handle,x,y,couleur);
  end;

end.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

denisbertin
Messages postés
197
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
27 septembre 2019
1 -
Trois après-midi et une soirée pour le divulguer à votre intention. Permet de créer un cercle avec la méthode de pythagore selon lequel r²=a²+b². Si la racine carré de cette distance est inférieur ou égal au rayon, l'ensemble de ces points forment un disque.
denisbertin
Messages postés
197
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
27 septembre 2019
1 -
J'ai bien rajouté la balise <code> au début de mon snippet et aussi à la fin avec
la balisede fermeture mais il semble du'il ne soit pas interprété correctement par votre outil de promotion du code comme je l'ai compris. pouvez-vous le vérifier ?
jordane45
Messages postés
27005
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
10 décembre 2019
318 > denisbertin
Messages postés
197
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
27 septembre 2019
-
le </code> n'était pas au bon endroit. tu l'avais mis à la fin de la première ligne.
De plus tu n'avais pas précisé le langage dans la balise de code
Le fonctionnement des balises est expliqué ici : https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
jordane45
Messages postés
27005
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
10 décembre 2019
318 -
Merci de corriger ton code en y mettant la coloration syntaxique (les balises de code).
Sans ça..ton message sera supprimé.

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.