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

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

{ 
 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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com