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

4.                                                    Блок-схема программы

Чтение координат с текстового файла(por.txt)

 

Вычисление коэффициентов пересчёта

 

Построение сетки

 
 


Выход из программы

 
 


5. Описание программы:

Programporkur;

Подключаем стандартные модули Graph для работы с графическим режимом и Crt для работы с текстовым режимом и обработки кодов кнопок клавиатуры

uses Graph,Crt;

Тип переменных для размещения координат точек поверхности T[1]-x ,T[2]-y, T[3]-z

Type TT=array[1..3] of real;

Тип переменных для размещения информации о поверхности

Type Q=array[1..200] of TT;

Тип переменных для размещения информации о координатах подписей изолинии

Type R=array[1..100,1..2] of real;

Тип переменных для размещения информации о номерах точек, объединяемых в треугольники

Type S=array[1..200,1..3] of integer;

Процедура ввода данных:

Процедура имеет только выходные параметры Nt-количество опорных точек, Ntr-количество опорных треугольников для построения сетки, x0,y0- координаты верхнего левого угла окна в котором будет выведено поле изолиний, lx,ly- длинна и ширина ,niz- количество изолиний, которые нужно построить. В качестве входных параметров служат переменные Xp,Yp типа integer – текущие координаты нахождения курсора и построения репера и Z типа real – уровень изолинии. Выходных параметров у данной процедуры нету.

Procedure Data(Var Nt,Ntr,x0,y0,lx,ly,niz:integer; Var XYZ:Q;Var NNN:S; Var z0:TT);

           Var  FL:text; i:integer;

Begin

    niz:=3;

    z0[1]:=-5; z0[2]:=12; z0[3]:=-8;

    x0:=50; y0:=20; lx:=549; ly:=438;

  Assign(FL,'por.txt'); Reset(FL); Readln(Fl,Nt);

 for i:=1 to Nt do Readln(FL,XYZ[i,1],XYZ[i,2],XYZ[i,3]);

   Readln(Fl,Ntr);

 for i:=1 to Ntr do Readln(FL,NNN[i,1],NNN[i,2],NNN[i,3]);Close(FL);

  for i:=1 to Nt do                                                      XYZ[i,3]:=XYZ[i,1]+XYZ[i,2]+sqrt(sqrt((XYZ[i,1]+XYZ[i,1])*(XYZ[i,1]+

XYZ[i,1])));

END;

Процедура построения репера (вертикальной отметки) на экране:

Procedure DQursor(Xp,Yp:integer;Zr:real);

Var s:string; i,Res:integer;

Rip:array[1..100,1..2] of integer;

Const Nrip: integer=0;

Begin

Res:=0;

  For i:=1 to Nrip do

    If (Rip[i,1]=xp) and (Rip[i,2]=yp) then res:=1;

If res=0 then begin Nrip:=Nrip+1; Rip[Nrip,1]:=xp; Rip[Nrip,2]:=yp;

   SetColor(white) end

   else

Begin Rip[Nrip,1]:=-1; Rip[Nrip,2]:=-1;SetColor(Black);  end;

 Str(Zr:4:2,s);

 Line(Xp,YP,Xp+3,Yp+10);

 Line(Xp,YP,Xp+9,Yp+5);

 Line(Xp+9,YP+5,Xp+3,Yp+10);

 OutTextXY(Xp+4,Yp-2,S);

end;

Процедура вычисления уровня изолинии, проходящей через данную точку.

В качестве входных параметров служат переменные x0,y0 типа integer- координаты верхнего левого угла окна, в котором строим нашу сетку. xmin,ymax типа real – минимальная  координата по оси Х и максимальная координата по оси Y, kx, ky типа real- коэффициенты пересчёта из физических координат в пиксельные. Выходных параметров процедура не имеет. Переменные Xp и Yp типа integer – содержат координаты текущего положения курсора. XYZ массив в котором хранятся координаты опорных точек, для построения сетки.

ProcedureQursor(xp,yp,x0,y0,Nt:integer;xmin,ymax,kx,ky:real;XYZ:Q);

Var i,i1,i2,i3:integer; zr,z1,z2,z3,xr,yr,r,rmin:real;

Begin

Xr:=(Xp-X0)/kx+xmin;

Yr:=ymax-(Yp-Y0)/ky;

Rmin:=1e20;

For i:=1 to Nt do

begin

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

 If R<Rmin then

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

 end;

Rmin:=1e20;

For i:=1 to Nt do

if i<>i1 then

begin

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

 If R<Rmin then

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

 end;

Rmin:=1e20;

For i:=1 to Nt do

if (i<>i1) and (i<>i2) then