Группа: Новичок
Регистрация: 16.12.2010
Пользователь №: 877
Сообщений: 1
Пол: Нет информации
Спасибо сказали: 0 раз(а)
Предупреждений: 0
--------------------------- | unit Unit1;
interface
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);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
//////////3D////////
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;
paused:boolean;
implementation
{$R *.dfm}
procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type
TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
pByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
TRectList = array[1..4] of TPoint;
var
x, y, W, H, v1, v2: Integer;
Dest, Src: pRGB;
VertArray: array of pByteArray;
Bmp: TBitmap;
procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
begin
ASin := Sin(AngleRad);
ACos := Cos(AngleRad);
end;
function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double):
TRectList;
var
DX, DY: Integer;
SinAng, CosAng: Double;
function RotPoint(PX, PY: Integer): TPoint;
begin
DX := PX - Center.x;
DY := PY - Center.y;
Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
end;
begin
SinCos(Angle * (Pi / 180), SinAng, CosAng);
Result[1] := RotPoint(Rect.Left, Rect.Top);
Result[2] := RotPoint(Rect.Right, Rect.Top);
Result[3] := RotPoint(Rect.Right, Rect.Bottom);
Result[4] := RotPoint(Rect.Left, Rect.Bottom);
end;
function Min(A, B: Integer): Integer;
begin
if A < B then
Result := A
else
Result := B;
end;
function Max(A, B: Integer): Integer;
begin
if A > B then
Result := A
else
Result := B;
end;
function GetRLLimit(const RL: TRectList): TRect;
begin
Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
end;
procedure Rotate;
var
x, y, xr, yr, yp: Integer;
ACos, ASin: Double;
Lim: TRect;
begin
W := Bmp.Width;
H := Bmp.Height;
SinCos(-Angle * Pi / 180, ASin, ACos);
Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0),
Angle));
Bitmap.Width := Lim.Right - Lim.Left;
Bitmap.Height := Lim.Bottom - Lim.Top;
Bitmap.Canvas.Brush.Color := BackColor;
Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
for y := 0 to Bitmap.Height - 1 do
begin
Dest := Bitmap.ScanLine[y];
yp := y + Lim.Top;
for x := 0 to Bitmap.Width - 1 do
begin
xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then
begin
Src := Bmp.ScanLine[yr];
Inc(Src, xr);
Dest^ := Src^;
end;
Inc(Dest);
end;
end;
end;
begin
Bitmap.PixelFormat := pf24Bit;
Bmp := TBitmap.Create;
try
Bmp.Assign(Bitmap);
W := Bitmap.Width - 1;
H := Bitmap.Height - 1;
if Frac(Angle) <> 0.0 then
Rotate
else
case Trunc(Angle) of
-360, 0, 360, 720: Exit;
90, 270:
begin
Bitmap.Width := H + 1;
Bitmap.Height := W + 1;
SetLength(VertArray, H + 1);
v1 := 0;
v2 := 0;
if Angle = 90.0 then
v1 := H
else
v2 := W;
for y := 0 to H do
VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
for x := 0 to W do
begin
Dest := Bitmap.ScanLine[x];
for y := 0 to H do
begin
v1 := Abs(v2 - x) * 3;
with Dest^ do
begin
B := VertArray[y, v1];
G := VertArray[y, v1 + 1];
R := VertArray[y, v1 + 2];
end;
Inc(Dest);
end;
end
end;
180:
begin
for y := 0 to H do
begin
Dest := Bitmap.ScanLine[y];
Src := Bmp.ScanLine[H - y];
Inc(Src, W);
for x := 0 to W do
begin
Dest^ := Src^;
Dec(Src);
Inc(Dest);
end;
end;
end;
else
Rotate;
end;
finally
Bmp.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i,j:byte;
cs,sn:real;
min:real;
min_pos:byte;
box,get:TRECT;
n:integer;
begin
n:=0;
if (paused=true)then exit;
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)) )+(image1.Width/2);
Viewpoints[i].y:=((newpoints[i].y*dest/(dest+newpoints[i].z)))+(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;
n:=n+1;
RotateBitmap(image2.Picture.Bitmap,1, clWhite);
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 0)+(form1.Width/2));
Viewpoints[i].y:=round((newpoints[i].y0)+(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;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if paused=false then
paused:=True
else
begin
paused:=False;
end;
end;
end.
|
