
25.10.2008, 15:26
|
Активный
|
|
Регистрация: 12.06.2008
Сообщения: 313
Репутация: 40
|
|
Если все правильно рассчитал то
Код:
procedure ImageLine(bPoint, ePoint: TPoint; Canvas: TCanvas; const Color: TColor);
var
x, y: Integer;
K, B: Extended;
// меняем местами А и В
procedure xChg(var A, B: Integer);
begin
A := A + B;
B := A - B;
A := A - B;
end;
begin
if bPoint.X <> ePoint.X then // любая прямая отличная от вертикальной
begin
if bPoint.X > ePoint.X then // если коэффициенты не в порядке возрастания
begin
xChg(bPoint.X, ePoint.X);
xChg(bPoint.Y, ePoint.Y);
end;
// коэффициент наклона
K := (ePoint.Y - bPoint.Y)/(ePoint.X - bPoint.X);
// постоянная состовляющая
B := bPoint.Y - K*bPoint.X;
// вывод
for x := bPoint.X to ePoint.X do
begin
y := Round(K*x + B); // формула
Canvas.Pixels[x, y] := Color;
end;
end
else // для вертикальной прямой
begin
x := bPoint.X; // постоянна
if bPoint.Y > ePoint.Y then // меняем если нужно
xChg(bPoint.Y, ePoint.Y);
for y := bPoint.Y to ePoint.Y do // рисуем
Canvas.Pixels[x, y] := Color;
end;
end;
Использовать примерно так
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
bPoint, ePoint: TPoint;
begin
bPoint.X := StrToInt(Edit1.Text);
bPoint.Y := StrToInt(Edit2.Text);;
ePoint.X := StrToInt(Edit3.Text);;
ePoint.Y := StrToInt(Edit4.Text);;
ImageLine(bPoint, ePoint, Image1.Canvas, clBlack);
end;
|