L'Unité Fast bitmap adresse un Bitmap avec ces fonctions
Contenu du snippet
unit U_fast_bitmap;
{L'Unité Fast bitmap adresse un Bitmap avec ces fonctions élémentaire comme circle}
{Une unité écrite par denis bertin pour accéler le mode Alias, écrit par denis bertin}
{L'accès à la lecture ou l'écriture de pixel dans une image. (c) db 15-07-2009}
{Et améliorer après l'avoir poster sur internet pour obtenir TFastBitmap2}
interface
uses Windows, Graphics, Classes, Contnrs, SysUtils, my_math;
var globale_stop : boolean;
const max_size_vertical = 32000;
type PTStyle = (PTS_Square,PTS_round,PTS_Triangle);
//Utilisation : Créer l'object avec sa méthode create
//et assigner lui un bitmap de chez Borland
//Faire des opérations sur les pixels Get et Set Pixels
//Puis assigner en retour le bitmap à obtenir à partir de celui dessinné.
//Normalement Pixel:=adresse_base_du_bitmap + largeur de l'image * Y + X;
type
Parray_maxi = ^Tarray_maxi;
Tarray_maxi = array[00..max_size_vertical] of pointer;
pointer_array_matrice = ^type_array_matrice;
type_array_matrice = array [0..24] of integer; // coefficients matrice filtre maxi 5x5
type
TTable=array[0..0] of integer;
PTable = ^TTable;
TFastBitmap = class {gagne 2000% en lecture le dbs:15-07-2009}
abitmap:Graphics.TBitmap;
awindow:hwnd;
constructor Create(window:hwnd);
destructor Destroy; override;
procedure Assign(Source: TPersistent);
function Lecture_de_la_scanline:boolean;
procedure Liberation_de_la_scanline;
function Height:integer;
function Width:integer;
function Get_pixel(x,y:integer):TColor;
procedure Set_pixel(x,y:integer; color:TColor);
procedure For_a_rectangle_filling(sa_couleur:TColor);
//procedure Resize(byx,byy:integer);
private
size : integer;
scan : Parray_maxi;
end; {TFastBitmap}
TFastBitmap_base = object
public
Bmp : Graphics.TBitMap;
W,H,Scan0,MLS:integer;
end;
TFastBitmap_8bits = object(TFastBitmap_base)
procedure Copy(iBmp : Graphics.tBitMap);
function GetPixel(X,Y : Integer):byte;
procedure SetPixel(X,Y : Integer; alpha:byte);
end;
TFastBitmap2 = object(TFastBitmap_base)
public
BPP : integer;
procedure Creer(x,y:integer);
procedure Copy(iBmp : Graphics.tBitMap);
procedure Init(iBmp : Graphics.tBitMap);
procedure Handle(A:hbitmap);
procedure Free_bmp;
procedure Determine;
procedure Free;
procedure Set_Pixel_in_limite_variation_Y(xx,y :integer; color : TColor);
procedure Set_Pixel_in_limite_variation_Y_sans_tab(xx,y :integer; color : TColor);
function GetPixel_in_limite_variation_Y(xx,y : Integer) : tColor;
function GetPixel_in_limite_variation_Y_sans_tab(xx,y : Integer) : tColor;
function GetPixel_in_limite(X,Y : Integer) : tColor;
procedure SetPixel_in_limite(x,y :integer; color : TColor);
function GetPixel(X,Y : Integer) : tColor;
procedure SetPixel(x,y :integer; color : TColor);
procedure RectangleFilling(color : TColor);
procedure ligne_horizontale(y:integer; color : TColor);
procedure ligne_vertical(x:integer; color : TColor);
procedure ligne_horizontale_fromage(a,b,y:integer; color : TColor);
procedure ligne_verticale_fromage(x,a,b:integer; color : TColor);
end;
Tdbbitmap = class
public
constructor Create(un_bitmap:tbitmap);
destructor Destroy; override;
procedure Initialise;
procedure Setpixel_in_limite(x,y:integer; une_couleur:tcolorref);
procedure Setpixel(x,y:integer; une_couleur:tcolorref);
procedure Setpixel_transparent(x,y:integer; une_couleur:tcolorref; transparent:real);
function Getpixel(x,y:integer):tcolorref;
procedure Cross_pixel(x,y:integer; une_couleur:tcolorref);
procedure Drawrect(x,y,xx,yy:integer; une_couleur:tcolorref);
procedure Drawrect_round(x,y,xx,yy:real; une_couleur:tcolorref);
procedure Drawrect_transparent(x,y,xx,yy:integer; une_couleur:tcolorref; transparent:real);
procedure FillCircle(x,y,rayon:integer; une_couleur:tcolorref; light:boolean);
procedure FillCircle_single(x,y,rayon:single; une_couleur:tcolorref; light:boolean);
procedure FillRectSoft(x,y,xx,yy:integer; une_couleur:tcolorref); //Le 15.12.2019
procedure Fillrect_real(x,y,xx,yy:real; une_couleur:tcolorref);
procedure Fillrect(x,y,xx,yy:integer; une_couleur:tcolorref);
procedure CrossRect(x,y,xx,yy,alpha:integer; une_couleur:tcolorref);
procedure RoundRect(x,y,xx,yy,alpha:integer; une_couleur:tcolorref);
Procedure Denis_line_hori(x,y,xx:integer; une_couleur:tcolorref);
Procedure Denis_line_hori_square_gradian(x,y,xx:integer; m:real; rect:trect;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
Procedure Denis_line_hori_parralelle(x,y,xx:integer; rect:trect; angle:integer;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
Procedure Denis_line_hori_graduate(x,y,xx:integer; ptA,ptB:my_math.Point2D; m:real;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
Procedure Denis_line_hori_circulaire(x,y,xx:integer; borne_central:tpoint; m:real;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
Procedure Denis_line(a,b,c,d:real; color:tcolorref);
Procedure Denis_line_single_epaisseur(a,b,c,d:real; color:tcolorref; width:integer; style:U_fast_bitmap.PTStyle);
Procedure Denis_line_single(a,b,c,d:real; color:tcolorref);
Procedure Denis_line_alias(a,b,c,d:real; color:tcolorref);
Procedure Denis_line_in_between(a,b,c,d:real; depart,color:tcolorref; stroke_mitter,stroke_bold:boolean; stroke_width:integer);
Procedure Denis_line_limite(a,b,c,d:real; color:tcolorref; maxix,maxiy:real; with_sinusoide,spectral,smooth:boolean;
Repetition,Amplitude,lumiere,saturation:real);
Procedure Denis_line_progressive(a,b,c,d:real; color,second_color:tcolorref; stroke_width:integer);
Procedure Flood_Fill(x,y:integer);
procedure Applique_bitmap;
public
abitmap:tbitmap;
bitmap_struct:TBitmapInfo;
taille_bitmap:integer;
pointer_bitmap:PTable;
flood_color:tcolorref;
end; {Tdbbitmap-intégré par denis Bertin le 17.3.2014}
implementation
uses k_erreur,g_base,math,wutil,utile,hls_rvb,deformat,u_object;
constructor TFastBitmap.Create(window:hwnd);
begin
inherited Create;
self.abitmap:=Graphics.tbitmap.create;
self.scan:=nil;
self.size:=0;
self.awindow:=window;
end;
destructor TFastBitmap.Destroy;
begin
self.Liberation_de_la_scanline;
self.abitmap.free;
inherited Destroy;
end;
procedure TFastBitmap.Assign(Source: TPersistent);
begin
self.abitmap.Assign(Source);
self.Liberation_de_la_scanline;
end;
function TFastBitmap.lecture_de_la_scanline:boolean;
var i:integer;
begin
try
begin
if self.abitmap.PixelFormat<>pf24bit then
self.abitmap.PixelFormat:=graphics.pf24bit;
end
except
on EOutOfResources do
begin
//spécifique à l'application
k_erreur.MessageBox(self.awindow,k_erreur.Err_Fichier_trop_volumineux,mb_iconstop+id_ok);
lecture_de_la_scanline:=false;
exit;
end;
end;
size:=self.abitmap.Height*sizeof(pointer);
getmem(self.scan,size);
for i:=0 to pred(self.abitmap.Height) do self.scan[i]:=Self.abitmap.scanline[i];
lecture_de_la_scanline:=true;
end; {TFastBitmap.lecture_de_la_scanline}
procedure TFastBitmap.Liberation_de_la_scanline;
begin
if self.scan<>nil then
freemem(self.scan,self.size);
self.scan:=nil;
self.size:=0;
end;
function TFastBitmap.get_pixel(x,y:integer):TColor;
var p:^byte;
color:tcolorref;
begin
if self.scan=nil then
lecture_de_la_scanline;
if (y>=self.abitmap.height) or (x>=self.abitmap.width) or (x<0) or (y<0) then
begin
get_pixel:=g_base.rgb_noir;
end
else
begin
p:=self.scan^[y];
inc(p,x*3);
color:=P^ shl 16;
inc(p);
inc(color,p^ shl 8);
inc(p);
inc(color,p^);
get_pixel:=color;
end;
end; {TFastBitmap.get_pixel}
function TFastBitmap.width:integer;
begin
result:=self.abitmap.Width;
end;
function TFastBitmap.Height:integer;
begin
result:=self.abitmap.Height;
end;
procedure TFastBitmap.set_pixel(x,y:integer; color:TColor);
var p:pchar; {PByteArray;}
q:pbytearray;
d:integer;
begin
if self.scan=nil then
lecture_de_la_scanline;
if not ((y>=self.abitmap.height) or (x>=self.abitmap.width) or (y<0) or (x<0)) then
begin
q:=Self.scan[y];
d:=x*3;
q[d]:=(color shr 16) and 255;
q[d+1]:=(color shr 8) and 255;
q[d+2]:=color and 255;
end;
end; {TFastBitmap.set_pixel}
procedure TFastBitmap.For_a_rectangle_filling(sa_couleur:TColor);
var i,j,ii,jj:integer;
begin
ii:=self.width-1;
jj:=self.Height-1;
for i:=0 to ii do for j:=0 to jj do self.Set_pixel(i,j,sa_couleur);
end;
procedure TFastBitmap_8bits.Copy(iBmp : Graphics.tBitMap);
begin
try
if iBmp.PixelFormat<>pf8bit then
iBmp.PixelFormat:=pf8bit;
Bmp:=iBmp;
Scan0:=Integer(BMP.ScanLine[0]);
if Bmp.height=1 then
MLS:=Integer(Scan0)
else
MLS:=Integer(BMP.ScanLine[1]) - Scan0;
W:=Bmp.width;
H:=Bmp.Height;
except Scan0:=0; end;
end;
function TFastBitmap_8bits.GetPixel(X,Y : Integer):byte;
begin
if Scan0=0 then begin result:=0; exit; end;
if (x>=0) and (y>=0) and (x<self.W) and (y<self.H) then
Result:=pbyte(Scan0+Y*MLS+X)^
else
Result:=0;
end;
procedure TFastBitmap_8bits.SetPixel(X,Y:Integer; alpha:byte);
begin
if Scan0=0 then exit;
if (x>=0) and (y>=0) and (x<self.W) and (y<self.H) then
pbyte(Scan0+Y*MLS+X)^:=alpha;
end;
{--------------------------- TFastBitmap2 -------------------------------------}
{Amélioration des fonctions Get/SET BitMap en utilisant le langage d'assemblage}
procedure TFastBitmap2.creer(x,y:integer);
begin
Bmp:=Graphics.tBitMap.create;
Bmp.width:=x;
Bmp.height:=y;
Self.determine;
end;
procedure TFastBitmap2.Copy(iBmp:Graphics.tBitMap);
begin
Bmp:=iBmp;
Self.determine;
end;
procedure TFastBitmap2.Handle(a:hbitmap);
begin
Bmp:=Graphics.tBitMap.create;
Bmp.Handle:=a;
Self.determine;
end;
procedure TFastBitmap2.Free_bmp;
begin
try self.bmp.free; except end;
end;
procedure TFastBitmap2.Init(iBmp : Graphics.tBitMap);
begin
Bmp:=Graphics.tBitMap.create;
Bmp.Assign(iBmp);
Self.determine;
end;
procedure TFastBitmap2.determine;
begin
try
if (Bmp=nil) or (Bmp.width=0) then
begin
Scan0:=0; exit;
end;
if Bmp.PixelFormat<>pf24bit then
Bmp.PixelFormat:=pf24bit;
Scan0:=Integer(BMP.ScanLine[0]);
if Bmp.height=1 then
MLS :=Integer(Scan0)
else
MLS :=Integer(BMP.ScanLine[1]) - Scan0;
BPP := 3; // pour pf24bit
W:=Bmp.width;
H:=Bmp.Height;
except
Scan0:=0;
end;
end;
procedure TFastBitmap2.free;
begin
self.bmp.free;
end;
(*
function tFastBitmap2.GetPixel(X,Y : Integer) : tColor; {Fonctionne}
var Scan : integer; {$IFOPT O-} pRGB3 : pRGBTriple; {$ENDIF}
begin Scan:=Scan0 + Y*MLS + X*BPP;
{$IFOPT O+}
asm
mov eax,Scan; //Obtenir l'adresse
mov ebx,[eax]; //Lire le mot dans EBX
mov eax,ebx; //Déplacer ce mot dans EAX
mov ecx,ebx; //Déplacer ce mot dans ECX
shr eax,$10; //tourner de 16 bits
and eax,$ff;
and ebx,$ff00
or ebx,eax;
shl ecx,$10;
and ecx,$ff0000;
or ebx,ecx;
end; {asm}
{$ELSE}
pRGB3 := pRGBTriple(Scan);
with pRGB3^ do Result:=RGB(rgbtRed,rgbtGreen,rgbtBlue);
{$ENDIF}
end;
*)
(*
function tFastBitmap2.GetPixel(X,Y : Integer) : tColor; {Fonctionne}
var Scan : integer; {$IFOPT O-} pRGB3 : pRGBTriple; {$ENDIF}
begin Scan:=Scan0 + Y*MLS + X*BPP;
{$IFOPT O+}
asm
mov eax,Scan; //Obtenir l'adresse
mov bx,[eax]; //Lire le mot dans EBX
mov cl,[eax+2];
mov al,bl;
shl eax,$10;
and ebx,$0000ff00;
add ebx,eax;
add ebx,ecx;
end; {asm}
{$ELSE}
pRGB3 := pRGBTriple(Scan);
with pRGB3^ do Result:=RGB(rgbtRed,rgbtGreen,rgbtBlue);
{$ENDIF}
end;
*)
(*
function tFastBitmap2.GetPixel(X,Y : Integer) : tColor; {Fonctionne}
var Scan : integer; {$IFOPT O-} pRGB3 : pRGBTriple; {$ENDIF}
begin Scan:=Scan0 + Y*MLS + X*BPP;
{$IFOPT O+}
asm
mov eax,Scan;
mov cl,[eax];
mov dl,[eax+$01];
mov al,[eax+$02];
and eax,$000000ff;
and edx,$000000ff;
shl edx,$08;
or eax,edx;
xor edx,edx;
mov dl,cl;
shl edx,$10;
or eax,edx;
mov ebx,eax;
end; {asm}
{$ELSE}
pRGB3 := pRGBTriple(Scan);
with pRGB3^ do Result:=RGB(rgbtRed,rgbtGreen,rgbtBlue);
{$ENDIF}
end;
*)
procedure tFastBitmap2.Set_Pixel_in_limite_variation_Y(xx,y :integer; color : TColor);
begin
if Scan0=0 then exit;
with pRGBTriple(Scan0 + Y*MLS + XX)^ do //la voilà.
begin
rgbtRed :=color; // and $ff;
rgbtGreen:=color shr 8; // and $ff;
rgbtBlue :=color shr 16; // and $ff;
end;
end;
procedure tFastBitmap2.Set_Pixel_in_limite_variation_Y_sans_tab(xx,y :integer; color : TColor);
begin
if Scan0=0 then exit;
with pRGBTriple(Y*MLS+XX)^ do
begin
rgbtRed :=color;
rgbtGreen:=(color shr 8);
rgbtBlue :=(color shr 16);
end;
end;
function tFastBitmap2.GetPixel_in_limite_variation_Y(xx,y : Integer) : tColor;
begin
if Scan0=0 then begin result:=0; exit; end;
with pRGBTriple(Scan0 + Y*MLS + xx)^ do
Result:=rgbtRed or (rgbtGreen shl 8) or (rgbtBlue shl 16); {and $00ff00 and $ff0000}
//Result:=RGB(rgbtRed,rgbtGreen,rgbtBlue);
end;
function tFastBitmap2.GetPixel_in_limite_variation_Y_sans_tab(xx,y : Integer) : tColor;
begin
if Scan0=0 then begin result:=0; exit; end;
with pRGBTriple(Y*MLS + xx)^ do
Result:=rgbtRed or (rgbtGreen shl 8) or (rgbtBlue shl 16); {and $00ff00 and $ff0000}
end;
procedure tFastBitmap2.SetPixel_in_limite(x,y :integer; color : TColor);
begin
if Scan0=0 then exit;
try
with pRGBTriple(Scan0 + Y*MLS + X*BPP)^ do
begin
rgbtRed :=color; // and $ff;
rgbtGreen:=color shr 8; // and $ff;
rgbtBlue :=color shr 16; //and $ff;
(*
rgbtRed :=GetRValue(color);
rgbtGreen:=GetGValue(color);
rgbtBlue :=GetBValue(color);
*)
end;
except end;
end;
function tFastBitmap2.GetPixel_in_limite(X,Y : Integer) : tColor;
begin
if Scan0=0 then begin result:=0; exit; end;
try
with pRGBTriple(Scan0 + Y*MLS + X*BPP)^ do
Result:=rgbtRed or (rgbtGreen shl 8) or (rgbtBlue shl 16);
//Result:=RGB(rgbtRed,rgbtGreen,rgbtBlue);
except end;
end;
function tFastBitmap2.GetPixel(X,Y : Integer) : tColor;
begin
if Scan0=0 then begin result:=0; exit; end;
try
if (x>=0) and (y>=0) and (x<self.W) and (y<self.H) then
begin
with pRGBTriple(Scan0 + Y*MLS + X*BPP)^ do
Result:=rgbtRed or (rgbtGreen shl 8) or (rgbtBlue shl 16);
//Result:=RGB(rgbtRed,rgbtGreen,rgbtBlue);
end
else
GetPixel:=g_base.rgb_blanc;
except
Scan0:=0;
end;
end;
procedure tFastBitmap2.SetPixel(x,y :integer; color : TColor);
//{$IFOPT O+} var scan:integer; ENDIF}
begin
if Scan0=0 then exit;
if (x>=0) and (y>=0) and (x<self.W) and (y<self.H) then
begin
if false then
begin
{$IFOPT O+}
Scan:=Scan0 + Y*MLS + X*BPP;
{$ENDIF}
if false then
begin
{$IFOPT O+}
asm
mov ebx,Scan;
add ebx,2;
mov eax,color;
mov [ebx],al;
dec ebx;
shr eax,$08;
mov [ebx],al;
dec ebx;
shr eax,$08;
mov [ebx],al;
end; {asm}
{$ELSE}
{$ENDIF}
end
end
else
begin
with pRGBTriple(Scan0 + Y*MLS + X*BPP)^ do
begin
rgbtRed :=color; // and $ff;
rgbtGreen:=(color shr 8); // and $ff;
rgbtBlue :=(color shr 16); // and $ff;
(*
rgbtRed :=GetRValue(color);
rgbtGreen:=GetGValue(color);
rgbtBlue :=GetBValue(color);
*)
end;
end;
end
end;
(*
procedure tFastBitmap2.SetPixel(x,y :integer; color : TColor);
var Scan : integer;
begin
Scan:=Scan0 + Y*MLS + X*BPP;
with pRGBTriple(Scan)^ do begin
rgbtRed :=GetRValue(color);
rgbtGreen:=GetGValue(color);
rgbtBlue :=GetBValue(color);
end;
end;
*)
procedure tFastBitmap2.ligne_horizontale(y:integer; color : TColor);
var x:integer;
begin
for x:=0 to pred(self.w) do SetPixel(x,y,color);
end; {ligne_horizontale}
procedure tFastBitmap2.ligne_vertical(x:integer; color : TColor);
var y:integer;
begin
for y:=0 to pred(self.h) do SetPixel(x,y,color);
end; {ligne_vertical}
procedure tFastBitmap2.ligne_horizontale_fromage(a,b,y:integer; color : TColor);
var x:integer;
begin
for x:=a to b do SetPixel(x,y,color);
end;
procedure tFastBitmap2.ligne_verticale_fromage(x,a,b:integer; color : TColor);
var y:integer;
begin
for y:=a to b do SetPixel(x,y,color);
end;
procedure tFastBitmap2.RectangleFilling(color : TColor);
var y,x, ScanY,ScanYX : integer; R,G,B : byte;
begin R:=GetRValue(color);
G:=GetGValue(color);
B:=GetBValue(color);
for y:=0 to pred(H) do begin
ScanY:=Scan0 + Y*MLS;
for x:=0 to pred(W) do begin
ScanYX:=ScanY + X*BPP;
with pRGBTriple(ScanYX)^ do begin
rgbtRed :=R;
rgbtGreen:=G;
rgbtBlue :=B;
end;
end;
end;
end;
constructor Tdbbitmap.create(un_bitmap:tbitmap);
begin
inherited create;
self.abitmap:=un_bitmap;
self.initialise;
end;
procedure Tdbbitmap.initialise;
begin
taille_bitmap:=(self.abitmap.Width*self.abitmap.Height) shl 2;
getmem(pointer_bitmap,taille_bitmap);
with bitmap_struct.bmiHeader do
begin
bisize:=sizeof(bitmap_struct.bmiHeader);
biWidth:=self.abitmap.Width;
biHeight:=self.abitmap.Height;
biPlanes:=1;
bibitcount:=32;
bicompression:=BI_RGB;
biSizeImage:=0;
biXPelspermeter:=1;
biYPelspermeter:=1;
biClrUsed:=0;
biClrImportant:=0;
end;
GetDIBits(self.abitmap.Canvas.Handle,self.abitmap.Handle,
0,bitmap_struct.bmiHeader.biHeight,pointer_bitmap,bitmap_struct,DIB_RGB_COLORS);
end;
destructor Tdbbitmap.destroy;
begin
freemem(pointer_bitmap,taille_bitmap);
inherited destroy;
end;
function Tdbbitmap.Getpixel(x,y:integer):tcolorref;
var color:tcolorref;
begin
if (x>=0) and (y>=0) and (x<self.abitmap.Width) and (y<self.abitmap.Height) then
begin
color:=pointer_bitmap[(pred(self.abitmap.Height)-y)*self.abitmap.Width+x];
result:=rgb((color shr 16) and $ff,(color shr 8) and $ff,color and $ff);
end
else
result:=g_base.rgb_noir;
end; {Tdbbitmap.Getpixel}
procedure Tdbbitmap.Cross_pixel(x,y:integer; une_couleur:tcolorref);
begin
self.Setpixel(x,y,une_couleur);
self.Setpixel(x-1,y-1,une_couleur);
self.Setpixel(x+1,y+1,une_couleur);
self.Setpixel(x-1,y+1,une_couleur);
self.Setpixel(x+1,y-1,une_couleur);
end; {Tdbbitmap.Cross_pixel}
Procedure Tdbbitmap.Flood_Fill(x,y:integer);
begin
if Getpixel(x,y)=g_base.rgb_blanc then ///<>color
begin
Setpixel(x,y,self.flood_color);
if x-1>=0 then Flood_Fill(x-1,y);
if x+1<self.abitmap.Width then Flood_Fill(x+1,y);
if y-1>=0 then Flood_Fill(x,y-1);
if y+1<self.abitmap.Height then Flood_Fill(x,y+1);
end;
end;
procedure Tdbbitmap.setpixel_in_limite(x,y:integer; une_couleur:tcolorref);
var color:tcolorref;
begin
color:=rgb((une_couleur shr 16) and $ff,(une_couleur shr 8) and $ff,une_couleur and $ff);
pointer_bitmap[(pred(self.abitmap.Height)-y)*self.abitmap.Width+x]:=color;
end;
procedure Tdbbitmap.Setpixel_transparent(x,y:integer; une_couleur:tcolorref; transparent:real);
var dos_couleur:tcolorref;
coefficient_alpha:real;
begin
if (x>=0) and (y>=0) and (x<self.abitmap.Width) and (y<self.abitmap.Height) then
begin
dos_couleur:=self.Getpixel(x,y);
coefficient_alpha:=1-transparent; ;
self.Setpixel_in_limite(x,y,
rgb(
min(255,max(0,round(getrvalue(une_couleur)*coefficient_alpha+getrvalue(dos_couleur)*transparent))),
min(255,max(0,round(getgvalue(une_couleur)*coefficient_alpha+getgvalue(dos_couleur)*transparent))),
min(255,max(0,round(getbvalue(une_couleur)*coefficient_alpha+getbvalue(dos_couleur)*transparent)))));
end; //Dans les limite
end; {Tdbbitmap.Setpixel_transparent}
procedure Tdbbitmap.setpixel(x,y:integer; une_couleur:tcolorref);
var color:tcolorref;
begin
if (x>=0) and (y>=0) and (x<self.abitmap.Width) and (y<self.abitmap.Height) then
begin
color:=rgb((une_couleur shr 16) and $ff,(une_couleur shr 8) and $ff,une_couleur and $ff);
pointer_bitmap[(pred(self.abitmap.Height)-y)*self.abitmap.Width+x]:=color;
end;
end;
procedure Tdbbitmap.Fillrect_real(x,y,xx,yy:real; une_couleur:tcolorref);
begin
self.Fillrect(round(x),round(y),round(xx),round(yy),une_couleur);
end; {Tdbbitmap.Fillrect_real}
procedure Tdbbitmap.Fillrect(x,y,xx,yy:integer; une_couleur:tcolorref);
var i,j:integer;
begin
for i:=math.max(0,x) to math.min(xx,self.bitmap_struct.bmiHeader.biWidth) do
for j:=math.max(0,y) to math.min(yy,self.bitmap_struct.bmiHeader.biHeight) do
Self.setpixel(i,j,une_couleur);
end;
procedure Tdbbitmap.CrossRect(x,y,xx,yy,alpha:integer; une_couleur:tcolorref);
var i,j:integer;
apt:tpoint;
rect_un,rect_deux,rect_trois,rect_quatre:trect;
begin
for i:=math.max(0,x) to pred(math.min(xx,self.bitmap_struct.bmiHeader.biWidth)) do
for j:=math.max(0,y) to pred(math.min(yy,self.bitmap_struct.bmiHeader.biHeight)) do
begin
apt.x:=i; apt.y:=j;
setrect(rect_un,x,y,x+alpha,y+alpha);
setrect(rect_deux,xx-alpha,y,xx,y+alpha);
setrect(rect_trois,xx-alpha,yy-alpha,xx,yy);
setrect(rect_quatre,x,yy-alpha,x+alpha,yy);
if ptinrect(rect_un,apt) then
begin
end
else if ptinrect(rect_deux,apt) then
begin
end
else if ptinrect(rect_trois,apt) then
begin
end
else if ptinrect(rect_quatre,apt) then
begin
end
else
Self.setpixel(i,j,une_couleur);
end;
end; {Tdbbitmap.Roundrect- écrit par denis B}
procedure Tdbbitmap.RoundRect(x,y,xx,yy,alpha:integer; une_couleur:tcolorref);
var i,j:integer;
apt:tpoint;
rect_un,rect_deux,rect_trois,rect_quatre:trect;
begin
for i:=math.max(0,x) to math.min(xx,self.bitmap_struct.bmiHeader.biWidth) do
for j:=math.max(0,y) to math.min(yy,self.bitmap_struct.bmiHeader.biHeight) do
begin
apt.x:=i; apt.y:=j;
setrect(rect_un,x,y,x+alpha,y+alpha);
setrect(rect_deux,xx-alpha,y,succ(xx),y+alpha);
setrect(rect_trois,succ(xx)-alpha,succ(yy)-alpha,succ(xx),succ(yy));
setrect(rect_quatre,x,succ(yy)-alpha,x+alpha,succ(yy));
if ptinrect(rect_un,apt) then
begin
if utile.distance(i,j,x+alpha,y+alpha)<=alpha then
Self.setpixel(i,j,une_couleur);
end
else if ptinrect(rect_deux,apt) then
begin
if utile.distance(i,j,xx-alpha,y+alpha)<=alpha then
Self.setpixel(i,j,une_couleur);
end
else if ptinrect(rect_trois,apt) then
begin
if utile.distance(i,j,xx-alpha,yy-alpha)<=alpha then
Self.setpixel(i,j,une_couleur);
end
else if ptinrect(rect_quatre,apt) then
begin
if utile.distance(i,j,x+alpha,yy-alpha)<=alpha then
Self.setpixel(i,j,une_couleur);
end
else
Self.setpixel(i,j,une_couleur);
end;
end; {Tdbbitmap.RoundRect}
procedure Tdbbitmap.Drawrect_transparent(x,y,xx,yy:integer; une_couleur:tcolorref; transparent:real);
var i:integer;
begin
for i:=x to xx do
begin
Self.Setpixel_transparent(i,y,une_couleur,transparent);
Self.Setpixel_transparent(i,yy,une_couleur,transparent);
end;
for i:=y to yy do
begin
Self.Setpixel_transparent(x,i,une_couleur,transparent);
Self.Setpixel_transparent(xx,i,une_couleur,transparent);
end;
end;
procedure Tdbbitmap.Drawrect(x,y,xx,yy:integer; une_couleur:tcolorref);
var i:integer;
begin
for i:=x to xx do
begin
Self.setpixel(i,y,une_couleur);
Self.setpixel(i,yy,une_couleur);
end;
for i:=y to yy do
begin
Self.setpixel(x,i,une_couleur);
Self.setpixel(xx,i,une_couleur);
end;
end;
procedure Tdbbitmap.FillCircle_single(x,y,rayon:single; une_couleur:tcolorref; light:boolean);
begin
FillCircle(round(x),round(y),round(rayon),une_couleur,light);
end;
procedure Tdbbitmap.FillCircle(x,y,rayon:integer; une_couleur:tcolorref; light:boolean);
var i,j,k,etendu,hauteur,posit_vertical:integer; r:trect; inside:boolean;
la_distance_de_ce_point_au_centre:integer; h,l,s:real;
begin
if not ((x+rayon>=0) and (y+rayon>=0)) then exit;
if not ((x-rayon<=self.abitmap.Width) and (y-rayon<=self.abitmap.Height)) then exit;
setrect(r,x-rayon,y-rayon,x+rayon,y+rayon);
etendu:=r.left+r.right; hauteur:=r.top+r.bottom;
if true then
begin
if light then hls_rvb.tcolorref_to_hls(une_couleur,h,l,s);
for j:=r.top to y do //r.bottom do
begin
posit_vertical:=hauteur-j;
i:=r.left;
inside:=false;
while not inside and (i<=x) do
begin
la_distance_de_ce_point_au_centre:=utile.idistance(i,j,x,y);
if la_distance_de_ce_point_au_centre<rayon then //Use 1/4 Square root function less
begin
inside:=true;
for k:=i to (etendu-i) do
begin
if not light then
begin
self.Setpixel(k,j,une_couleur);
self.Setpixel(k,posit_vertical,une_couleur);
end
else
begin
la_distance_de_ce_point_au_centre:=utile.idistance(k,j,x,y);
une_couleur:=hls_rvb.Get_HLS_RGB(h,0.5+0.5*(la_distance_de_ce_point_au_centre/rayon),1);
self.Setpixel(k,j,une_couleur);
self.Setpixel(k,posit_vertical,une_couleur);
end;
end; {for k}
end; {la_distance_de_ce_point_au_centre<rayon}
inc(i);
end //While
end {for j}
end
else
for i:=r.left to r.right do for j:=r.top to r.bottom do
if utile.idistance(i,j,x,y)<rayon then
self.Setpixel(i,j,une_couleur);
end; {Tdbbitmap.FillCircle}
procedure Tdbbitmap.FillRectSoft(x,y,xx,yy:integer; une_couleur:tcolorref);
var borne_central:tpoint; m,n,h,l,s:real; i,j,miny,maxy:integer;
begin
borne_central.x:=(x+xx) div 2; borne_central.y:=(y+yy) div 2;
m:=utile.single_distance(x,y,borne_central.x,borne_central.y);
hls_rvb.tcolorref_to_hls(une_couleur,h,l,s);
miny:=max(0,y); maxy:=min(abitmap.Height,yy);
for i:=max(0,x) to min(abitmap.Width,xx) do for j:=miny to maxy do
begin
with borne_central do n:=utile.single_distance(i,j,x,y);
self.Setpixel(i,j,hls_rvb.Get_HLS_RGB(h,0.5+0.5*(n/m),1));
end;
end; {Tdbbitmap.FillRectSoft}
procedure Tdbbitmap.Drawrect_round(x,y,xx,yy:real; une_couleur:tcolorref);
begin
self.Drawrect(round(x),round(y),round(xx),round(yy),une_couleur);
end; {Tdbbitmap.Drawrect}
procedure Tdbbitmap.applique_bitmap;
begin
SetDIBits(self.abitmap.Canvas.Handle,self.abitmap.Handle,0,self.abitmap.height,pointer_bitmap,bitmap_struct,DIB_RGB_COLORS);
end;
Procedure Tdbbitmap.Denis_line_progressive(a,b,c,d:real; color,second_color:tcolorref; stroke_width:integer);
var longeur_effective:integer;
position:integer;
i,j:integer;
dx,dy:real;
old_a,old_b,old_c,old_d:real;
depart,arriver,maximum,deplacement:integer;
begin
old_a:=a;
old_b:=b;
old_c:=c;
old_d:=d;
longeur_effective:=0;
if (a-c)=0 then
begin {vertical}
j:=round(a);
for i:=math.min(round(b),round(d)) to math.max(round(b),round(d)) do
inc(longeur_effective);
end {vertical}
else if (b-d)=0 then
begin {horizontal}
j:=round(b);
for i:=math.min(round(a),round(c)) to math.max(round(a),round(c)) do
inc(longeur_effective);
end {horizontal}
else
begin
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
inc(longeur_effective);
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
inc(longeur_effective);
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
inc(longeur_effective);
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
inc(longeur_effective);
end;
end; {quartier 90°-135°}
end; {progression vertical}
end;
position:=-1;
a:=old_a;
b:=old_b;
c:=old_c;
d:=old_d;
if (a-c)=0 then
begin {vertical}
j:=round(a);
depart:=math.min(round(b),round(d));
arriver:=math.max(round(b),round(d));
maximum:=arriver-depart;
deplacement:=0;
for i:=depart to arriver do
begin
inc(position);
if color=second_color then
self.Setpixel(j,i,hls_rvb.Get_HLS_RGB(360*position/longeur_effective,0.50,1))
else
begin
self.Setpixel(j,i,deformat.IN_Between_longint_RGB(color,second_color,deplacement,maximum));
if (stroke_width>=10) and (stroke_width<18) then
self.Setpixel(j+1,i,deformat.IN_Between_longint_RGB(color,second_color,deplacement,maximum))
else if stroke_width>=18 then
begin
self.Setpixel(j-1,i,deformat.IN_Between_longint_RGB(color,second_color,deplacement,maximum));
self.Setpixel(j+1,i+1,deformat.IN_Between_longint_RGB(color,second_color,deplacement,maximum));
end;
inc(deplacement);
end;
end;
exit;
end; {vertical}
if (b-d)=0 then
begin {horizontal}
j:=round(b);
depart:=math.min(round(a),round(c));
arriver:=math.max(round(a),round(c));
maximum:=arriver-depart;
deplacement:=0;
for i:=depart to arriver do
begin
inc(position);
if color=second_color then
self.Setpixel(i,j,hls_rvb.Get_HLS_RGB(360*position/longeur_effective,0.50,1))
else
begin
self.Setpixel(i,j,deformat.IN_Between_longint_RGB(color,second_color,i-depart,maximum));
if (stroke_width>=10) and (stroke_width<18) then
self.Setpixel(i,j+1,deformat.IN_Between_longint_RGB(color,second_color,i-depart,maximum))
else if stroke_width>=18 then
begin
self.Setpixel(i,j-1,deformat.IN_Between_longint_RGB(color,second_color,i-depart,maximum));
self.Setpixel(i,j+1,deformat.IN_Between_longint_RGB(color,second_color,i-depart,maximum));
end;
inc(deplacement);
end;
end;
exit;
end; {horizontal}
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
inc(position);
self.Setpixel(i,round(b),hls_rvb.Get_HLS_RGB(360*position/longeur_effective,0.50,1));
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
inc(position);
self.Setpixel(i,round(d),hls_rvb.Get_HLS_RGB(360*position/longeur_effective,0.50,1));
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
inc(position);
self.Setpixel(round(a),i,hls_rvb.Get_HLS_RGB(360*position/longeur_effective,0.50,1));
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
inc(position);
self.Setpixel(round(c),i,hls_rvb.Get_HLS_RGB(360*position/longeur_effective,0.50,1));
end;
end; {quartier 90°-135°}
end; {progression vertical}
end; {Tdbbitmap.Denis_line_progressive}
Procedure Tdbbitmap.Denis_line_limite(a,b,c,d:real; color:tcolorref; maxix,maxiy:real;
with_sinusoide,spectral,smooth:boolean; repetition,amplitude,lumiere,saturation:real);
var i,j:integer;
dx,dy:real;
ma_couleur,une_couleur:TColorRef;
procedure My_Setpixel(j,i:integer);
var h,l,s:real;
begin
if smooth then
begin
hls_rvb.tcolorref_to_hls(ma_couleur,h,l,s);
une_couleur:=hls_rvb.Get_HLS_RGB(h,0.75,1);
self.Setpixel(j-1,i-1,une_couleur);
self.Setpixel(j-1,i+1,une_couleur);
self.Setpixel(j+1,i-1,une_couleur);
self.Setpixel(j+1,i+1,une_couleur);
end;
self.Setpixel(j,i,ma_couleur);
end;
begin
ma_couleur:=color;
if (a-c)=0 then
begin {vertical}
j:=round(a);
for i:=math.min(round(b),round(d)) to math.max(round(b),round(d)) do
begin
if spectral then ma_couleur:=hls_rvb.Get_HLS_RGB(360*i/maxiy,lumiere,saturation);
if with_sinusoide then
My_Setpixel(j+round(cos(pi/4*repetition*i/maxiy)*amplitude),i)
else
My_Setpixel(j,i);
end;
end {vertical}
else if (b-d)=0 then
begin {horizontal}
j:=round(b);
for i:=math.min(round(a),round(c)) to math.max(round(a),round(c)) do
begin
if spectral then ma_couleur:=hls_rvb.Get_HLS_RGB(360*i/maxix,lumiere,saturation);
if with_sinusoide then
My_Setpixel(i,j+round(cos(pi/4*repetition*i/maxix)*amplitude))
else
My_Setpixel(i,j);
end;
end; {horizontal}
end; {Tdbbitmap.Denis_line_limite, le 19.11.2019-denis B}
Procedure Tdbbitmap.Denis_line_single(a,b,c,d:real; color:tcolorref);
var i,j:integer;
dx,dy:real;
begin
if (a-c)=0 then
begin {verticalement}
j:=round(a);
for i:=math.min(round(b),round(d)) to math.max(round(b),round(d)) do
self.Setpixel(j,i,color);
end {vertical}
else if (b-d)=0 then
begin {horizontalement}
j:=round(b);
for i:=math.min(round(a),round(c)) to math.max(round(a),round(c)) do
self.Setpixel(i,j,color);
end
else
begin //Les quatre quartiers
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
self.Setpixel(i,round(b),color); //round
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
self.Setpixel(i,round(d),color);
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
self.Setpixel(round(a),i,color);
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
self.Setpixel(round(c),i,color);
end;
end; {quartier 90°-135°}
end;
end;
end; {Tdbbitmap.Denis_line_single}
Procedure Tdbbitmap.Denis_line_hori(x,y,xx:integer; une_couleur:tcolorref);
var i:integer;
begin
for i:=math.max(0,x) to math.min(xx,pred(self.abitmap.Width)) do
self.Setpixel(i,y,une_couleur);
end; {Tdbbitmap.Denis_line_hori}
Procedure Tdbbitmap.Denis_line_hori_square_gradian(x,y,xx:integer; m:real; rect:trect;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
var i,ratio,obtenir:integer; center:tpoint; une_distance,dos_distance,coefficient:real;
begin
center.x:=(rect.left+rect.right) div 2;
center.y:=(rect.bottom+rect.top) div 2;
une_distance:=utile.single_distance(0,y,center.x,center.y);
if une_distance>=1 then
begin
coefficient:=1000/une_distance; {1000 et une distance ne varient pas dans cette boucle for i}
for i:=math.max(0,x) to math.min(xx,pred(self.abitmap.Width)) do
begin
dos_distance:=abs(center.x-i);
ratio:=math.min(1000,math.max(0,round(dos_distance*coefficient)));
self.Setpixel_in_limite(i,y,
u_object.T_Col_point_couleur(collection).in_between_color(ratio,hue_lum_sat,false,obtenir));
end {délice thé end ? ou pas}
end
else
Denis_line_hori(x,y,xx,une_couleur);
end; {Tdbbitmap.Denis_line_hori_square_gradian}
Procedure Tdbbitmap.Denis_line_hori_parralelle(x,y,xx:integer; rect:trect; angle:integer;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
var i,ratio,obtenir:integer; center:tpoint;
une_distance,dos_distance,tres_distance,alpha:real;
pt,ptA,ptB:Point2D;
begin
alpha:=angle*pi/180;
center.x:=(rect.left+rect.right) div 2;
center.y:=(rect.bottom+rect.top) div 2;
une_distance:=utile.distance(rect.left,rect.top,rect.right,rect.bottom);
ptA.x:=center.x+cos(alpha)*une_distance;
ptA.y:=center.y-sin(alpha)*une_distance;
ptB.x:=center.x+cos(alpha+Pi)*une_distance;
ptB.y:=center.y-sin(alpha+Pi)*une_distance;
pt.x:=0; pt.y:=0; dos_distance:=DistDroite(pt,ptA,ptB); //thé end ?
for i:=math.max(0,x) to math.min(xx,pred(self.abitmap.Width)) do
begin
if ((angle=0) or (angle=180)) and (rect.bottom<>rect.top) then
begin
ratio:=math.min(1000,math.max(0,round(y/(rect.bottom-rect.top)*1000)));
if collection=nil then
self.Setpixel(i,y,une_couleur)
else
self.Setpixel_in_limite(i,y,
u_object.T_Col_point_couleur(collection).in_between_color(ratio,hue_lum_sat,false,obtenir));
end
else if ((angle=90) or (angle=270)) and (rect.right<>rect.left) then
begin
ratio:=math.min(1000,math.max(0,round(y/(rect.right-rect.left)*1000)));
if collection=nil then
self.Setpixel_in_limite(i,y,une_couleur)
else
self.Setpixel_in_limite(i,y,
u_object.T_Col_point_couleur(collection).in_between_color(ratio,hue_lum_sat,false,obtenir));
end
else
begin
pt.y:=y; pt.x:=i; tres_distance:=DistDroite(pt,ptA,ptB); //thé end ?
ratio:=math.max(0,math.min(1000,round(1000*tres_distance/dos_distance)));
if collection=nil then
self.Setpixel(i,y,une_couleur)
else
self.Setpixel(i,y,u_object.T_Col_point_couleur(collection).in_between_color(ratio,hue_lum_sat,false,obtenir));
end;
end;
end; {Tdbbitmap.Denis_line_hori_parralelle-delice le 8.2.2020}
Procedure Tdbbitmap.Denis_line_hori_graduate(x,y,xx:integer; ptA,ptB:my_math.Point2D; m:real;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
var h,l,s,n:real; i,ratio,obtenir:integer; pt:my_math.Point2D;
begin
pt.y:=y;
hls_rvb.tcolorref_to_hls(une_couleur,h,l,s);
for i:=math.max(0,x) to math.min(xx,pred(self.abitmap.Width)) do
begin
if collection.count=0 then
self.Setpixel_in_limite(i,y,hls_rvb.Get_HLS_RGB(h,0.5+0.5*(n/m),1)) {De denis bertin}
else
begin
pt.x:=i;
n:=DistDroite(pt,ptA,ptB);
ratio:=math.min(1000,math.max(0,round(n/m*1000)));
self.Setpixel_in_limite(i,y,
u_object.T_Col_point_couleur(collection).in_between_color(ratio,hue_lum_sat,false,obtenir));
end;
end;
end; {Tdbbitmap.Denis_line_hori_graduate}
Procedure Tdbbitmap.Denis_line_hori_circulaire(x,y,xx:integer; borne_central:tpoint; m:real;
une_couleur:tcolorref; collection:contnrs.TObjectList; hue_lum_sat:boolean);
var i,obtenir:integer; h,l,s,n:real;
begin
try
hls_rvb.tcolorref_to_hls(une_couleur,h,l,s);
for i:=math.max(0,x) to math.min(xx,pred(self.abitmap.Width)) do
begin
n:=utile.single_distance(i,y,borne_central.x,borne_central.y);
if collection.count=0 then
self.Setpixel_in_limite(i,y,hls_rvb.Get_HLS_RGB(h,0.5+0.5*(n/m),1)) {De denis bertin}
else
self.Setpixel_in_limite(i,y,
u_object.T_Col_point_couleur(collection).in_between_color(round(n/m*1000),hue_lum_sat,false,obtenir));
end;
except end;
end; {Tdbbitmap.Denis_line_hori_circulaire}
Procedure Tdbbitmap.Denis_line_single_epaisseur(a,b,c,d:real; color:tcolorref; width:integer; style:U_fast_bitmap.PTStyle);
var i,j:integer;
dx,dy:real;
procedure local_Setpixel(x,y:integer);
var i,j:integer;
begin
case style of
PTS_Square,PTS_Triangle:
for i:=-width to width do for j:=-width to width do
self.Setpixel(x+i,y+j,color);
PTS_round:
for i:=-width to width do for j:=-width to width do
if utile.distance(x+i,y+j,x,y)<width then
self.Setpixel(x+i,y+j,color);
end; {case}
end; {local_Setpixel}
begin
if (a-c)=0 then
begin {vertical}
j:=round(a);
for i:=math.min(round(b),round(d)) to math.max(round(b),round(d)) do
local_Setpixel(j,i);
exit;
end; {vertical}
if (b-d)=0 then
begin {horizontal}
j:=round(b);
for i:=math.min(round(a),round(c)) to math.max(round(a),round(c)) do
local_Setpixel(i,j);
exit;
end; {horizontal}
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
local_Setpixel(i,round(b));
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
local_Setpixel(i,round(d));
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
local_Setpixel(round(a),i);
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
local_Setpixel(round(c),i);
end;
end; {quartier 90°-135°}
end; {progression vertical}
end; {Tdbbitmap.Denis_line_single_epaisseur}
{L'algorythme de Bresenham le parcours d'une droite divisé en quatre quartiers de progression}
Procedure Tdbbitmap.Denis_line(a,b,c,d:real; color:tcolorref);
var i,j:integer;
dx,dy:real;
begin
if (a-c)=0 then
begin {vertical}
j:=round(a);
for i:=math.min(round(b),round(d)) to math.max(round(b),round(d)) do
self.Setpixel(j,i,color);
exit;
end; {vertical}
if (b-d)=0 then
begin {horizontal}
j:=round(b);
for i:=math.min(round(a),round(c)) to math.max(round(a),round(c)) do
self.Setpixel(i,j,color);
exit;
end; {horizontal}
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
self.Setpixel(i,round(b),color);
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
self.Setpixel(i,round(d),color);
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
self.Setpixel(round(a),i,color);
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
self.Setpixel(round(c),i,color);
end;
end; {quartier 90°-135°}
end; {progression vertical}
end; {denis_line}
Procedure Tdbbitmap.Denis_line_in_between(a,b,c,d:real; depart,color:tcolorref; stroke_mitter,stroke_bold:boolean; stroke_width:integer);
var i,j,k,kk:integer;
dx,dy:real;
rb,rd,ra,rc:integer;
une_color:tcolorref;
mini,maxi,posit:integer;
decalage,obtenue:integer;
begin
decalage:=-stroke_width div 2; obtenue:=stroke_width div 2;
if (a-c)=0 then
begin {vertical}
j:=round(a);
mini:=math.min(round(b),round(d));
maxi:=math.max(round(b),round(d));
posit:=round(a);
for i:=mini to maxi do
begin
une_color:=IN_Between_longint_RGB(depart,color,i-mini,maxi-mini);
if (stroke_mitter and (round(i) mod 10<=5)) or not stroke_mitter then
begin
self.Setpixel(posit,i,une_color);
if stroke_bold then
begin
self.Setpixel(posit-1,i,une_color);
self.Setpixel(posit+1,i,une_color);
self.Setpixel(posit,i-1,une_color);
self.Setpixel(posit,i+1,une_color);
for k:=decalage to obtenue do for kk:=decalage to obtenue do self.Setpixel(posit+k,i+kk,une_color);
end;
end;
end;
exit;
end; {vertical}
if (b-d)=0 then
begin {horizontal}
j:=round(b);
mini:=math.min(round(a),round(c));
maxi:=math.max(round(a),round(c));
posit:=round(b);
for i:=mini to maxi do
begin
une_color:=IN_Between_longint_RGB(depart,color,i-mini,maxi-mini);
if (stroke_mitter and (round(i) mod 10<=5)) or not stroke_mitter then
begin
self.Setpixel(i,posit,une_color);
if stroke_bold then
begin
self.Setpixel(i-1,posit,une_color);
self.Setpixel(i+1,posit,une_color);
self.Setpixel(i,posit-1,une_color);
self.Setpixel(i,posit+1,une_color);
end;
for k:=decalage to obtenue do for kk:=decalage to obtenue do self.Setpixel(i+k,posit+kk,une_color);
end;
end;
exit;
end; {horizontal}
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
rb:=round(b);
une_color:=IN_Between_longint_RGB(depart,color,i-round(a),round(c)-round(a));
if (stroke_mitter and (round(i) mod 10<=5)) or not stroke_mitter then
begin
self.Setpixel(i,rb,color);
if stroke_bold then
begin
self.Setpixel(i-1,rb,une_color);
self.Setpixel(i+1,rb,une_color);
self.Setpixel(i,rb-1,une_color);
self.Setpixel(i,rb+1,une_color);
end;
for k:=decalage to obtenue do for kk:=decalage to obtenue do self.Setpixel(i+k,rb+kk,une_color);
end;
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
rd:=round(d);
une_color:=IN_Between_longint_RGB(depart,color,i-round(c),round(a)-round(c));
if (stroke_mitter and (round(i) mod 10<=5)) or not stroke_mitter then
begin
self.Setpixel(i,rd,color);
if stroke_bold then
begin
self.Setpixel(i+1,rd,une_color);
self.Setpixel(i-1,rd,une_color);
self.Setpixel(i,rd+1,une_color);
self.Setpixel(i,rd-1,une_color);
end;
for k:=decalage to obtenue do for kk:=decalage to obtenue do self.Setpixel(i+k,rd+kk,une_color);
end;
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
ra:=round(a);
une_color:=IN_Between_longint_RGB(depart,color,i-round(b),round(d)-round(b));
if (stroke_mitter and (round(i) mod 10<=5)) or not stroke_mitter then
begin
self.Setpixel(ra,i,une_color);
if stroke_bold then
begin
self.Setpixel(ra,i,une_color);
self.Setpixel(ra+1,i,une_color);
self.Setpixel(ra-1,i,une_color);
self.Setpixel(ra,i+1,une_color);
self.Setpixel(ra,i-1,une_color);
end;
for k:=decalage to obtenue do for kk:=decalage to obtenue do self.Setpixel(ra+k,i+kk,une_color);
end;
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
rc:=round(c);
une_color:=IN_Between_longint_RGB(depart,color,i-round(d),round(b)-round(d));
if (stroke_mitter and (round(i) mod 10<=5)) or not stroke_mitter then
begin
self.Setpixel(rc,i,une_color);
if stroke_bold then
begin
self.Setpixel(rc+1,i,une_color);
self.Setpixel(rc-1,i,une_color);
self.Setpixel(rc,i+1,une_color);
self.Setpixel(rc,i-1,une_color);
end;
for k:=decalage to obtenue do for kk:=decalage to obtenue do self.Setpixel(rc+k,i+kk,une_color);
end;
end;
end; {quartier 90°-135°}
end; {progression vertical}
end; {Tdbbitmap.Denis_line_in_between}
{L'algorythme de Bresenham le parcours d'une droite divisé en quatre quartiers de progression}
Procedure Tdbbitmap.Denis_line_alias(a,b,c,d:real; color:tcolorref);
var i,j:integer;
dx,dy:real;
rb,rd,ra,rc:integer;
une_color:tcolorref;
begin
if (a-c)=0 then
begin {vertical}
j:=round(a);
for i:=math.min(round(b),round(d)) to math.max(round(b),round(d)) do
begin
self.Setpixel(j,i,color);
une_color:=self.Getpixel(j-1,i);
self.Setpixel(j-1,i,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
une_color:=self.Getpixel(j+1,i);
self.Setpixel(j+1,i,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
end;
exit;
end; {vertical}
if (b-d)=0 then
begin {horizontal}
j:=round(b);
for i:=math.min(round(a),round(c)) to math.max(round(a),round(c)) do
begin
self.Setpixel(i,j,color);
une_color:=self.Getpixel(i,j-1);
self.Setpixel(i,j-1,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
une_color:=self.Getpixel(i,j+1);
self.Setpixel(i,j+1,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
end;
exit;
end; {horizontal}
{delta - différence}
dx:=(b-d)/(a-c);
dy:=(a-c)/(b-d);
if abs(dx)<abs(dy) then
begin {progression horizontal}
if a<c then
begin {quartier 0-45°}
for i:=round(a) to round(c) do
begin
b:=b+dx;
rb:=round(b);
self.Setpixel(i,rb,color);
une_color:=self.Getpixel(i,rb-1);
self.Setpixel(i,rb-1,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
une_color:=self.Getpixel(i,rb+1);
self.Setpixel(i,rb+1,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
end
end {quartier 0-45°}
else
begin {quartier 180°-135°}
for i:=round(c) to round(a) do
begin
d:=d+dx;
rd:=round(d);
self.Setpixel(i,rd,color);
une_color:=self.Getpixel(i,rd-1);
self.Setpixel(i,rd-1,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
une_color:=self.Getpixel(i,rd+1);
self.Setpixel(i,rd+1,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
end
end; {quartier 180°-135}
end {progression horizontal}
else
begin {progression vertical}
if b<d then
begin {quartier 45°-90°}
for i:=round(b) to round(d) do
begin
a:=a+dy;
ra:=round(a);
self.Setpixel(ra,i,color);
une_color:=self.Getpixel(ra-1,i);
self.Setpixel(ra-1,i,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
une_color:=self.Getpixel(ra+1,i);
self.Setpixel(ra+1,i,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
end;
end {quartier 45°-90°}
else
begin {quartier 90°-135°}
for i:=round(d) to round(b) do
begin
c:=c+dy;
rc:=round(c);
self.Setpixel(rc,i,color);
une_color:=self.Getpixel(rc-1,i);
self.Setpixel(rc-1,i,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
une_color:=self.Getpixel(rc+1,i);
self.Setpixel(rc+1,i,
rgb(
(getrvalue(color)+getrvalue(une_color)) div 2,
(getgvalue(color)+getgvalue(une_color)) div 2,
(getbvalue(color)+getbvalue(une_color)) div 2));
end;
end; {quartier 90°-135°}
end; {progression vertical}
end; {denis_line_alias} {le 11.10.2018}
end.
Compatibilité : 1.0
A voir également
- L'Unité Fast bitmap adresse un Bitmap avec ces fonctions
- Bitmap - Forum Delphi / Pascal
- Pascal unité ✓ - Forum Delphi / Pascal
- Violation d'accès à l'adresse - Forum Delphi / Pascal
- Bitmap c# ✓ - Forum C# / .NET
- Violation d’accès à l’adress - Forum Delphi / Pascal