Delphi World - Нарисовать линию без зазубринок
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Нарисовать линию без зазубринок

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
 This code draws an anti-aliased line on a bitmap 
 This means that the line is not jagged like the 
 lines drawn using the LineTo() function 
}

 uses
   Graphics, Windows;

 type
   TRGBTripleArray = array[0..1000] of TRGBTriple;
   PRGBTripleArray = ^TRGBTripleArray;

 // anti-aliased line 
procedure WuLine(ABitmap : TBitmap ; Point1, Point2 : TPoint ; AColor : TColor);
 var
   deltax, deltay, loop, start, finish : integer;
   dx, dy, dydx : single; // fractional parts 
  LR, LG, LB : byte;
   x1, x2, y1, y2 : integer;
 begin
   x1 := Point1.X; y1 := Point1.Y;
   x2 := Point2.X; y2 := Point2.Y;
   deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation 
  deltay := abs(y2 - y1);
   if (deltax = 0) or (deltay = 0) then begin // straight lines 
    ABitmap.Canvas.Pen.Color := AColor;
     ABitmap.Canvas.MoveTo(x1, y1);
     ABitmap.Canvas.LineTo(x2, y2);
     exit;
   end;
   LR := (AColor and $000000FF);
   LG := (AColor and $0000FF00) shr 8;
   LB := (AColor and $00FF0000) shr 16;
   if deltax > deltay then
   begin // horizontal or vertical 
    if y2 > y1 then // determine rise and run 
      dydx := -(deltay / deltax)
     else
       dydx := deltay / deltax;
     if x2 < x1 then
     begin
       start := x2; // right to left 
      finish := x1;
       dy := y2;
     end else
     begin
       start := x1; // left to right 
      finish := x2;
       dy := y1;
       dydx := -dydx; // inverse slope 
    end;
     for loop := start to finish do
     begin
       AlphaBlendPixel(ABitmap, loop, trunc(dy), LR, LG, LB, 1 - frac(dy));
       AlphaBlendPixel(ABitmap, loop, trunc(dy) + 1, LR, LG, LB, frac(dy));
       dy := dy + dydx; // next point 
    end;
   end else
   begin
     if x2 > x1 then // determine rise and run 
      dydx := -(deltax / deltay)
     else
       dydx := deltax / deltay;
     if y2 < y1 then
     begin
       start := y2; // right to left 
      finish := y1;
       dx := x2;
     end else
     begin
       start := y1; // left to right 
      finish := y2;
       dx := x1;
       dydx := -dydx; // inverse slope 
    end;
     for loop := start to finish do
     begin
       AlphaBlendPixel(ABitmap, trunc(dx), loop, LR, LG, LB, 1 - frac(dx));
       AlphaBlendPixel(ABitmap, trunc(dx) + 1, loop, LR, LG, LB, frac(dx));
       dx := dx + dydx; // next point 
    end;
   end;
 end;

 // blend a pixel with the current colour 
procedure AlphaBlendPixel(ABitmap : TBitmap ; X, Y : integer ; R, G, B : byte ; ARatio : Real);
 Var
   LBack, LNew : TRGBTriple;
   LMinusRatio : Real;
   LScan : PRGBTripleArray;
 begin
   if (X < 0) or (X > ABitmap.Width - 1) or (Y < 0) or (Y > ABitmap.Height - 1) then
     Exit; // clipping 
  LScan := ABitmap.Scanline[Y];
   LMinusRatio := 1 - ARatio;
   LBack := LScan[X];
   LNew.rgbtBlue := round(B*ARatio + LBack.rgbtBlue*LMinusRatio);
   LNew.rgbtGreen := round(G*ARatio + LBack.rgbtGreen*LMinusRatio);
   LNew.rgbtRed := round(R*ARatio + LBack.rgbtRed*LMinusRatio);
   LScan[X] := LNew;
 end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования