Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

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