-
Привет всем мастерам программирования! :)
Задача передо мной стоит такая: задаются 2 точки, надо нарисовать эллипс с вершинами в этих точках. Другими словами надо нарисовать эллипс наклоенный под углом зная координаты его вершин и радиусов.
Способы, которые я придумал, не позволяют нарисовать четкий эллипс. Теряется реалистичность. Так как при большом наклоне эллипса самые крайние левые (правые) точки эллипса имиеют координату по Х меньшую (большую), чем координата вершины. В моей же программе самые крайние точки - это точки, которые задаются в начале программы (которые должны быть вершинами эллипса).
Может кто-то сталкивался с такой проблемой?
-
Процедура рисования наклонного эллипса у меня есть, но там просто задается угол наклона, координаты центра эллипса и размеры большой и малой полуоси.
-
Dimaxx, буду невероятно признателен, если сможешь мне выслать эту процедуру (farrex@sibmail.com)!!!
Я уже запарился с моей корявой процедурой....
-
> [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); Крутит относительно ВЛ угла....
-
Спасибо огромное!
Все работает, все классно!!!
-
{RASkov}, скажи, а что происходит с координатами после использования этой процедуры?
И как сразу после использования процедуры восстановить прежнюю систему координат?
-
> [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;
Если увидешь красную надпись, то тест провален.... координаты не восстановлены...
-
Все получилось. Лишнее закомментировал, блин :) Хотел просто надпись убрать...
Все. Спасибо!!!!
-
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;
-
Dimaxx, а почему Delphi ругается - обзывает pixels и moveto неизвестными переменными...?
-
Потому что они растут от TCanvas. Изначально я хотел прикрутить ее туда...
-
> Dimaxx ©
Pixels[] (как варианты SetPixel/GetPixel) - это очень и очень медленно, к сожалению.
-
> [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;
-
> Pixels[] (как варианты SetPixel/GetPixel) - это очень и
> очень медленно, к сожалению.
В данной процедуре они вызываются всего 1 раз при YY=0.
-
> 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] удобнее несколько (легче представить результат в воображении)
-
Ну код написан, чтобы нарисовать один или два наклонных эллипса, а не фигачить десятки тысяч штук в секунду. К тому же, согласен, применение LineTo дороговато обходится по времени.
-
А мне понравился код(ну по крайней мере результат его деяний) [8].... удобно...
С учетом [14], [15] конечно же...
-
+ Ну конечно же его[8] дооптимизировать нужно.... ну хотя бы от варнингов избавится...;)
-
Рассчитать контрольные точки четырех кривых Безье, образующих единичную окружность, провести над ними аффинное преобразование, переводящее окружность в нужный эллипс (растяжение+поворот+перенос).
Windows GDI (в NT-системах) рисует эллипсы именно с помощью кривых Безье
-
> Рассчитать контрольные точки четырех кривых Безье, образующих
> единичную окружность, провести над ними аффинное преобразование,
> переводящее окружность в нужный эллипс (растяжение+поворот+перенос).
Помедленнее, плз, я не успеваю записывать... :) Код это не мой - содран со старого журнала (сырец ваще на Бейсике был). Поскольку надо было срочно - пришлось "адаптировать" бейсиковский вариант...
-
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;
-
Удалено модератором
|
Есть новые 
Нет новых [134431 +10][b:0][p:0.003]