Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
default.doc
Скачиваний:
5
Добавлен:
01.05.2025
Размер:
982 Кб
Скачать
☆

Лабораторна робота №8

ІМІТАЦІЯ РУХУ ПЛАНЕТ НАВКОЛО СОНЦЯ

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms

Dialogs, ExtCtrls, StdCtrls;

const

dest=500;

des=10;

n_v=10;

type

TVector = record

x,y,z:real;

end;

type

TPlanet = record

pos :TVector;

grad :real;

vec :real;

image :TPicture;

end;

type

TForm1 = class(TForm)

Timer1: TTimer;

Image2: TImage;

Image1: TImage;

Image3: TImage;

Button1: TButton;

procedure Timer1Timer(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

{ Public declarations }

Viewpoints : array[1..n_v] of TVector;

points : array[1..n_v] of TVector;

newPoints : array[1..n_v] of TVector;

Planets : array[1..n_v] of TPlanet;

draw_posled :array[1..n_v] of byte;

end;

var

Form1: TForm1;

g:real;

fil:text;

v_n:byte;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var i,j:byte;

cs,sn:real;

min:real;

min_pos:byte;

box,get:TRECT;

begin

g:=0.5;

if g>2*pi then g:=0;

for i:=1 to v_n do

begin

planets[i].grad:=planets[i].grad+planets[i].vec;

if planets[i].grad>2*pi then planets[i].grad:=0;

if planets[i].grad<0 then planets[i].grad:=2*pi;

cs:=cos(planets[i].grad);

sn:=sin(planets[i].grad);

newPoints[i].x:=points[i].x*cs+points[i].z*sn;

newPoints[i].y:=points[i].y;

newPoints[i].z:=-points[i].x*sn+points[i].z*cs;

newPoints[i].x:=newPoints[i].x;

newPoints[i].y:=newPoints[i].y*cos(g)-newPoints[i].z*sin(g);

newPoints[i].z:=newPoints[i].y*sin(g)+newPoints[i].z*cos(g);

Viewpoints[i].x:=((newpoints[i].x*dest/(dest+newpoints[i].z))*80)+(image1.Width/2);

Viewpoints[i].y:=((newpoints[i].y*dest/(dest+newpoints[i].z))*80)+(image1.Height/2);

Viewpoints[i].z:=newpoints[i].z;

planets[i].pos:=Viewpoints[i];

end;

image1.Canvas.Lock;

image1.canvas.Brush.Color:=clblack;

image1.canvas.CopyRect(image1.Canvas.ClipRect,image3.Canvas,image3.Canvas.ClipRect);

image1.Canvas.Brush.Color:=clred;

image2.Canvas.Brush.Color:=clwhite;

image2.Canvas.Pen.Color:=clwhite;

for j:=1 to v_n do

begin

min:=planets[1].pos.z;

min_pos:=1;

for i:= 2 to v_n do

if planets[i].pos.z>min then

begin

min:=planets[i].pos.z;

min_pos:=i;

end;

planets[min_pos].pos.z:=-3000;

draw_posled[j]:=min_pos;

end;

for i:= 1 to v_n do

begin

begin

image2.Canvas.Rectangle(image2.Canvas.ClipRect);

box.Left:=0;

box.Top :=0;

box.Right:=round((planets[draw_posled[i]].image.Graphic.Width)*des/(des+Viewpoints[draw_posled[i]].z));

box.Bottom:=round((planets[draw_posled[i]].image.Graphic.Height)*des/(des+Viewpoints[draw_posled[i]].z));

get.Left:=0;

get.Top:=0;

get.Right:=planets[draw_posled[i]].image.Bitmap.Width;

get.Bottom:=planets[draw_posled[i]].image.Bitmap.Height;

image2.Transparent:=true;

image2.Picture.Bitmap.TransparentColor:=$FFFFFF;

image2.Picture.Bitmap.Transparent:=true;

image2.Canvas.copyRect(box,planets[draw_posled[i]].image.Bitmap.Canvas,planets[draw_posled[i]].image.Bitmap.Canvas.ClipRect);

image2.Width:=box.Right-box.Left;

image2.Height:=box.Bottom-box.Top;

image1.Canvas.Draw(round(planets[draw_posled[i]].pos.x-(planets[draw_posled[i]].image.Graphic.Width div 2)*des/(des+Viewpoints[draw_posled[i]].z))

round(planets[draw_posled[i]].pos.y-(planets[draw_posled[i]].image.Graphic.Height div 2)*des/(des+Viewpoints[draw_posled[i]].z))

image2.Picture.Bitmap);

end;

end;

image1.Canvas.Unlock;

end;

procedure TForm1.FormDestroy(Sender: TObject);

var

i:integer;

begin

for i:=1 to v_n do

begin

planets[i].image.Destroy;

end;

end;

procedure TForm1.FormActivate(Sender: TObject);

var i:integer;

begin

Image1.Canvas.Pixels[ 0,0]:=$FFFFFF;

image1.Canvas.Brush.Color:=clwhite;

image1.Canvas.Rectangle(Image3.Canvas.ClipRect);

image3.Canvas.Brush.Color:=clblack;

image3.Canvas.Rectangle(Image3.Canvas.ClipRect);

for i:=1 to 1000 do

begin

Image3.Canvas.Pixels[ random(form1.Width)

random(form1.Height)]:=$FFFFFF;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

i:byte;

str:string;

begin

v_n:=8;

g:=0;

AssignFile(fil,'3d.txt');

reset(fil);

readln(fil,v_n);

for i:=1 to v_n do

begin

readln(fil);

readln(fil,points[i].x);

readln(fil,points[i].y);

readln(fil,points[i].z);

readln(fil,planets[i].vec);

planets[i].grad:=0;

planets[i].image:=TPicture.Create;

readln(fil,str);

planets[i].image.LoadFromFile(str);

end;

CloseFile(fil);

g:=pi/2;

g:=0;

for i:=1 to v_n do

begin

newPoints[i]:=points[i];

Viewpoints[i].x:=round((newpoints[i].x*100)+(form1.Width/2));

Viewpoints[i].y:=round((newpoints[i].y*100)+(form1.Height/2));

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

AnimateWindow(Handle, 700, AW_BLEND) //плавное поява форми

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

AnimateWindow(Handle, 700, AW_HIDE or AW_BLEND) //плавное розчинення форми

end; end.

Текстовий файл з координатами руху

10 // Vertexs

//////// point(1) Сонце //////////

0.30000

0.10000

0.00000

0

sun.bmp

//////// point(2) Меркурій //////////

1.00000

0.00000

0.00000

0.05

mercurij.bmp

//////// point(3) Венера //////////

1.20000

0.00000

0.00000

0.045

venera.bmp

//////// point(4) Земля //////////

1.30000

0.00000

0.00000

0.04

zemlya.bmp

//////// point(5) Марс //////////

1.40000

0.00000

0.00000

0.035

mars.bmp

//////// point(6) Юпітер //////////

3.00000

0.00000

0.00000

0.03

jupiter.bmp

//////// point(7) Сатурн //////////

6.00000

0.00000

0.00000

0.025

Saturn.bmp

//////// point(8) Уран //////////

10.00000

0.00000

0.00000

0.02

uran.bmp

//////// point(9) нептун //////////

15.00000

0.00000

0.00000

0.015

neptun.bmp

//////// point(10) Плутон //////////

19.0000

0.00000

0.00000

0.01

pluton.bmp

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]