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

{ **** 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.