• Главная
  • Исходники Delphi
  • Справочники Delphi
  • Книги Delphi
  • Основы Delphi
  • библиотека Delphi исходников
  • Форум
  • Блоги

Последние записи

  • Прозрачность тайлсета в 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 на другой лист по условию
  • Мелодия в Pascal.ABC.Net с помощью System.Console.Beep — задержка воспроизведения звука

made in programmersforum 3

programmersforum3

  • .NET
  • ASP.NET
  • assembler
  • Basic
  • c/c++
  • CMS
  • Delphi
  • HTML
  • iPhone
  • Java
  • JavaScript
  • Linux
  • Pascal
  • Perl
  • Photoshop
  • php
  • Python
  • Ruby
  • SEO
  • sql
  • VBA
  • Win Api
  • Windows
  • XML и XSLT
  • Администрирование ОС
  • Апгрейды
  • Архив
  • Безопасность
  • Блоги
  • Веб-аналитика
  • Железо
  • Журнал
  • Заметки
  • Имейдж
  • Интервью
  • Исходники
  • Новости
  • Общалка
  • Операционные системы
  • Пост-обзор
  • Профлитература
  • Рассылка
  • Реклама
  • си шарп
  • Советы
  • Софт
  • Статьи
  • Топик-обзор
  • Файлы








3rd
Ноя

Как нарисовать стрелку в конце эллиптической дуги?

Posted by Chas under Delphi

есть 4-ре точки (прямоугольник) в котором надо нарисовать эллиптическую дугу
и в конце этой дуги нарисовать стрелку (наконечник)
подскажите как это сделать правильно?

woojin
вот что получилось:

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 := 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] тема на форуме

Похожие статьи

  • Движение обьекта на заданный угол
  • Крестики нолики исходник
  • Нарисовать флаг Дании и Швейцарии
  • Соединить 2 edit линией
  • Как сделать снимок memo поля в программе
  • Как сделать скриншот во время игры?
  • Как сделать выделение кнопки как в delphi?
  • Баловство с Random
  • Движение прямоугольника вместе с курсором
  • Описание CopyRect
Теги: canvas | PaintBox | TBitMap | графика








© Copyright "Клуб программистов" – материалы по Delphi и С++. Создание и продвижние сайта - Веб-сателлит.