Читаем О чём не пишут в книгах по Delphi полностью

 if (Button = mbLeft) and (FDragPoint = dpFirst) then

 begin

  FNewLine := False;

  FDragPoint := dpNone;

  // Промежуточные точки равномерно распределяем по прямой

  FCurve[1].X := FCurve[0].X + Round((FCurve[3].X - FCurve[0].X) / 3);

  FCurve[1].Y := FCurve[0].Y + Round((FCurve[3].Y - FCurve[0].Y) / 3);

  FCurve[2].X := FCurve[0].X + Round(2 + (FCurve[3].X - FCurve[0].X) / 3);

  FCurve[2].Y := FCurve[0].Y + Round(2 + (FCurve[3].Y - (Curve[0].Y) / 3);

  Refresh;

 end;

end;


procedure TCurveForm.FormPaint(Sender: TObject);

var

 I: Integer;

 L: Extended;

begin

 // Сначала выводим фон

 Canvas.Draw(0, 0, FBack);

 if FNewLine then

 begin

  // Если программа находится в режиме рисования резиновой прямой,

  // рисуем прямую от точки FCurve[0] до FCurve[3]. Значение FCurve[1]

  // и FCurve[2] на данном этапе игнорируется

  if FDragPoint = dpFirst then

  begin

   FCounter := 0;

   L :=

    Sqrt(Sqr(FCurve[0].X - FCurve[3].X) +

    Sqr(FCurve[0].Y - FCurve[3].Y));

   if L > 0 then

   begin

    FDX := Round(4 * (FCurve[0].Y -FCurve[3].Y) / L);

    FDY := Round(4 * (FCurve[3].X - FCurve[0].X) / L);

    LineDDA(FCurve[0].X, FCurve[0].Y, FCurve[3].X, FCurve[3].Y,

     @LineDrawFunc, Integer(Canvas));

   end;

  end;

 end

 else

 begin

  // Если есть незавершённая кривая и установлен режим рисования

  // по опорным точкам, выводим отрезки, показывающие касательные

  // к кривой в её начале и конце

  if RGroupDrawMethod.ItemIndex = 0 then

  begin

   Canvas.Pen.Style := psDot;

   Canvas.Pen.Width := 3;

   Canvas.Pen.Color := clDkGrey;

   Canvas.MoveTo(FCurve[0].X, FCurve[0].Y);

   Canvas.LineTo(FCurve[1].X, FCurve[1].Y);

   Canvas.MoveTo(FCurve[3].X, FCurve[3].Y);

   Canvas.LineTo(FCurve[2].X, FCurve[2].Y);

  end;

  // Рисуем красные квадраты, показывающие точки, которые пользователь

  // может перемещать

  Canvas.Pen.Style := psSolid;

  Canvas.Pen.Width := 1;

  Canvas.Pen.Color := clRed;

  Canvas.Brush.Style := bsClear;

  for I := 0 to 3 do

   Canvas.Rectangle(FCurve[I].X - RectSize, FCurve[I].Y - RectSize,

    FCurve[I].X + RectSize + 1, FCurve[I].Y + RectSize + 1);

 end;

end;


// функция PtNearPt возвращает True, если точка с координатами (X1, Y1)

// удалена от точки Pt по каждой из координат не более чем на RectSize

function TCurveForm.PtNearPt(X1, Yl: Integer; const Pt: TPoint): Boolean;

begin

 Result :=

  (X1 >= Pt.X - RectSize) and (X1 <= Pt.X + RectSize) and

  (Y1 >= Pt.Y - RectSize) and (Y1 <= Pt.Y + RectSize);

end;


procedure TCurveForm.BtnEndClick(Sender: TObject);

begin

 if not FNewLine then

 begin

  DrawCurve(FBack.Canvas);

  FNewLine := True;

  Refresh;

 end;

end;

Перейти на страницу:
Нет соединения с сервером, попробуйте зайти чуть позже