Программное обеспечение для построения полей изолиний, страница 3

begin

 R:=SQR(xr-XYZ[i,1])+SQR(yr-XYZ[i,2]);

 If R<Rmin then

         Begin i3:=i; Rmin:=R; end;

 end;

z1:=(XYZ[i3,3]-XYZ[i1,3])*((Yr-XYZ[i1,2])*

       (XYZ[i2,1]-XYZ[i1,1])-(Xr-XYZ[i1,1])*(XYZ[i2,2]-XYZ[i1,2]));

z2:=(XYZ[i2,3]-XYZ[i1,3])*((XYZ[i3,2]-XYZ[i1,2])*(Xr-XYZ[i1,1])

      -(Yr-XYZ[i1,2])*(XYZ[i3,1]-XYZ[i1,1]));

z3:=(XYZ[i2,1]-XYZ[i1,1])*(XYZ[i3,2]-XYZ[i1,2])-

       (XYZ[i3,1]-XYZ[i1,1])*(XYZ[i2,2]-XYZ[i1,2]);

zr:=XYZ[i1,3]+(z1+z2)/z3;

DQursor(Xp,Yp,Zr);

end;

Процедура вычисления  коэффициентов пересчёта физических координат точек в пиксельные.

XYZ массив в котором хранятся координаты опорных точек, для построения сетки.,

Lx,Ly- длина и ширина окна в котором будет выведено поле изолиний, Nt количество опорных точек(узлов) для построение сетки изолиний. Данные параметры являются входящимся для процедуры. Исходящие переменные имеют следующий смысл: kx,ky  коэффициенты пересчёта, xmin минимальное значение х из всех опорных точек, ymax максимальное значение y из всех опорных точек.

Procedure Koefic(XYZ:Q;lx,ly:real;Nt:integer; Var kx,ky,ymax,xmin:real);

 Var xmax,ymin:real; i,j:integer;

 Begin

 xmin:=XYZ[1,1]; xmax:=xmin;

 ymin:=XYZ[1,2]; ymax:=ymin;

 for i:=1 to Nt do begin

 if xmin>XYZ[i,1] then xmin:=XYZ[i,1];

 if xmax<XYZ[i,1] then xmax:=XYZ[i,1];

 if ymin>XYZ[i,2] then ymin:=XYZ[i,2];

 if ymax<XYZ[i,2] then ymax:=XYZ[i,2];

 end;

 kx:=lx/(xmax-xmin);

 ky:=ly/(ymax-ymin);

end;

Процедура построения изолинии и её подписи:

Переменные Xp и Yp типа integer – содержат координаты текущего положения курсора. z0- текущий уровень изолинии. RXY-массив для хранения координат выведенных подписей, kx, ky  коэффициенты пересчёта, xmin минимальное значение х из всех опорных точек, ymax максимальное значение y из всех опорных точек. Исходящих параметров процедура не имеет.

Procedure Podpis(xp,yp:integer;z0:real;RXY:R;x0,y0:integer;kx,ky,xmin,ymax:real);

Var R,Rmin:real; i,j:integer; s:string;

Const NXY:integer=0;

Begin

Rmin:=1000; SetColor(7);

for i:=1 to NXY do

 begin

 R:=sqrt(sqr(xp-RXY[i,1])+sqr(yp-RXY[i,2]));

 if R<Rmin then Rmin:=R;

 end;

If Rmin>5 then

          Begin

          NXY:=NXY+1; RXY[NXY,1]:=xp; RXY[NXY,2]:=yp;

          Str(z0:4:2,S);

          OutTextXY(X0+Round((Xp-xmin)*kx),Y0+Round((ymax-Yp)*ky),S);

          end;

end;

Процедура построение опорной сетки, покрывающей область определения фрагмента поверхности:

XYZ массив в котором хранятся координаты опорных точек, для построения сетки,

NNN- массив для хранения точек, которые образуют треугольники для вывода сетки, Ntr- количество опорных треугольников, Nt количество опорных точек(узлов) для построение сетки изолиний, x0,y0 - координаты верхнего левого угла окна, в котором строим поле изолиний, col – цвет сетки, kx, ky  коэффициенты пересчёта, xmin минимальное значение х из всех опорных точек, ymax максимальное значение y из всех опорных точек.

Procedure Setka(XYZ:Q;NNN:S;Ntr,Nt,x0,y0,col:integer; xmin,ymax,kx,ky:real);

 Var i,j:integer; s:string;

 Begin

 SetColor(col);

 for i:=1 to Ntr do

 Begin

 Line(x0+Round((XYZ[NNN[i,1],1]-xmin)*kx),Round((ymax-XYZ[NNN[i,1],2])*ky)+y0,

 x0+Round((XYZ[NNN[i,2],1]-xmin)*kx),Round((ymax-XYZ[NNN[i,2],2])*ky)+y0);

  Line(x0+Round((XYZ[NNN[i,1],1]-xmin)*kx),Round((ymax-XYZ[NNN[i,1],2])*ky)+y0,

 x0+Round((XYZ[NNN[i,3],1]-xmin)*kx),Round((ymax-XYZ[NNN[i,3],2])*ky)+y0);

  Line(x0+Round((XYZ[NNN[i,3],1]-xmin)*kx),Round((ymax-XYZ[NNN[i,3],2])*ky)+y0,

 x0+Round((XYZ[NNN[i,2],1]-xmin)*kx),Round((ymax-XYZ[NNN[i,2],2])*ky)+y0);

 end; SetColor(Green);

 For i:=1 to Nt do Begin Str(XYZ[i,3]:4:2,S); OutTextXY(Round((XYZ[i,1]-xmin)*kx)+X0-14,Y0+7+Round((ymax-XYZ[i,2])*ky),s);

 circle(X0+Round((XYZ[i,1]-xmin)*kx),Y0+Round((ymax-XYZ[i,2])*ky),3); end;

end;

Процедура рисовки курсора (стрелочки):

Переменные Xp и Yp типа integer – содержат координаты текущего положения курсора.

Procedure PicCur (xp,yp:Integer);

Begin