Лаборатоные 2 семестр (паскаль) / 3d модуль PABC.NET / LGraph3dABC

//////////////////////////////////////////////////////////////////
/// Модуль LGraph2dABC ///
/// только для свободного распространения ///
/// используя данный модуль вы соглашаетесь с ///
/// GNU LESSER GENERAL PUBLIC LICENSE ///
/// оригинал:http://www.gnu.org/copyleft/lesser.html ///
/// русский перевод: ///
//http://ru.wikisource.org/wiki/GNU_Lesser_General_Public_License/
/// Краткая инструкция: ///
/// необходимо подключить модуль LGraph3dABC, для этого перед ///
/// началом программы необходимо дописать uses LGraph2dABC; ///
/// в модуле есть 3 процедуры первой вызывается drawXYZ ///
///drawXYZ(startX,endX,startY,endY,startZ,endZ:real;Height,Width,indent:integer; var flag:string);
///startX и endX начало и конец оси x соответственно
///startY и endY начало и конец оси y
///startZ и endZ начало и конец оси Z
///Height и Width высота и ширина поля для графика
///indent отступы краев окна от графика
/// flag служебный строковый параметр необходимый для построения графиков
///!!!!!!!!!!!!!!!!!!!!!! НЕОБХОДИМО ПОЛУЧИТЬ ФЛАГ с процедуры
///
///drawPoint рисует на поле точку с кординатами (x,y,z) и цветом clr необходимо передать флаг
///drawPoint(flag:string; x,y,z:real);
///
///procedure drawPointColor(flag:string; x,y,z:real;clr:color);
///drawPoint рисует на поле точку с кординатами (x,y,z) и цветом clr необходимо передать флаг
///
///drawPolygone(flag:string;x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4:real)
///рисует 4х угольный полигон с вершинами в узлах (x1,y1,z1) (x2,y2,z2) (x3,y3,z3) (x4,y4,z4)
///flag служебный строковый параметр необходимый для построения графиков
///
///
///drawPolygoneColorLine(flag:string;x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4:real; clr:color);
///рисует 4х угольный полигон с вершинами в узлах (x1,y1,z1) (x2,y2,z2) (x3,y3,z3) (x4,y4,z4)
///цветом clr
///flag служебный строковый параметр необходимый для построения графиков
///
///drawLine рисует на поле линию с началом в точке (x1,y1) и концом в точке (x2,y2) и цветом clr необходимо передать флаг
///drawLine(flag:string; x1,y1,x2,y2:real;clr:color);
///------------------------------------------------------------///
///------------------25.10.2011 Жданов С.В---------------------///
///------------------------------------------------------------///
//////////////////////////////////////////////////////////////////

unit LGraph3dABC;

interface
uses graphABC;
const indent=40;
ColorGradiend:array[1..13] of Color=(clBlue,clDarkBlue,clPink,clYellow,clGreen,clDarkGreen,clOrange,clDarkOrange,clRed,clDarkRed,clViolet,clBlueViolet,clMediumVioletRed);
angleX=3.14/6;
angleY=3.14/6;
type mas=array [1..3000] of real; //описание массива
procedure drawXYZ(startX,endX,startY,endY,startZ,endZ:real;Height,Width,indent:integer; var flag:string);
procedure drawPoint(flag:string; x,y,z:real);
procedure drawPointColor(flag:string; x,y,z:real; clr:color);
procedure drawPolygone(flag:string;x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4:real);
procedure drawPolygoneColorLine(flag:string;x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4:real; clr:color);
implementation
procedure drawPoint(flag:string; x,y,z:real);
var startX,startY,startZ,stepX,stepY,stepZ:real;
Height,Width,indent,centerX,centerY,i:integer;
clr:color;
begin
try
startX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
Height:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Width:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
indent:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
except
on System.Exception do
begin
writeln('ОШИБКА:Неверный формат ввода служебной переменной при создании точки');
writeln('по нажатию Enter программа будет завершена');
readln();
Halt();
end;
end;
centerX:=trunc(Width/2)+indent;
centerX:=trunc(centerX+ stepX*(0-startX)*cos(angleX)-stepY*(0-startY)*cos(angleY));
centerY:=trunc(Height/2)+indent;
centerY:=trunc(centerY+stepX*(0-startX)*sin(angleX)+stepY*(0-startY)*sin(angleY)-stepZ*(0-startZ) );
for i:=0 to 12 do
begin
if ((Height/20)*(i+1)>=z*stepZ) AND ((Height/20)*i<=z*stepZ) Then begin clr:=ColorGradiend[i+1]; break;end;
end;
putPixel(Trunc(centerX+ stepX*x*cos(angleX)-stepY*y*cos(angleY)),trunc(centerY+stepX*x*sin(angleX)+stepY*y*sin(angleY)-stepZ*z ) ,clr);
end;

