Неверов Евгений Викторович
QR-код
Меню сайта
Категории раздела
Программирование на языке Паскаль [26]
В данной категории представлены новые функции, созданные на языке Паскаль, которые могут пригодиться при написании своих программ
Программирование на Delphi [19]
В данной категории представлены полезные подпрограммы, которые могут пригодиться при написании своих программ, а также рассматриваются примеры готовых проектов, создаваемых в среде программирования Delphi
Программирование на HTML [1]
В данной категории рассматриваются примеры готовых проектов, создаваемых на языке HTML
Мои программы [1]
Описание разработанных автором программ.
Online-программы [2]
Прочее [42]
Свободная тематика
Мини-чат
200
Наш опрос
Оцените мой сайт
Всего ответов: 59
Статистика

Онлайн всего: 4
Гостей: 4
Пользователей: 0

Сфера (3D)

Функция 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 показана сфера с размещенными на ней точками. Здесь нужно обратить внимание, что синяя точка на рисунке отсутствует. Это связано с тем, что данная точка расположена на противоположной стороне сферы (на заднем плане) и она нам не видна.

Категория: Программирование на Delphi | Добавил: newerow1989 |
Просмотров: 1137 | Рейтинг: 0.0/0
Всего комментариев: 0
Имя *:
Email:
Код *:
Вход на сайт
Поиск
Друзья сайта
Заработок в Интернете
Для начала необходим Электронный PAYEER® кошелек!
Copyright MyCorp © 2025
Версия для мобильных устройств. Яндекс.Метрика Анализ сайта Проверить мой сайт на ScamAdviser.com