1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
|
function GetSign(X: Integer): Integer;
begin
if X < 0 then GetSign := -1
else if X = 0 then GetSign := 0
else GetSign := +1;
end;
procedure Line(X1, Y1, X2, Y2: Integer; Color: Byte);
var
X, Y: Integer;
Count: Integer;
XS, YS: Integer;
XM, YM:Integer;
begin
X := X1;
Y := Y1;
XS := X2 - X1;
YS := Y2 - Y1;
XM := GetSign(XS);
YM := GetSign(YS);
XS := Abs(XS);
YS := Abs(YS);
PutPixel(X, Y, FColor);
if XS > YS then
begin
Count := -(XS div 2);
while X <> X2 do
begin
Inc(Count, YS);
Inc(X, XM);
if Count > 0 then
begin
Inc(Y, YM);
Dec(Count, XS);
end;
PutPixel(X, Y, Color);
end;
end
else
begin
Count := -(YS div 2);
while Y <> Y2 do
begin
Inc(Count, XS);
Inc(Y, YM);
if Count > 0 then
begin
Inc(X, XM);
Dec(Count, YS);
end;
PutPixel(X, Y, Color);
end;
end;
end; |
Partager