procedure drawPointColor(flag:string; x,y,z:real;clr:color);
var startX,startY,startZ,stepX,stepY,stepZ:real;
Height,Width,indent,centerX,centerY:integer;
begin
try
startX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
Height:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Width:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
indent:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
except
on System.Exception do
begin
writeln('ОШИБКА:Неверный формат ввода служебной переменной при создании точки');
writeln('по нажатию Enter программа будет завершена');
readln();
Halt();
end;
end;
centerX:=trunc(Width/2)+indent;
centerX:=trunc(centerX+ stepX*(0-startX)*cos(angleX)-stepY*(0-startY)*cos(angleY));
centerY:=trunc(Height/2)+indent;
centerY:=trunc(centerY+stepX*(0-startX)*sin(angleX)+stepY*(0-startY)*sin(angleY)-stepZ*(0-startZ) );
putPixel(Trunc(centerX+ stepX*x*cos(angleX)-stepY*y*cos(angleY)),trunc(centerY+stepX*x*sin(angleX)+stepY*y*sin(angleY)-stepZ*z ) ,clr);
end;

procedure drawPolygone(flag:string;x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4:real);
var a:array [1..4] of Point;
startX,startY,startZ,stepX,stepY,stepZ:real;
Width,Height,CenterX,CenterY,indent,i:integer;
clr:color;
begin
try
startX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
Height:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Width:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
indent:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
except
on System.Exception do
begin
writeln('ОШИБКА:Неверный формат ввода служебной переменной при создании точки');
writeln('по нажатию Enter программа будет завершена');
readln();
Halt();
end;
end;
centerX:=trunc(Width/2)+indent;
centerX:=trunc(centerX+ stepX*(0-startX)*cos(angleX)-stepY*(0-startY)*cos(angleY));
centerY:=trunc(Height/2)+indent;
centerY:=trunc(centerY+stepX*(0-startX)*sin(angleX)+stepY*(0-startY)*sin(angleY)-stepZ*(0-startZ) );
a[1].X:=Trunc(centerX+ stepX*x1*cos(angleX)-stepY*y1*cos(angleY));
a[1].Y:=trunc(centerY+stepX*x1*sin(angleX)+stepY*y1*sin(angleY)-stepZ*z1 );
a[2].X:=Trunc(centerX+ stepX*x2*cos(angleX)-stepY*y2*cos(angleY));
a[2].Y:=trunc(centerY+stepX*x2*sin(angleX)+stepY*y2*sin(angleY)-stepZ*z2 );
a[3].X:=Trunc(centerX+ stepX*x3*cos(angleX)-stepY*y3*cos(angleY));
a[3].Y:=trunc(centerY+stepX*x3*sin(angleX)+stepY*y3*sin(angleY)-stepZ*z3 );
a[4].X:=Trunc(centerX+ stepX*x4*cos(angleX)-stepY*y4*cos(angleY));
a[4].Y:=trunc(centerY+stepX*x4*sin(angleX)+stepY*y4*sin(angleY)-stepZ*z4 ) ;

