Эллипс под углом.

← →
farrex © (2008-03-08 21:51) [0]

Привет всем мастерам программирования! :)
Задача передо мной стоит такая: задаются 2 точки, надо нарисовать эллипс с вершинами в этих точках. Другими словами надо нарисовать эллипс наклоенный под углом зная координаты его вершин и радиусов.

Способы, которые я придумал, не позволяют нарисовать четкий эллипс. Теряется реалистичность. Так как при большом наклоне эллипса самые крайние левые (правые) точки эллипса имиеют координату по Х меньшую (большую), чем координата вершины. В моей же программе самые крайние точки - это точки, которые задаются в начале программы (которые должны быть вершинами эллипса).

Может кто-то сталкивался с такой проблемой?

← →
Dimaxx © (2008-03-09 00:09) [1]

Процедура рисования наклонного эллипса у меня есть, но там просто задается угол наклона, координаты центра эллипса и размеры большой и малой полуоси.

← →
farrex © (2008-03-09 10:58) [2]

Dimaxx, буду невероятно признателен, если сможешь мне выслать эту процедуру (farrex@sibmail.com)!!!
Я уже запарился с моей корявой процедурой....

← →
{RASkov} © (2008-03-09 14:05) [3]

> [2] farrex © (09.03.08 10:58)

Попробуй:
procedure RotatedEllipse(ACnv: TCanvas; const X1, Y1, X2, Y2, AAngle: Integer); var NewF, OldF: TXForm; begin SetGraphicsMode(ACnv.Handle, GM_Advanced); GetWorldTransform(ACnv.Handle, OldF); with NewF do begin eM11 := 1 * Cos(AAngle / 360 * Pi * 2); eM22 := 1 * Cos(AAngle / 360 * Pi * 2); eM12 := 1 * Sin(AAngle / 360 * Pi * 2); eM21 := 1 * -Sin(AAngle / 360 * Pi * 2); eDX := Round((X1 + X2) / 2); eDY := Round((Y1 + Y2) / 2); end; ModifyWorldTransform(ACnv.Handle, NewF, MWT_LEFTMULTIPLY); ACnv.Ellipse(X1, Y1, X2, Y2); ACnv.Font.Size:=20; ACnv.TextOut(100, 45, "Rotated Ellipse"); SetWorldTransform(ACnv.Handle, OldF); end; RotatedEllipse(Canvas, 30, 30, 300, 100, 45);

Крутит относительно ВЛ угла....

← →
farrex © (2008-03-09 15:44) [4]

Спасибо огромное!
Все работает, все классно!!!

← →
farrex © (2008-03-09 15:57) [5]

{RASkov}, скажи, а что происходит с координатами после использования этой процедуры?
И как сразу после использования процедуры восстановить прежнюю систему координат?

← →
{RASkov} © (2008-03-09 18:01) [6]

> [5] farrex © (09.03.08 15:57)
> скажи, а что происходит с координатами после использования
> этой процедуры?

См последнюю строку... где восстанавливается старая система координат...

Вот тебе проверка:
begin
Canvas.Brush.Style:=bsClear;
Canvas.Font.Color:=clRed; Canvas.Font.Size:=9{11};
Canvas.TextOut(10,10, "TEST");
Canvas.Font.Color:=clGreen;
RotatedEllipse(Canvas, 30, 30, 300, 100, 45);
Canvas.Font.Color:=clBlue; Canvas.Font.Size:=9;
Canvas.TextOut(10,10, "TEST");
end;

Если увидешь красную надпись, то тест провален.... координаты не восстановлены...

← →
farrex © (2008-03-09 19:07) [7]

Все получилось. Лишнее закомментировал, блин :) Хотел просто надпись убрать...

Все. Спасибо!!!!

← →
Dimaxx © (2008-03-10 17:55) [8]

X,Y - координаты центра эллипса
A,B - размеры большой и малой полуоси эллипса
Angle - угол наклона в градусах

Угол наклона исчисляется стандартно, против часовой стрелки.

procedure Ellipse(X,Y,A,B: integer; Angle: single); var I,S,C,H2,K1,K2,R: single; X1,X2,Y1,Y2,X3,Y3,X4,Y4,YY: integer; begin I:=(180-Angle)*PI/180; S:=Sin(I); C:=Cos(I); H2:=Sqr(A*S)+Sqr(B*C); K1:=S*C*(Sqr(A)-Sqr(B))/H2; K2:=A*B/H2; YY:=0; while Sqr(YY)<=H2 do begin R:=K2*Sqrt(H2-Sqr(YY)); X1:=Round(K1*YY+R); X2:=Round(K1*YY-R); if YY=0 then begin Pixels[X+X1,Y+YY]:=Pen.Color; Pixels[X-X1,Y-YY]:=Pen.Color; end else begin MoveTo(X+X1,Y+YY); LineTo(X+X3,Y+YY-1); MoveTo(X+X2,Y+YY); LineTo(X+X4,Y+YY-1); MoveTo(X-X1,Y-YY); LineTo(X-X3,Y-YY+1); MoveTo(X-X2,Y-YY); LineTo(X-X4,Y-YY+1); end; X3:=X1; X4:=X2; Inc(YY); end; H2:=Int(1.99*(YY-Sqrt(H2))); MoveTo(X+X3,Y+YY-1); LineTo(X+X3-Round(R),Y+YY-Round(H2)); LineTo(X+X4,Y+YY-1); MoveTo(X-X3,Y-YY+1); LineTo(X-X3+Round(R),Y-YY+Round(H2)); LineTo(X-X4,Y-YY+1); end;

