Последние записи
- Как сделать картинку адаптивной, само растягивающейся к размеру монитора, чтобы размер баннера изменялся сам — подстраивался под дизайн сайта
- Прозрачность тайлсета в TPNGImage
- Как сделать VBA макрос в excel
- Поиск по столбцу 1-ого не нулевого значения (формулой в Microsoft Office Excel)
- Простановка единиц в ячейки под объектами (Microsoft Office Excel)
- Расчет затраченного времени между определенным рабочим временем (формулой в Microsoft Office Excel)
- Мигающий экран на Assembler
- VBA-макрос по копированию 10 строчек в выбранном диапазоне в Microsoft Office Excel
- Копирование только нужного диапазона в Microsoft Office Excel
- Перенос диапазона стоки в Microsoft Office Excel на другой лист по условию
3rd
Ноя
Как нарисовать стрелку в конце эллиптической дуги?
Posted by Chas under Delphi
есть 4-ре точки (прямоугольник) в котором надо нарисовать эллиптическую дугу
и в конце этой дуги нарисовать стрелку (наконечник)
подскажите как это сделать правильно?
woojin
вот что получилось:
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 := 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 := 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;
[/code]
тема на форуме