for i:=0 to 12 do
begin
if ((Height/20)*(i+1)>=abs(z1*stepZ)) AND ((Height/20)*i<=abs(z1*stepZ)) Then begin clr:=ColorGradiend[i+1]; break;end;
end;
setPenStyle(psSolid);
setPenColor(clBlack);
Line(a[1].X,a[1].Y,a[2].X,a[2].Y,Clr);
Line(a[2].X,a[2].Y,a[4].X,a[4].Y,Clr);
Line(a[4].X,a[4].Y,a[3].X,a[3].Y,Clr);
Line(a[3].X,a[3].Y,a[1].X,a[1].Y,Clr);
//Если появится возможность передать нормально полигон
//Polygon(a);
//FloodFill(Trunc((a[1].X+a[4].X)/2),Trunc((a[1].Y+a[4].Y)/2),clr);

// FillPolygon(a);


end;

procedure drawPolygoneColorLine(flag:string;x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4:real;clr:color);
var a:array [1..4] of Point;
startX,startY,startZ,stepX,stepY,stepZ:real;
Width,Height,CenterX,CenterY,indent:integer;
begin
try
startX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
startZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Delete(flag,1,Pos('|',flag));
Height:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Width:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
indent:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
except
on System.Exception do
begin
writeln('ОШИБКА:Неверный формат ввода служебной переменной при создании точки');
writeln('по нажатию Enter программа будет завершена');
readln();
Halt();
end;
end;
centerX:=trunc(Width/2)+indent;
centerX:=trunc(centerX+ stepX*(0-startX)*cos(angleX)-stepY*(0-startY)*cos(angleY));
centerY:=trunc(Height/2)+indent;
centerY:=trunc(centerY+stepX*(0-startX)*sin(angleX)+stepY*(0-startY)*sin(angleY)-stepZ*(0-startZ) );
a[1].X:=Trunc(centerX+ stepX*x1*cos(angleX)-stepY*y1*cos(angleY));
a[1].Y:=trunc(centerY+stepX*x1*sin(angleX)+stepY*y1*sin(angleY)-stepZ*z1 );
a[2].X:=Trunc(centerX+ stepX*x2*cos(angleX)-stepY*y2*cos(angleY));
a[2].Y:=trunc(centerY+stepX*x2*sin(angleX)+stepY*y2*sin(angleY)-stepZ*z2 );
a[3].X:=Trunc(centerX+ stepX*x3*cos(angleX)-stepY*y3*cos(angleY));
a[3].Y:=trunc(centerY+stepX*x3*sin(angleX)+stepY*y3*sin(angleY)-stepZ*z3 );
a[4].X:=Trunc(centerX+ stepX*x4*cos(angleX)-stepY*y4*cos(angleY));
a[4].Y:=trunc(centerY+stepX*x4*sin(angleX)+stepY*y4*sin(angleY)-stepZ*z4 ) ;
setPenStyle(psSolid);
// setPenColor(clr);
Line(a[1].X,a[1].Y,a[2].X,a[2].Y,Clr);
Line(a[2].X,a[2].Y,a[4].X,a[4].Y,Clr);
Line(a[4].X,a[4].Y,a[3].X,a[3].Y,Clr);
Line(a[3].X,a[3].Y,a[1].X,a[1].Y,Clr);
//Если появится возможность передать нормально полигон


end;


