{ **** UBPFD *********** by delphibase.endimus.com ****
>> "Сквозь Вселенную" с дополнительными возможностями
Демонстрационный пример, динамически рисующий "движение среди звёзд" с вращением.
Зависимости: Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
Автор: Dimka Maslov, <a href="mailto:mainbox@endimus.ru">mainbox@endimus.ru</a>, 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.