L'Unité Fast bitmap adresse un Bitmap avec ces fonctions

Commenter

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

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (denisbertin)