procedure drawXYZ(startX,endX,startY,endY,startZ,endZ:real;Height,Width,indent:integer; var flag:string);
const indentHeight=5;
ValueRound=3;
var i,centerX,centerY,stepDiv,stepDivX,stepDivY:integer;
s:string;
stepX,stepY,stepZ:real;
begin
flag:='';
flag:=FloatToStr(startX)+'|'+FloatToStr(endX)+'|'+FloatToStr(startY)+'|'+FloatToStr(endY)+'|'+FloatToStr(startZ)+'|'+FloatToStr(endZ)+'|'+FloatToStr(Height)+'|'+FloatToStr(Width)+'|'+FloatToStr(indent)+'|';
if (Height<1) or (Width<1) Then begin
writeln('ОШИБКА:Параметры окна не могут быть меньше 1');
writeln('по нажатию Enter программа будет завершена');
readln();
Halt();
end;
if indent<0 Then begin
writeln('ОШИБКА:Отступ от края окна не может быть отрицательным');
writeln('по нажатию Enter программа будет завершена');
readln();
Halt();
end;
SetWindowWidth(Width+indent*2);
SetWindowHeight(Height+indent*5);
centerX:=trunc(Width/2)+indent ;
centerY:=trunc(Height/2)+indent;
Line(centerX,centerY,centerX,indent);//ось Z
Line(centerX,centerY,centerX+trunc(Width/2),centerY+trunc(Width/2*tan(angleX)));//ось X
Line(centerX,centerY,indent,centerY+trunc(Width/2*tan(angleY)));//ось Y
stepDiv:=trunc((height/2)/10);
setPenStyle(psDash);
setPenColor(clGray);
stepDivX:=trunc( ((sqrt((width/2)*(width/2)+(Height/2)*(Height/2)*tan(angleX)*tan(angleX) )/10)*cos(angleX)));
stepDivY:=trunc( ((sqrt((width/2)*(width/2)+(Height/2)*(Height/2)*tan(angleY)*tan(angleY))/10)*sin(angleY)));
stepZ:=(Height/2)/(endZ-StartZ); //(abs(startZ)+abs(endZ));
stepX:=sqrt((width/2)*(width/2)+(Height/2)*(Height/2)*tan(angleX)*tan(angleX))/(endX-StartX); //(abs(startX)+abs(endX));
stepY:=sqrt((width/2)*(width/2)+(Height/2)*(Height/2)*tan(angleY)*tan(angleY))/(endY-StartY); //(abs(startY)+abs(endY));
flag:=flag+FloatToStr(StepX)+'|'+FloatToStr(StepY)+'|'+FloatToStr(StepZ)+'|';
for i:=1 to 10 do
begin
line(centerX,centerY-i*stepDiv,centerX+trunc(Width/2),centerY-i*stepDiv+trunc(Width/2*tan(angleX))); //штриховка по z вправо
line(centerX,centerY-i*stepDiv,indent,centerY-i*stepDiv+trunc(Width/2*tan(angleY))); //штриховка по z влевj
s:=FloatToStr(Trunc( (StartZ+i*(Height/20)/stepZ)*power(10,ValueRound)) /power(10,ValueRound));
TextOut(indent-TextWidth(s),centerY-i*stepDiv+trunc(Width/2*tan(angleY))-Trunc(TextHeight(s)/2),s);
line(centerX+i*stepDivX,centerY+i*stepDivY,indent+stepDivX*i,centerY+trunc((Width/2+stepDivX*i)*tan(angleY))); //оси параллельные Y
s:=FloatToStr(Trunc( (StartX+i*(sqrt((width/2)*(width/2)+(Height/2)*(Height/2)*tan(angleX)*tan(angleX))/10)/stepX)*power(10,ValueRound)) /power(10,ValueRound));
TextOut(indent+stepDivX*i,centerY+trunc((Width/2+stepDivX*i)*tan(angleY)),s);
line(centerX-i*stepDivX,centerY+i*stepDivY,centerX+trunc(Width/2) -stepDivX*i ,centerY+trunc((Width/2+stepDivX*i)*tan(angleY)));
s:=FloatToStr(Trunc( (StartY+i*(sqrt((width/2)*(width/2)+(Height/2)*(Height/2)*tan(angleY)*tan(angleY))/10)/stepY)*power(10,ValueRound)) /power(10,ValueRound));
TextOut(centerX+trunc(Width/2) -stepDivX*i ,centerY+trunc((Width/2+stepDivX*i)*tan(angleY)),s);
line(centerX+i*stepDivX,centerY+i*stepDivY,centerX+stepDivX*i,indent+i*stepDivY); //оси параллельные Z
line(centerX-i*stepDivX,centerY+i*stepDivY,centerX-stepDivX*i,indent+i*stepDivY);
end;


end;
begin
end.

{
//What can we take from "flag:string;"
startX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
endX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
startY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
endY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
startZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
endZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Height:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
Width:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
indent:=StrToInt( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepX:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepY:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
stepZ:=StrToFloat( Copy(flag,1,Pos('|',flag)-1));
Delete(flag,1,Pos('|',flag));
}