Файловый архив студентов. Файловый архив студентов.
1328 вузов, 5500 предметов.
/ Регистрация
FAQ Обратная связь Вопросы и предложения
Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Национальный исследовательский ядерный университет (МИФИ)
Предмет:
Численные методы
Файл:

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

.pas
Скачиваний:
40
Добавлен:
10.05.2014
Размер:
18 Кб
Скачать
☆ 
//////////////////////////////////////////////////////////////////
///                   Модуль 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));
}
Соседние файлы в папке 3d модуль PABC.NET
Помощь Обратная связь Вопросы и предложения Пользовательское соглашение Политика конфиденциальности