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

SetColor(11);

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

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

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

end;

Процедура обработки движения курсора (нажатия клавиш):

Procedure cursor(XYZ:Q;NNN:S;Ntr,x0,y0,col,e,k,xp,yp,lx,ly,Nt:integer; xmin,ymax,kx,ky:real);

Type T=array[1..10000] of byte;

Var B:^T; i,xs,ys:integer;  s1,s2:string;

Kod:char; Label M1,M2;

Begin

M2:GetMem(B,264);

M1: xs:=xp; ys:=yp;

GetImage(xs,ys,xs+10,ys+10,B^);

PicCur(xp,yp);

 kod:=readkey;

   if kod=#0 then begin

          kod:=ReadKey;

          end;

Нажатие клавиши Enter- нарисовать репер

if kod=#13 then begin  PutImage(xs,ys,B^,0);

            If (x0<xp) and ((x0+lx)>xp) then

            If (y0<yp) and ((y0+ly)>yp) then

            Qursor(x0,y0,xmin,ymax,kx,ky,xp,yp); goto M1;

             end;

Нажатие клавиши вниз – переместить курсор на 5 пикселей вниз:

if kod=#72 then begin

              If (yp+5)>(y0-20) then begin

                                    PutImage(xs,ys,B^,0);

                                    yp:=yp-5;

                                    goto M1;

                                    end

                                    else

                                    Begin PutImage(xs,ys,B^,0); yp:=yp; goto M1; end;

             end;

Нажатие клавиши вверх – переместить курсор на 5 пикселей вверх:

If kod=#80 then begin

              If (yp+5)<(y0+ly+20) then begin

                                    PutImage(xs,ys,B^,0);

                                    yp:=yp+5;

                                    goto M1;

                                     end

                                    else

                                    Begin PutImage(xs,ys,B^,0); yp:=yp; goto M1; end;

             end;

Нажатие клавиши вправо – переместить курсор на 5 пикселей вправо:

if kod=#77 then begin

              If (xp+5)<(x0+lx+40) then begin

                                    PutImage(xs,ys,B^,0);

                                    xp:=xp+5;

                                    goto M1;

                                    end

                                    else

                                    Begin PutImage(xs,ys,B^,0); xp:=xp; goto M1; end;

             end;

Нажатие клавиши влево – переместить курсор на 5 пикселей влево:

if kod=#75 then begin

              If (xp-5)>(x0-50) then begin

                                    PutImage(xs,ys,B^,0);

                                    xp:=xp-5;

                                    goto M1;

                                     end

                                    else

                                    Begin PutImage(xs,ys,B^,0); xp:=xp; goto M1; end;

              end;

Нажатие клавиши Tab – убрать вывести сетку:

If kod=#9 then Begin     PutImage(xs,ys,B^,0);

                                   e:=e+1;

                                   e:=e mod 2;

                                   If e=1 then col:=black ;

                                   If e=0 then col:=red;

                      Setka(XYZ,NNN,Ntr,Nt,x0,y0,col,xmin,ymax,kx,ky);

                                   goto M1;

                                       end;

Нажатие клавиши Esc – выход из программы:

If kod=#27 then Begin

                                       PutImage(xs,ys,B^,0);

                                       FreeMem(B,264);

                                       EXIT;

              end;

end;

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

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

Процедура нахождение точки пересечения отрезка и плоскости: