диссертация модальная логика

-361 - Приложение 1

Rotate2D(x,y,OZAng,true); // поворачиваем относительно оси OZ Rotate2D(y,z,OXAng,true); // поворачиваем относительно оси ОХ Rotate2D(x,z,OYAng,true); // поворачиваем относительно оси 0 Y end; {with}

//// / поворот СК квадратика до совмещения с СК текущего паттерна

Rotate2D(x,y,OZAng,false); // поворачиваем относительно оси OZ end; {with}

end; {with}

//// получаем изображение квадратика-прототипа в массиве fork:=lto4do An-ayGrafPr[k]:=DisplayPoint3D(AKvadrPrtp[k]);

end; (if NumbPrtpo-1}

// выводим полученный массив на экран

///выводим квадратик-прототип if NamePrtpo" then begin Canvas.Brush.Color:=clWhite; Canvas.Polygon(Array GrafPr); end; {ifNumbPrtpO-1}

///выводим родной квадратик ArrayPlane^[(j-1 )*(NOfX;- l)+i]'^.Clr:=

CalculClrKvadr(0-l)*(NOOC-l)+i,-l); Canvas.Brush.Color:=ArrayPlane^[(j-1 )*(NOfX-1 )+i]^.Clr; Canvas.Polygon(ArrayGraf);

{$R+}

end; {procedure ShowKvadr}

procedure ShowSK;

// выводит на экран систему координат, var

PrlPip: array [1..6] of TPlane; //массив граней параллепипеда

BegX,BegY,BegZ: Point3D; // точки начал координатных осей OldCh: TColor;

OldMode: TPenMode;

-362 -

Приложение1

function InversVec(Vec: TVector): TVector;

// выдает вектор, противоположный исходному begin {function}

with Vec do begin A:=-A;

B:=-B; c:=-C; end; {with}

InversVec:=Vec; end; {function}

fimction MuIVToK(Vec:TVector; Koofreal): TVector; // Умножает вектор на число,

begin {fiinction} MulVToK.A:=Vec.A*Koof; MulVToK.B:=Vec.B*Koof; MulVToK.C:=Vec.C*Koof; end; {fimction}

fiinction GetEndVec(BasePnt: PointSD; Vec: TVector): Point3D; // Возвращает конец вектора, придлженного к точке,

begin {function} GetEndVec.X:=BasePnt.X+Vec.A; GetEndVec.Y:=BasePnt.Y+Vec.B; GetEndVec.Z:=BasePnt.Z+Vec.C; end; {function}

function GetValueD(Normal: TVector; qwePnt: Point3D): real; // возвращает значение коэф. D для уравнения плоскости begin {function}

with Normal,qwePnt do GetVa]ueD:=-(A*X)-(B*Y)-(C*Z); end; {function}

function BePntOfPlane(TestPnt: Point3D; TestPlane: TPlane): boolean; // проверка принадлежности точки плоскости

const

precis=lE3; // определяет до какого знака после запятой учитывать begin {fiinction}

with TestPnt,TestPlane,TestPlane.Norm do

if ((int((A*X+B*Y+C*Z+D)*precis))/precis)=0 then BePntOfPlane:=true

-364-

Приложение 1

OutPnt: TPoint; begin {procedure} with Canvas do begin

OutPnt:=DisplayPoint3D(InfoPnt);

//центрируем надпись по точке привязки OutPnt.x;=OutPnt.x-round(TextWidth(Inform)/2); OutPnt.y:=OutPnt.y-round(TextHeight(Inform)/2);

//смещаем надпись вдоль вектора направления OutPnt.x:=OutPnt.x+round(TextWidth('l 1 r)*Direct.A); OutPnt.y:=OutPnt.y-round(TextWidth('l 1 r)*Direct.B);

//выводим надпись на экран

Brush. Color;=clWhite;

Font.Color:=cIMaroon;

TextOut(OutPnt.x,OutPnt.y,Inform); end; {with}

end; {procedure}

procedure ShowAxis(BegPnt:Point3D; AxisOrt:TVector; AxisLength:real; ArrNumb: byte);

// процедура вырисовки координатной оси var

EndPnt: Point3D; i: integer; qwe2D: TPoint; begin {procedure}

with Canvas do begm

//определяем конечную точку координатной оси EndPnt:=GetEndVec(BegPnt,MulVToK(AxisOrt,AxisLength));

//рисуем координатную ось PenPos:=DisplayPoint3D(BegPnt); qwe2D:=DisplayPoint3D(EndPnt); LineTo(qwe2D.x,qwe2D.y);

//рисуем стрелку у координатной оси

