Сквозь Вселенную с дополнительными возможностями

Delphi , Графика и Игры , Canvas

Автор: Dimka Maslov
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> "Сквозь Вселенную" с дополнительными возможностями

Демонстрационный пример, динамически рисующий "движение среди звёзд" с вращением.

Зависимости: Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
Автор:       Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright:   Dimka Maslov
Дата:        1 августа 2003 г.
***************************************************** }

unit Starfields;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    procedure AB00(var Message); message $AB00;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TPoint = packed record
    X, Y, Z, R, Phi: Double;
  end;

const
  NumStars = 2000; // Количество звёзд,
  // управляет общей плотностью звёздного поля

  RangeY = 7000; // Максимальное расстояние от картинной плоскости до звезды,
  // управляет плотностью звёзд в центре

  RangeR = 7000; // Максимальное радиальное удаление от луча зрения до звезды,
  // управляет плотностью звёзд по краям

  Height = 5000; // Высота наблюдателя,
  // управляет положением центра изображения по вертикали

  Basis = 100; // Расстояние до картинной плоскости
  // управляет соотношением количества звёзд в центре к их
  // количеству по краям

  DeltaY = 5; // Шаг изменения координаты, управляет скоростью движения
  DeltaT = 0.01; // Приращение времени, управляет скоростью вращения
  Period1 = 0.1; // Период вращения звёзд
  Amplitude2 = 0.5; // Амплитуда вращательных колебаний звёзд
  Period2 = 1.0; // Период вращательных колебаний
  Period3 = 0.1; // Период изменения направления движения звёзд.

  Direction = 1; // Направление движения 1 - к наблюдателю, -1 - от него

var
  Stars: array[1..NumStars] of TPoint;
  Time: Double = 0;
  X0: Integer = 0;
  Y0: Integer = 0;

procedure InitializeStars;
var
  i: Integer;
begin
  Randomize;
  for i := 1 to NumStars do
    with Stars[i] do
    begin
      Y := Random(RangeY);
      R := RangeR - 2 * Random(RangeR);
      Phi := Random(628) / 100;
    end;
end;

procedure Perspective(const X, Y, Z, Height, Basis: Double; var XP, YP: Double);
var
  Den: Double;
begin
  Den := Y + Basis;
  if Abs(Den) < 1E-100 then
    Den := 1E-100;
  XP := Basis * X / Den;
  YP := (Basis * Z + Height * Y) / Den;
end;

function KeyPressed(VKey: Integer): LongBool;
asm
   push eax
   call GetKeyState
   and eax, 0080h
   shr al, 7
end;

procedure TForm1.AB00(var Message);
begin
  if KeyPressed(VK_ESCAPE) then
    Close
  else
    Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitializeStars;
  DoubleBuffered := True;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  X, Y: Double;
  L, T: Integer;
  i: Integer;
  D: Double;
begin
  for i := 1 to NumStars do
  begin
    Application.ProcessMessages;
    with Stars[i] do
    begin
      D := Direction * sin(Period3 * Time);
      Y := Y - D * DeltaY;
      X := R * sin((Period1 * Time + Phi) + Amplitude2 * cos(Period2 * time));
      Z := R * cos((Period1 * Time + Phi) + Amplitude2 * cos(Period2 * time));
      if D > 0 then
      begin
        if Y < 0 then
        begin
          Y := RangeY;
          R := RangeR - 2 * Random(RangeR);
          // Phi := Random(628) / 100;
        end;
      end
      else
      begin
        if Y > RangeY then
        begin
          Y := 0;
          R := RangeR - 2 * Random(RangeR);
          // Phi := Random(628) / 100;
        end;
      end;
    end;
    Perspective(Stars[i].X, Stars[i].Y, Stars[i].Z, Height, Basis, X, Y);
    L := X0 + Round(X);
    T := Y0 - Round(Y);
    Canvas.Pen.Color := clWhite;
    if Stars[i].Y < RangeY / 4 then
    begin
      Canvas.Rectangle(L, T, L + 2, T + 2);
    end
    else
    begin
      Canvas.MoveTo(L, T);
      Canvas.LineTo(L + 1, T + 1);
    end;
  end;
  PostMessage(Handle, $AB00, 0, 0);
  Time := Time + DeltaT;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  X0 := ClientWidth div 2;
  Y0 := ClientHeight * 3 div 2;
end;

end.

Программный пример на языке Delphi, создает форму с динамическим эффектом звездного поля, где звезды движутся и вращаются в 3D-перспективе.

Вот разбивка кода:

1. Единица Starfields содержит основной класс формы (TForm1) с процедурами для создания, рисования, изменения размера и обработки сообщений.
2. Процедура InitializeStars инициализирует массив записей типа TPoint, представляющих звезды, устанавливая их начальную позицию (Y, R, Phi) случайно.
3. Функция Perspective вычисляет 2D-координаты (XP, YP) для заданного 3D-пункта (X, Y, Z) с помощью формулы перспективной проекции.
4. Процедура KeyPressed проверяет, нажата ли конкретная клавиша, и возвращает булевое значение, указывающее, является ли это истинным или ложным.
5. В процедуре FormCreate форма инициализируется вызовом InitializeStars, установкой DoubleBuffered в True, что позволяет использовать двойное буферирование для более гладкого анимационного эффекта.
6. Процедура FormPaint рисует звездное поле, итерируя по массиву звезд и вычисляя новые позиции на основе времени, направления, периода, амплитуды и случайных значений. Она также обновляет координаты перспективы с помощью функции Perspective и рисует каждую звезду как маленький прямоугольник или линию в зависимости от расстояния от наблюдателя.
7. В процедуре FormResize клиентская зона формы адаптируется к новому размеру.

Код использует различные фичи Delphi, такие как:

• Декларация packed record для эффективного использования памяти
• Ключевое слово asm для вставки inline-ассемблерного кода
• Функция GetKeyState для проверки состояния клавиатуры
• Функция PostMessage для отправки сообщений другим окнам

Для улучшения этого кода следующие предложения:

1. Рассмотрите использование более описательных имен переменных и комментариев, чтобы сделать код более понятным.
2. Вместо использования Randomize; в InitializeStars, вы могли бы использовать одиночное случайное инициализирование только раз в начале программы.
3. Можете добавить дополнительные функции, такие как масштабирование, панорамирование или изменение параметров звездного поля (например, направление, период) во время выполнения.
4. Рассмотрите использование более эффективных алгоритмов для вычисления позиций звезд и координат перспективы, особенно если вы планируете использовать высокопроизводительные системы.

В целом, этот код демонстрирует основное понимание перспективной проекции 3D и программирования на Delphi, но может потребовать дополнительной оптимизации и улучшения для создания более привлекательного и реалистичного эффекта звездного поля.

Сквозь Вселенную с дополнительными возможностями - это демонстрационный пример программы на языке Delphi, динамически рисующий движение звёзд с вращением.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Canvas ::