Ce script lit une image et dessine un cercle.

Soyez le premier à donner votre avis sur cette source.

Vue 467 fois - Téléchargée 25 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

Commenter la réponse de denisbertin

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.