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