for i:=ArrNumb to ArrNumb+3 do begin PenPos:=DisplayPoint3D(EndPnt); qwe2D:=DisplayPoint3D(SKoord.ArrPnts[i]); LineTo(qwe2D.x,qwe2d.y);

end; {for} end; {with}

end; {procedure}

-365 -

Приложение1

procedure SetVisAxis; begin {procedure}

Canvas.Pen.Color:=clmaroon;

Canvas.Pen.Width:=2;

Canvas.Pen.Mode:=pmCopy; end; {procedure}

procedure SetHideAxis; begin {procedure} Canvas.Pen.Color:=clteal; Canvas.Pen.Width:=2;

Canvas.Pen.Mode:=pmMaskNotPen; end; {procedure}

begin {procedure SliowSK}

// определяем точки начал координатных oceii with SKoord do begin

PntBaseSK:=GetEndVec(Base3D,MulVToK(AxisX,BaseSK.A));

PntBaseSK:=GetEndVec(PntBaseSK,MulVToK(AxisY,BaseSK.B));

PntBaseSK:=GetEndVec(PntBaseSk,MulVToK(AxisZ,BaseSK.C));

if BaseSK.A=0 then BegX:=PntBaseSk else BegX:=Base3D;

if BaseSK.B=0 then BegY:=PntBaseSk else BegY:=Base3D;

if BaseSK.C=0 then BegZ:=PntBaseSk else BegZ:=Base3D;

end; {with}

//определяем точки по углам параллепипеда with SKoord,Gabarit do begin

PntO:=Base3D; PntNeO:=GetEndVec(PntO,MulVTOK(AxisX,MaxX-MinX)); PntNeO:=GetEndVec(PntNeO,MulVTOK(AxisY,MaxY-MinY)); PntNeO:=GetEndVec(PntNeO,MulVTOK(AxisZ,MaxZ-MinZ)); end; {with}

//определяем грани параллепипеда

PrlPip[ 1 ] .D:=GetValueD(PrlPip[ 1 ].Norm,PntO);

PrlPip[5].Norm:=InversVec(AxisY); // плоскость X'O'Z' PrlPip[5].D:=GetValueD(PrlPip[5].Norm,PntNeO); PrlPip[6].Norm:=InversVec(AxisX); // плоскость Y'O'Z' PrlPip[6].D:=GetValueD(PrlPip[6].Norm,PntNeO);

end; {with}

with Canvas do begin

//сохраняем параметры пера 01dCh:=Pen.Color; 01dMode:=Pen.Mode;

//выводим координатные оси на экран with Gabarit,SKoord do begin

//рисуем наименования осей

TextOutCenter(GetEndVec(BegX,MulVTOK(AxisX,MaxX-MinX)),AxisX,'Fi,°'); TextOutCenter(GetEndVec(BegY,MulVTOK(AxisY,MaxY-MinY)),AxisY,

NameOfForce+V+EdinOfForce);

TextOutCenter(GetEndVec(BegZ,MulVTOK(AxisZ,MaxZ-MinZ)),AxisZ,'N,o6/M'); // рисуем ось X

if GetVisOfAxis(AxisX,BegX) then SetVisAxis else SetHideAxis;

ShowAxis(BegX,AxisX,MaxX-MinX,l); // рисуем ось Y

if GetVisOfAxis(AxisY,BegY) then SetVisAxis else SetHideAxis;

ShowAxis(BegY,AxisY,MaxY-MinY,5); // рисуем ось Z

if GetVisOfAxis(AxisZ,BegZ) then SetVisAxis else SetHideAxis;

ShowAxis(BegZ,AxisZ,MaxZ-MinZ,9); end; {with}

// восстанавливаем параметры пера Pen.Color:=01dCh; Pen.Mode:=OidMode; Pen.Width:=l;

end; {with}

-367-

Приложение 1

end; {procedure ShowSK}

begin {FormPaint} {$R-}

//инициализируем переменные

///инициализируем параметры прототипа if NamePrtpo" then begin

with (MamForm.MDiChildren[GetNumbPrtp(NamePrtp)] as TForce) do begin ABasePrtp:=ArrayBase;

APIanePrtp ;=ArrayPlane;

MasXPrtp:=SKoord.MasX;

MasYPrtp:=SKoord.MasY;

MasZPrtp:=SKoord.MasZ;

with SKoord do Ang3DBN:=GetAngel3D(AxisX,AxisY,AxisZ); end; {with}

with SKoord do Ang3DBS:=GetAngel3D(AxisX,AxisY,AxisZ); end; {if}

// рисуем квадратики

