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

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

Сфера (3D)
uses Math;

function Tochka(a, b: real; a0, b0, c0, r: integer; var x, y: integer): boolean;
const da=90;
var a1, a2, b1, r0, ugol, xr, yr: real;

   function Gradus(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(Gradus(b0, -180));
   If Abs(b0)<=90 then
      a:=Gradus(a+da-a0, -90) else
      a:=Gradus(a+da-a0, 90);
   b:=Gradus(b, -180);
   c0:=Round(Gradus(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);
   ugol:=ArcTan(yr/xr)*180/pi;
   If xr<0 then
      ugol:=ugol+180;
   ugol:=ugol-c0;
   r0:=Sqrt(xr*xr+yr*yr);
   xr:=r0*Cos(ugol*pi/180);
   yr:=r0*Sin(ugol*pi/180);
   x:=Round(xr);
   y:=-Round(yr);
end;

где

a - долгота (для карты Земли), прямое восхождение (для карты звездного неба);

b - широта (для карты Земли), склонение (для карты звездного неба);

a0 - начальная долгота, начальное прямое восхождение (см. рис. 1);

b0 - начальная широта, начальное склонение (см. рис. 2);

c0 - наклон сферы (см. рис. 3);

r - радиус сферы;

x, y - вычисляемые координаты точки (для рисования 2D).

Функция Tochka показывает видимость точки с координатами (a, b), т.е. находится ли заданная точка на переднем плане.

Примечание. Координаты a, b, a0, b0, c0 задаются в градусах.



Рис. 1. Изменение начальной долготы (начального прямого восхождения) на 20° - поворот сферы относительно оси вращения


Рис. 2. Изменение начальной широты (начального склонения) на 40° - поворот сферы "на себя"


Рис. 3. Наклон сферы на 10° вправо (по часовой стрелке)

procedure Sphere(Canvas: TCanvas; a0, b0, c0, r, x0, y0: integer);
var a, b, x, y: integer;
    vis, vist: 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
         vist:=Tochka(a, b, a0, b0, c0, r, x, y);
         If vist 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
         vist:=Tochka(a, b, a0, b0, c0, r, x, y);
         If vist 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);

x0, y0 - координаты центра сферы относительно Canvas.

Процедура Sphere рисует сферу с географической сеткой. Экватор и нулевой меридиан выделены толстой линией.

Примечание. Если поместить процедуру Sphere в таймер и постоянно изменять начальные координаты a0, b0 или c0 (или их комбинации), то можно увидеть анимацию - вращение сферы.

Например, на рис. 4 показана сфера, нарисованная после вызова процедуры FormCreate:

procedure TForm1.FormCreate(Sender: TObject);
const r=150;
begin
   Sphere(Image1.Canvas, 20, 40, 10, r, 155, 155);
end;


Рис. 4. Поворот сферы во всех трех направлениях

Разместим на сфере 3 точки с координатами (340°; 40°) - ярко-зеленого цвета, (35°; -28°) - красного цвета, (100°; -52°) - синего цвета. Код, позволяющий разместить точки на сфере, представлен ниже (процедура FormCreate):

procedure TForm1.FormCreate(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 Tochka(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 Tochka(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 Tochka(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 (02.10.2016)
Просмотров: 965 | Рейтинг: 0.0/0
Всего комментариев: 0
Имя *:
Email *:
Код *:
Вход на сайт
Поиск
Друзья сайта
Заработок в Интернете
Для начала необходим Электронный PAYEER® кошелек!
Copyright MyCorp © 2024
Версия для мобильных устройств. Яндекс.Метрика БКНС Анализ сайта