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);
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));
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].x0)+(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.
Warning: in_array() expects parameter 2 to be array, null given in /var/www/coder/data/www/coders-library.ru/modules/forums/function/forum_topic.php on line 235
Тему читают 0 чел.Пользователи(0):
Внимание! Если у вас не получилось найти нужную информацию, используйте рубрикатор или воспользуйтесь поиском
)+(image1.Width/2);
0)+(form1.Width/2));
