Графика в Delphi - примеры задач на построение графиков, а также компоненты для графики

Нарисовать линию без зазубринок

{
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;

Powered WP Ъ скачать delphi, delphi 7, скачать delphi 7, delphi файлы, delphi, компоненты, delphi 2009, delphi программы, delphi бесплатно, delphi скачать, бесплатно работа delphi, delphi создание, delphi строки, программирования delphi, borland delphi, delphi формы