Функция Points показывает видимость точки с координатами
(a , b ), т.е. находится ли заданная точка на переднем плане.
uses Math;
function Points(a, b: real; a0, b0, c0, r: integer; var x, y: integer): boolean;
const da = 90;
var a1, a2, b1, r0, corn, xr, yr: real;
function Degree(a, a0: real): real;
var d: integer;
procedure da;
begin
d:=0;
if a<a0 then
d:=360;
if a>=360+a0 then
d:=-360;
end;
begin
da;
while d<>0 do
begin
a:=a+d;
da;
end;
Result:=a;
end;
function b90(b0: integer): integer;
begin
if b0>90 then
b0:=180-b0;
if b0<-90 then
b0:=-180-b0;
Result:=b0;
end;
begin
b0:=Round(Degree(b0, -180));
if Abs(b0)<=90 then
a:=Degree(a+da-a0, -90) else
a:=Degree(a+da-a0, 90);
b:=Degree(b, -180);
c0:=Round(Degree(c0, -180));
Result:=true;
if (b<=b90(b0)-90) or (b>=b90(b0)+90) then
Result:=false;
b1:=90-Abs(b0);
if Abs(b)<Abs(b1) then
begin
if b90(b0)=0 then
b1:=0 else
b1:=Power(Abs(b/b1), 1+Abs(b/b90(b0)))*90;
if b<0 then
b1:=-b1;
if b0<0 then
b1:=-b1;
a1:=-b1;
a2:=180+b1;
if Abs(b0)>90 then
begin
a1:=a1+180;
a2:=a2+180;
end;
if (a<a1) or (a>a2) then
Result:=false;
end;
r0:=r*Cos(b*pi/180);
xr:=r0*Cos(a*pi/180);
yr:=-r0*Sin(a*pi/180)*Sin(b0*pi/180)+r*Sin(b*pi/180)*Cos(b0*pi/180);
corn:=ArcTan(yr/xr)*180/pi;
if xr<0 then
corn:=corn+180;
corn:=corn-c0;
r0:=Sqrt(xr*xr+yr*yr);
xr:=r0*Cos(corn*pi/180);
yr:=r0*Sin(corn*pi/180);
x:=Round(xr);
y:=-Round(yr);
end;
где:
a – долгота (для карты Земли), прямое восхождение (для карты
звездного неба), задается в градусах;
b – широта (для карты Земли), склонение (для карты звездного
неба), задается в градусах;
a0 – начальная долгота, начальное прямое восхождение,
задается в градусах (см. рис. 1);
b0 – начальная широта, начальное склонение, задается в
градусах (см. рис. 2);
c0 – наклон сферы, задается в градусах (см. рис. 3);
r – радиус сферы;
x , y – вычисляемые координаты точки (для рисования 2D).
Процедура Sphere рисует сферу с географической сеткой. Экватор и
нулевой меридиан выделены толстой линией.
procedure Sphere(Canvas: TCanvas; a0, b0, c0, r, x0, y0: integer);
var a, b, x, y: integer;
vis, visp: boolean;
begin
Canvas.Ellipse(x0-r, y0-r, x0+r+1, y0+r+1);
for b:=-90 to 90 do
begin
if b mod 10 <> 0 then
Continue;
if b=0 then
Canvas.Pen.Width:=2 else
Canvas.Pen.Width:=1;
vis:=false;
for a:=0 to 360 do
begin
visp:=Points(a, b, a0, b0, c0, r, x, y);
if visp then
if not vis then
begin
vis:=true;
Canvas.MoveTo(x0+x, y0+y);
end else
Canvas.LineTo(x0+x, y0+y) else
vis:=false;
end;
end;
for a:=0 to 360 do
begin
if a mod 15 <> 0 then
Continue;
if a=0 then
Canvas.Pen.Width:=2 else
Canvas.Pen.Width:=1;
vis:=false;
for b:=-90 to 90 do
begin
visp:=Points(a, b, a0, b0, c0, r, x, y);
if visp then
if not vis then
begin
vis:=true;
Canvas.MoveTo(x0+x, y0+y);
end else
Canvas.LineTo(x0+x, y0+y) else
vis:=false;
end;
end;
end;
где:
Canvas – объект для рисования (например,
Label1.Canvas );
a0 – начальная долгота, начальное прямое восхождение,
задается в градусах (см. рис. 1);
b0 – начальная широта, начальное склонение, задается в
градусах (см. рис. 2);
c0 – наклон сферы, задается в градусах (см. рис. 3);
r – радиус сферы;
x0 , y0 – координаты центра сферы относительно
Canvas .
Например,
Sphere(Image1.Canvas, 20, 0, 0, 150, 155, 155) :

Рис. 1. Изменение начальной долготы (начального прямого восхождения) на 20° –
поворот сферы относительно оси вращения
Например,
Sphere(Image1.Canvas, 0, 40, 0, 150, 155, 155) :

Рис. 2. Изменение начальной широты (начального склонения) на 40° – поворот
сферы "на себя"
Например,
Sphere(Image1.Canvas, 0, 0, 10, 150, 155, 155) :

Рис. 3. Наклон сферы на 10° вправо (по часовой стрелке)
Например,
Sphere(Image1.Canvas, 20, 40, 10, 150, 155, 155) :

Рис. 4. Поворот сферы во всех трех направлениях
Примечание. Если поместить процедуру
Sphere в таймер и постоянно изменять начальные координаты a0 ,
b0 или c0 (или их комбинации), то можно увидеть анимацию
– вращение сферы.
Например. Разместим на сфере 3 точки с координатами
(340°; 40°) – ярко-зеленого цвета, (35°; -28°) – красного цвета,
(100°; -52°) – синего цвета. Код, позволяющий разместить точки на сфере,
представлен ниже:
procedure TForm1.Button1Click(Sender: TObject);
const r = 150; // радиус сферы
x0 = 155; // координаты центра сферы
y0 = 155;
a0 = 20; // поворот сферы относительно оси вращения
b0 = 40; // поворот сферы "на себя"
c0 = 10; // наклон сферы
var x, y: integer;
begin
Sphere(Image1.Canvas, a0, b0, c0, r, x0, y0);
if Points(340, 40, a0, b0, c0, r, x, y) then
with Image1.Canvas do
begin
Pen.Color:=clLime;
Brush.Color:=clLime;
Ellipse(x0+x-2, y0+y-2, x0+x+3, y0+y+3);
end;
if Points(35, -28, a0, b0, c0, r, x, y) then
with Image1.Canvas do
begin
Pen.Color:=clRed;
Brush.Color:=clRed;
Ellipse(x0+x-2, y0+y-2, x0+x+3, y0+y+3);
end;
if Points(100, -52, a0, b0, c0, r, x, y) then
with Image1.Canvas do
begin
Pen.Color:=clBlue;
Brush.Color:=clBlue;
Ellipse(x0+x-2, y0+y-2, x0+x+3, y0+y+3);
end;
end;

Рис. 5. Расположение точек на сфере
На рис. 5 показана сфера с размещенными на ней точками. Здесь нужно обратить
внимание, что синяя точка на рисунке отсутствует. Это связано с тем, что данная
точка расположена на противоположной стороне сферы (на заднем плане) и она нам не
видна.
|