Показать сообщение отдельно
  #6  
Старый 25.10.2008, 15:26
Drozh Drozh вне форума
Активный
 
Регистрация: 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;
Ответить с цитированием