program ThreeDi;
uses
GraphABC, System, System.Collections.Generic;
const
n = 10;gr = 4;
var
radius: array[1..n] of real; angular: array[1..n] of real; height: array[1..n] of real;
x: array[1..n] of real; a: array[1..n] of real; z: array[1..n] of real;
displayX: array[1..n] of real; displayY: array[1..n] of real;
grs: array[1..gr] of string; colors: array[1..gr] of color;
num: array[1..4] of integer;numZ: array[1..gr] of integer;
numP: array of point; GNOMZ: array[1..gr] of integer;
zx, zy, koef, k1, fps, mousex, mousey, alpha1, alpha2, alpha3: real;
slepper, panelWidth, panelX, osz, osx, cod, x12, y12, y13, x13, angularX: integer;
vers, text: string;
sw, rang, drawbody, drawskeleton, drawpanel, rectfps: boolean;
//Процедура задания начальных координат
procedure InitMap;
begin;
radius[1] := 60; angular[1] := 90; height[1] := 35;
radius[2] := 60; angular[2] := 90; height[2] := -25;
radius[3] := 60; angular[3] := 180; height[3] := 35;
radius[4] := 60; angular[4] := 180; height[4] := -25;
radius[5] := 60; angular[5] := 270; height[5] := 35;
radius[6] := 60; angular[6] := 270; height[6] := -25;
radius[7] := 60; angular[7] := 0; height[7] := 35;
radius[8] := 60; angular[8] := 0; height[8] := -25;
grs[1]:='001-002-004-003'; colors[1] := argb(255, 50, 80, 100);
grs[2]:='004-003-005-006'; colors[2] := argb(155, 50, 80, 100);
grs[3]:='005-006-008-007'; colors[3] := argb(175, 50, 80, 100);
grs[4]:='008-007-001-002'; colors[4] := argb(200, 50, 80, 100);
sw := true; rang := true; drawbody := true; drawskeleton := true; drawpanel := true; rectfps := false;
SetWindowTitle(floattostr(MouseX));
koef := 3;k1 := 1;slepper := 0;
setlength(numP, 4);
osz := 0;osx := 0;
angularX := 0;
panelwidth := 200;
alpha1 := 16.97; alpha2 := 15.97; alpha3 := 0.0528;
end;
procedure MouseMove(x11, y11, mb: integer);
begin
angularX := (round(-(x11 + x12) / 5));
x13 := x11;
y13 := y11;
end;
//Процедура математических вычислений, главная часть "движка"
procedure MainMath;
begin;
{$omp parallel for }
{$omp parallel for }
for var mathh := 1 to n do
begin
ZX := (Window.Width - panelwidth) / 2; ZY := Window.height / 2;
koef := (ZX + ZY) / 300;
a[mathh] := (angular[mathh] + angularX) * (3.14159 / 180);
x[mathh] := osx + (radius[mathh] * sin(a[mathh]));
z[mathh] := osz + (radius[mathh] * cos(a[mathh]));
displayX[mathh] := zx + (koef * (x[mathh] * (alpha1 / (alpha2 + z[mathh] * alpha3))));
displayY[mathh] := zy + (koef * (height[mathh] * (alpha1 / (alpha2 + z[mathh] * alpha3))));
end;
end;
//Оганичиваем FPS
procedure cutfps;
begin;
if fps >= 31 then slepper += 2;
if fps <= 29 then slepper -= 1;
if slepper <= 30 then slepper += 3;
if slepper > 30 then slepper -= 2;
sleep(round(slepper * 1.5));
end;
//Процедура просчёта граней, которые будут вырисовываться первыми, без вырисовки.
procedure Rangularing;
begin;
if rang = true then begin
for var t := 1 to gr do
begin
text := copy(grs[t], 1, 3);
val(text, num[1], cod);
text := copy(grs[t], 5, 3);
val(text, num[2], cod);
text := copy(grs[t], 9, 3);
val(text, num[3], cod);
text := copy(grs[t], 13, 3);
val(text, num[4], cod);
numZ[t] := round(((z[num[1]] + z[num[2]] + z[num[3]]+z[num[4]]) / 3));GNOMZ[t] := numZ[t];
end;
for var T := 2 TO gr - 1 do
begin
for var T1 := 1 TO gr - (T - 1) do
begin
if numZ[T1] < numZ[T1 + 1] THEN begin
SWAP(numZ[T1], numZ[T1 + 1]); SWAP(grs[T1], grs[T1 + 1]);SWAP(colors[t1], colors[t1 + 1]);
end;
end;
end;
end;
end;
//Вырисовка "заранжированных" граней.
procedure DrawRangularing;
begin;
if sw = true then begin
for var t := 1 to gr do
begin
text := copy(grs[t], 1, 3);
val(text, num[1], cod);
text := copy(grs[t], 5, 3);
val(text, num[2], cod);
text := copy(grs[t], 9, 3);
val(text, num[3], cod);
text := copy(grs[t], 13, 3);
val(text, num[4], cod);
for var gg := 0 to 3 do
begin
numP[gg].X := round(displayX[num[gg + 1]]);
numP[gg].Y := round(displayY[num[gg + 1]]);
end;
if drawbody = true then setbrushcolor(colors[t]);
if drawbody = false then setbrushcolor(argb(0, 0, 0, 0));
if drawskeleton = true then setpencolor(clblack);
if drawskeleton = false then setpencolor(argb(0, 0, 0, 0));
Polygon(numP);
end;
end;
end;
//Обработчик события нажатия клавиш мыши
procedure MyMouseDown(mxx, myy, mb: integer);
begin
MouseX := mxx;
MouseY := myy;
end;
procedure BackPanel;
begin;
OnMouseDown := MyMouseDown;
vers := ' xClick ' + (floattostr(MouseX)) + ' yClick ' + floattostr(MouseY) + ' xMouse ' + inttostr(x13) + ' yMouse ' + inttostr(y12);
SetWindowTitle(vers);
PanelX := Window.Width - panelwidth;setbrushcolor(clsilver);setpencolor(clblack);
FillRectangle(PanelX, 0, Window.Width, Window.height);DrawRectangle(PanelX, 0, Window.Width, Window.height);
setbrushcolor(argb(0, 0, 0, 0));
TextOut(PanelX + 5, 2, 'Текущий FPS:');TextOut(PanelX + 95, 2, floattostr(round(fps)));
TextOut(PanelX + 5, 22, 'Угол поворота камеры:'); TextOut(PanelX + 160, 22, inttostr(angularX));
TextOut(panelX + 5, 39, 'Повернуть модель на 1 градус');
TextOut(panelX + 5, 80, 'Переменная приломнения #1');TextOut(panelX + 90, 100, inttostr(round(alpha1)));
TextOut(panelX + 5, 120, 'Переменная приломнения #2');TextOut(panelX + 80, 137, floattostr((alpha2)));
TextOut(panelX + 5, 160, 'Переменная приломнения #3');TextOut(panelX + 80, 177, floattostr((alpha3)));
TextOut(panelx + 5, 195, 'Рендеринг'); Textout(panelx + 5, 212, 'Каркас'); TextOut(panelx + 5, 230, 'Боковое меню');
Textout(panelx + 5, 248, 'Ограничить FPS до 30');Textout(panelx + 5, 264, 'Ранжирование');Textout(panelx + 5, 281, 'Вырисовка');
setbrushcolor(clblack);FillRectangle(PanelX + 5, 60, PanelX + 20, 75);
FillRectangle(Window.Width - 5, 60, Window.Width - 20, 75);
FillRectangle(PanelX + 5, 100, PanelX + 20, 115);FillRectangle(Window.Width - 5, 100, Window.Width - 20, 115);
FillRectangle(PanelX + 5, 137, PanelX + 20, 152);FillRectangle(Window.Width - 5, 137, Window.Width - 20, 152);
FillRectangle(PanelX + 5, 177, PanelX + 20, 192);FillRectangle(Window.Width - 5, 177, Window.Width - 20, 192);
FillRectangle(Window.Width - 37, 195, Window.Width - 22, 210);
FillRectangle(Window.Width - 37, 212, Window.Width - 22, 227);
FillRectangle(Window.Width - 37, 229, Window.Width - 22, 245);
FillRectangle(Window.Width - 37, 247, Window.Width - 22, 262);
FillRectangle(Window.Width - 37, 264, Window.Width - 22, 279);
FillRectangle(Window.Width - 37, 281, Window.Width - 22, 296);
//Блок основных проверок hажатий кнопок
{$omp parallel for }
for var i := 1 to 14 do
begin
//
if (PanelX + (i + 5)) = MouseX then begin
{$omp parallel for }
for var l := 1 to 14 do
begin
if (60 + l) = MouseY then begin
for var j := 1 to n do
begin
angular[j] := angular[j] + 3;MouseX := 0; MouseY := 0;
end;
end;
if (100 + l) = MouseY then begin
alpha1 := alpha1 - 1;MouseX := 0; MouseY := 0;
end;
if (137 + l) = MouseY then begin
alpha2 := alpha2 - 0.1;MouseX := 0; MouseY := 0;
end;
if (177 + l) = MouseY then begin
alpha3 := alpha3 - 0.009;MouseX := 0; MouseY := 0;
end;
end;
end;
//
if (Window.Width - 20) + i = MouseX then begin
{$omp parallel for }
for var l := 1 to 14 do
begin
if (60 + l) = MouseY then begin
for var j := 1 to n do
begin
angular[j] := angular[j] - 3;MouseX := 0; MouseY := 0;
end;
end;
if (100 + l) = MouseY then begin
alpha1 := alpha1 + 1;MouseX := 0; MouseY := 0;
end;
if (137 + l) = MouseY then begin
alpha2 := alpha2 + 0.1;MouseX := 0; MouseY := 0;
end;
if (177 + l) = MouseY then begin
alpha3 := alpha3 + 0.009;MouseX := 0; MouseY := 0;
end;
end;
end;
//
if (Window.Width - 37) + i = MouseX then begin
{$omp parallel for }
for var l := 1 to 14 do
begin
if (195 + l) = MouseY then begin
if drawbody = true then drawbody := false
else drawbody := true;
MouseX := 0; MouseY := 0;
end;
if (212 + l) = MouseY then begin
if drawskeleton = true then drawskeleton := false
else drawskeleton := true;
MouseX := 0; MouseY := 0;
end;
if (229 + l) = MouseY then begin
if drawpanel = true then drawpanel := false;
panelwidth := 0;
MouseX := 0; MouseY := 0;
end;
if (247 + l) = MouseY then begin
if rectfps = false then rectfps := true
else rectfps := false;
MouseX := 0;MouseY := 0;
end;
if (264 + l) = MouseY then begin
if rang = false then rang := true
else rang := false;
MouseX := 0; MouseY := 0;
end;
if (281 + l) = MouseY then begin
if sw = false then sw := true
else sw := false;
MouseX := 0; MouseY := 0;
end;
end;
end;
//
end;
end;
begin
InitMap;
for var j := 1 to 99999 do
begin
LockDrawing;
window.Clear;
MainMath;
if rang = true then Rangularing;
x12 := x13;
y12 := y13;
OnMouseMove := MouseMove;
if sw = true then DrawRangularing;
OnMouseDown := MyMouseDown;
if drawpanel = false then begin
window.Title := floattostr(round(fps));
setbrushcolor(clsilver);setpencolor(clblack);
textout(1, 1, 'Вернуть боковое меню');
FillRectangle(150, 2, 165, 17);
for var i := 1 to 14 do
begin
if (150 + i) = MouseX then begin
for var l := 1 to 14 do
begin
if (2 + l) = MouseY then begin
drawpanel := true;MouseX:=0;MouseY:=0;Panelwidth:=200;
end;
end;
end;
end;
end;
if drawpanel = true then BackPanel;
k1 += 1;
fps := k1 / Milliseconds * 1000;
if rectfps = true then cutfps;
Redraw;
end;
end.