if ((ArrayBase'^I l]^.Z+ArrayBase^[(NOfZ-1 )*NODC+1 ]'^.Z)/2)< ((ArrayBase'^[N0fX]^.Z+An-ayBase'^[N0fZ*NOfX]'^.Z)/2)

then

for i:=l to (NOfX-1) do

forj:=l to(NOfZ-l)do ShowKvadrCCJ-1 )*(NOfX-1 )+i)

else

for i:=(NOfX-l) downto 1 do for j:=(NOfZ-l) downto 1 do ShowKvadr(G-1 )*(NOfX-1 )+i);

// рисуем систему координат with Gabarit do ShowSK;

{$R+}

end; {FormPaint}

function TForce.CalculClrKvadr(NumbKvadr,NumbFrm: integer): TColor; var

Normal: TVector;

CosFi: real;

modN,modL: real;

X21,x31,y21,y31,z21,z31:real;

- 368 - Приложение 1

begin {function CaiculClrKvadr} {$R-} CalcuIClrKvadr:=clBtnFace;

// простая расцветка

if ColorStyle=0 then begin CalcuiClrKvadr—clBtnFace;

end; {if RadioColor.ItemIndex=0} // тоновая расцветка

if CoiorStyIe=l then begin

// вычисляем координаты вектора нормали к квадратику with An-ayPlane'^[NumbKvadr]^ do begin x21:=ArrayBase'^[Pts[2]]'^.X-ArrayBase'^[Pts[l]]'^.X;

x31 :=ArrayBase^[Pts[3]]^.X-ArrayBase^[Pts[l]]'^.X; y21:=ArrayBase'^[Pts[2]]'^.Y-ArrayBase''[Pts[l]]^.Y; y31:=ArrayBase'^[Pts[3]]'^.Y-ArrayBase^[Pts[I]]'^.Y; z21 :=ArrayBase^[Pts[2]]'^.Z-ArrayBase'^[Pts[ 1 ]]'^.Z; z31:=ArrayBase'^[Pts[3]]'^.Z-ArrayBase^[Pts[l]]'^.Z; end; {with}

Normal.A:=y21 *z31-уЗ 1 *z21;

Normal.B:=z21 *x31 -z31 *x21;

Normal.C:=x21 *уЗ 1 -x31 *у21;

// вычисляем косинус угла между нормалью и лучом падения света modN:=sqrt(Normal.A*Normal.A+Normal.B*Normal.B+Normal.C*Normal.C); modL:=sqrt(Light.A*Light.A+Light.B*Light.B+Light.C*Light.C); CosFi:=abs((Normal.A*Light.A+Normal.B*Light.B+Normal.C*Light.C)/

(modN*modL)); // определяем градацию цвета квдратика

CalculClrKvadr:=$00000000+(round(CosFi*$80)+$80)*256*256; end; {ifRadioColor.ItemIndex=l}

{$R+}

end; {function CalculColorKvadr}

procedure TForce.FreeMemory; var

i: integer;

begm {procedure} {$R-}

// освобождаем память из под массива трехмерных точек for i:=l to NOfPoints do dispose(ArrayBase'^[i]);

- 369 -

Приложение1

freemem(ArrayBase);

ArrayBase:=nil;

//освобождаем память из под массива двухмерных точек for i:=l to NOfPoints do disposeCArrayScreen-^p]); fi-eemem(ArrayScreen);

ArrayScreen:=nil;

//освобождаем память из под массива квадратиков

for i:=l to NOfPIanes do dispose(ArrayPlane'^[i]); freemem(ArrayPlane);

AnayPlane:=nil; {$R+}

end; {procedure}

procedure TForce.CreateArrayScreen; var

i: integer; begin {function}

//создаем массив указателей на точки getmem(ArrayScreen,NOfPoints*sizeof(PPoint2D));

//создаем точки

{$R-} for i:=l to NOfPoints do new(ArrayScreen''[i]); {$R+} end;

end.

unit DIznos;

interface

uses .

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ComCtrls;

type

TVec2D=record A,B: real;

end;

-370 -

Приложение 1

PPoint2D='^TPoint2D;

TPoint2D=record X,Y: real;

end;

TE10fRes=record Koord: TPoint2D; PosS: byte; LenS: byte;

end;

TE10fTzn=record Summa: real; Koof: real; Direct: TVec2D; end;

PArrayPolar='^TArrayPolar;

TArrayPolar=array [ 1.. 1 ] of PPoint2D;

PDIznos='^TDIznos;

TDIznos=array [1..12] of TElOflzn;

PArrayIznos=^TArrayIznos;

TArrayIznos=array [1..1] of PDIznos;

PArraySheyka='^TArraySheyka;

TArraySheyka=array [ 1.. 1 ] of TPoint2D;

OtnosX,OtnosY: integer; // приращение в относительном пространстве