Автор: 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.