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.