Показать сообщение отдельно
  #6  
Старый 31.10.2013, 23:03
woojin woojin вне форума
Прохожий
 
Регистрация: 09.08.2008
Сообщения: 3
Репутация: 10
Хорошо

подсказали на другом форуме и вот что получилось:

Код:
var
  bm: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
   bm := TBitmap.Create;
   bm.Width := PaintBox1.Width;
   bm.Height := PaintBox1.height;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Count: integer;

begin
    Count: = 50; //количество точек
    bm.Canvas.FillRect(Bounds(0, 0, PaintBox1.Width, PaintBox1.Height));
    DrawBezier(bm.Canvas, Count, PenW, Color)
    PaintBox1.Canvas.Draw(0, 0, bm);
end;

procedure DrawEdje(P1, P2: TPoint; Arrow: boolean; Canvas: TCanvas; Color: TColor);
var
  Angle: real;
  p3, p4: TPoint;
  size, angle_shift: Integer;

begin
   size := 20;
   angle_shift := 160; // на сколько острой стрелка
   Canvas.Color := Color;
  if Arrow = true then
     begin
        Angle := 180 * ArcTan2(P2.y - P1.y, P2.x - P1.x) / pi;
        p3 := Point(P2.x + Round(size * cos(pi * (Angle + angle_shift) / 180)), P2.y + Round(size * sin(pi * (Angle + angle_shift) / 180)));
        p4 := Point(P2.x + Round(size * cos(pi * (Angle - angle_shift) / 180)), P2.y + Round(size * sin(pi * (Angle - angle_shift) / 180)));
        Canvas.MoveTo(p2.X,p2.Y);
        Canvas.LineTo(p3.X,p3.y);
        Canvas.MoveTo(p2.X,p2.Y);
        Canvas.LineTo(p4.X,p4.y);

        Canvas.MoveTo(p1.X,p1.Y);
        Canvas.LineTo(p3.X,p3.y);
        Canvas.MoveTo(p1.X,p1.Y);
        Canvas.LineTo(p4.X,p4.y);
  end;
end;

function GetBinomialCoefficient(m, i: Integer): single;
  function Factorial(x: Integer): double;
  var
    i: Integer;
  begin
     result := 1;
     for i := 2 to x do
       result := result * i;
  end;

begin
   result := Factorial(m) / (Factorial(i) * Factorial(m - i));
end;

procedure DrawBezier(Canvas: TCanvas; Count: Integer; PenW: Integer = 2; Color: TColor = clRed);
type
  TPointFArray = array [word] of TPoint;
  PPointFArray = ^TPointFArray;

var
  p: PPointFArray;
  Step, qx, qy, t, q: single;
  i, j, n: Integer;
  BezierPoints: array of TPoint;
  PointShift: single;
  C: array of single;

begin
   n := 3;
   SetLength(BezierPoints, n);
   SetLength(C, n);

//координаты трапеции для полуэллипса
   PointShift := Canvas.Width / 3;
   BezierPoints[0] := TPoint.Create(Canvas.Width, Canvas.Height);
   BezierPoints[1] := TPoint.Create(Canvas.Width - PointShift, 0);
   BezierPoints[2] := TPoint.Create(Canvas.Width - PointShift * 2, 0);
   BezierPoints[3] := TPoint.Create(0, Canvas.Height);

   for i := 0 to n do
     C[i] := GetBinomialCoefficient(n, i);

   GetMem(p, sizeof(TPoint) * (Count + 1));
   Step := 1.0 / Count;
   for i := 0 to Count do
     begin
        t := i * Step;
        qx := 0;
        qy := 0;
        for j := 0 to n do
          begin
             q := C[j] * IntPower(1 - t, j) * IntPower(t, n - j);
             qx := qx + q * BezierPoints[j].x;
             qy := qy + q * BezierPoints[j].y;
          end;
        p[i] := PointF(qx, qy);
     end;

   Canvas.Pen.Color := Color;
   Canvas.pen.Width := PenW;
   i := 0;
   while (i <= Count - 1) do
      begin
         Canvas.MoveTo(p[i], p[i + 1], 100);
         Canvas.LineTo(p[i+1].x, p[i+1].y);
         inc(i, 2);
      end;

   DrawEdje(p[Count - 1], p[Count], true, Canvas, Color);

   FreeMem(p);
end;
Ответить с цитированием