← →
farrex © (2008-03-10 21:13) [9]

Dimaxx, а почему Delphi ругается - обзывает pixels и moveto неизвестными переменными...?

← →
Dimaxx © (2008-03-10 21:30) [10]

Потому что они растут от TCanvas. Изначально я хотел прикрутить ее туда...

← →
DVM © (2008-03-10 22:06) [11]

> Dimaxx ©

Pixels[] (как варианты SetPixel/GetPixel) - это очень и очень медленно, к сожалению.

← →
{RASkov} © (2008-03-10 22:27) [12]

> [9] farrex © (10.03.08 21:13)

procedure Ellipse(Cnv: TCanvas; X,Y,A,B: integer; Angle: single); var I,S,C,H2,K1,K2,R: single; X1,X2,Y1,Y2,X3,Y3,X4,Y4,YY: integer; begin with Cnv do begin I:=(180-Angle)*.... ........ end; end;

← →
Dimaxx © (2008-03-11 03:17) [13]

> Pixels[] (как варианты SetPixel/GetPixel) - это очень и
> очень медленно, к сожалению.

В данной процедуре они вызываются всего 1 раз при YY=0.

← →
DVM © (2008-03-11 12:51) [14]

> Dimaxx © (11.03.08 03:17) [13]

Но зато много раз вызываются MoveTo LineTo - а их вызовы занимают времени не меньше, чем SetPixel.

{RASkov} © (09.03.08 14:05) [3]

в 6 раз быстрее, чем

Dimaxx © (10.03.08 17:55) [8]

но [8] удобнее несколько (легче представить результат в воображении)

← →
Dimaxx © (2008-03-12 10:50) [15]

Ну код написан, чтобы нарисовать один или два наклонных эллипса, а не фигачить десятки тысяч штук в секунду. К тому же, согласен, применение LineTo дороговато обходится по времени.

А мне понравился код(ну по крайней мере результат его деяний) [8].... удобно...
С учетом [14], [15] конечно же...

+ Ну конечно же его[8] дооптимизировать нужно.... ну хотя бы от варнингов избавится...;)

Рассчитать контрольные точки четырех кривых Безье, образующих единичную окружность, провести над ними аффинное преобразование, переводящее окружность в нужный эллипс (растяжение+поворот+перенос).
Windows GDI (в NT-системах) рисует эллипсы именно с помощью кривых Безье

> Рассчитать контрольные точки четырех кривых Безье, образующих
> единичную окружность, провести над ними аффинное преобразование,
> переводящее окружность в нужный эллипс (растяжение+поворот+перенос).

Помедленнее, плз, я не успеваю записывать... :) Код это не мой - содран со старого журнала (сырец ваще на Бейсике был). Поскольку надо было срочно - пришлось "адаптировать" бейсиковский вариант...

// CX, CY: кооординаты центра эллипса // A, B : полуоси // Angle - угол поворота в радианах procedure EllipseAngle(Canvas: TCanvas; CX, CY, A, B: Integer; Angle: Double); const DXY = 0.55228475; var X, Y: array[0..12] of Single; DX, DY: Single; CF, SF: Single; Pts: array[0..12] of TPoint; i: Integer; begin DX := A * DXY; DY := B * DXY; X[0] := A; Y[0] := 0; X[1] := A; Y[1] := DY; X[2] := DX; Y[2] := B; X[3] := 0; Y[3] := B; X[4] := -DX; Y[4] := B; X[5] := -A; Y[5] := DY; X[6] := -A; Y[6] := 0; X[7] := -A; Y[7] := -DY; X[8] := -DX; Y[8] := -B; X[9] := 0; Y[9] := -B; X[10] := DX; Y[10] := -B; X[11] := A; Y[11] := -DY; X[12] := A; Y[12] := 0; CF := Cos(Angle); SF := Sin(Angle); for i := 0 to 12 do begin Pts[i].X := Round(X[i] * CF - Y[i] * SF + CX); Pts[i].Y := Round(X[i] * SF + Y[i] * CF + CY); end; Canvas.PolyBezier(Pts); end; procedure TForm2.Button23Click(Sender: TObject); begin EllipseAngle(Canvas, 200, 200, 200, 100, - Pi/4); end;

← →
имя (2009-03-20 16:58) [21]

Удалено модератором

Эллипс под углом. Найти похожие ветки