Pascal/Turbo Pascal - Ramón necesito ayuda con un ejercicio con lazarus/pascal

{Esto te puede ayudar}

program retucula;

 {$N+}

 uses

    crt, dos;

  type

    string12 = string[12];

  var

      x, y : integer;

    screenx, screeny : word;

    page, bpp : byte;

    posxx, posyy, posx, posy : integer;

    cuadro, ck, logx, logy : integer;

  function realstring(n : real) : string12;

  var

    nus : string12;

   begin

      realstring := '';

      str(n:8:4,nus);

      realstring := copy(nus,1,length(nus));

   end;

  function integerstring(n : integer) : string12;

  var

    s : string12;

    begin

       str(n,s);

       integerstring := copy(s,1,length(s));

    end;

  procedure iniciografico;

  var

     i : integer;

     entorno : string;

  begin

     asm

       mov ax,4f02h

       mov bx,$101

       int 10h

     end;

      bpp := 16;

      screenx := 640;

      screeny := 480;

  end;

  procedure closegraficos;

  begin

    asm

      mov ah,00h

      mov al,03h

      int 10h

    end;

    bpp := 0;

    screenx := 80;

    screeny := 24;

  end;

  procedure putpixel(x, y : word; c : byte);

  var

      banco : word;

      despla : longint;

   begin

    despla := longint(y) * 640 + x;

    banco := despla shr 16;

    despla := despla - (banco shl 16);

    if banco <> page then

    begin

    page := banco;

    asm

      mov ax,4F05h

      mov dx,banco

      int 10h

    end;

  end;

  asm

    mov ax,0A000h

    mov es,ax

    mov di,word(despla)

    mov al,c

    mov es:[di],al

   end;

 end;

  Procedure Clearscreen;

  var

    t, l : integer;

  begin

    for l := 1 to 480 do

    begin

        for t := 1 to 640 do

        putpixel(t,l,0);

    end;

 end;

 procedure outtextxy(x, y : word; texto : string);

 var

   lx, ly : word;

   col, bit, posf, font, posi : byte;

   i, t : integer;

  begin

     ly := y;

   for posi := 1 to Length(texto) do

   begin

      lx := x;

      y := ly;

   for posf := 0 to 7 do

   begin

     font := mem[$ffa6:$e + (ord(texto[posi]) shl 3) + posf];

      for bit := 7 downto 0 do

      begin

       if (font and (1 shl bit)) <> 0 then

        putpixel(x, y, 15);

        x := x + 1;

       end;

          y := y + 1;

          x := lx;

     end;

          x := x + 8;

     end;

   end;

   procedure linea(x1, y1, x2, y2 : Integer; color : byte);

   var

     dd, dx, dy, ai, bi, xi, yi : Integer;

  begin

    if (x1 < x2) then

    begin

      xi := 1;

      dx := x2 - x1;

    end

 else

   begin

     xi := - 1;

     dx := x1 - x2;

   end;

   if (y1 < y2) then

   begin

      yi := 1;

      dy := y2 - y1;

   end

 else

    begin

        yi := - 1;

        dy := y1 - y2;

    end;

     putPixel(x1, y1, color);

    if (dx > dy) then

    begin

       ai := (dy - dx) * 2;

       bi := dy * 2;

       dd := bi - dx;

    repeat

      if (dd >= 0) then

      begin

        y1 := y1 +  yi;

        dd := dd +  ai;

      end

  else

       dd := dd +  bi;

       x1 := x1 + xi;

      putPixel(x1, y1, color);

    until (x1 = x2);

    end

  else

   begin

    ai := (dx - dy) * 2;

    bi := dx * 2;

    dd := bi - dy;

    repeat

      if (dd >= 0) then

      begin

        x1 := x1 +  xi;

        dd := dd + ai;

      end

   else

      dd := dd + bi;

      y1 := y1 +  yi;

      putPixel(x1, y1, color);

    until (y1 = y2);

    end;

  end;

   procedure borrado(xb, yb : integer);

   var

     t, i : integer;

    begin

       for t := 0 to 7 do

        for i := 0 to 7 do

        putpixel(xb + t,yb + i,0);

    end;

   function entradato(xd, yd : integer) : real;

   var

     error, d, xi, yi : integer;

     tec : char;

     dato : string12;

     ton : real;

   begin

      d := 1;

    repeat

      tec := readkey;

      if tec in[#48..#57,#46] then

      begin

         dato[d] := tec;

         dato[0] := chr(d);

         outtextxy(xd + (d * 8),yd,dato[d]);

         d := d + 1;

         if d > 12 then

         d := 12;

      end;

      if tec = #8 then

      begin

         d := d - 1;

         if d < 1 then

         d := 1;

         borrado(xd + (d * 8),yd);

         dato[d] := ' ';

         dato[0] := chr(d);

         outtextxy(xd + (d * 8),yd,' ');

      end;

    until tec = #13;

    val(dato,ton,error);

    if error <> 0 then

    begin

       delete(dato,error,1);

       val(dato,ton,error);

    end;

      entradato := ton;

   end;

  procedure cuadricula(x1, y1, cu : integer);

  var

     superf : double;

     x, y : integer;

     t, yy, xx : integer;

   begin

      if cu > 29 then

      cu := 29;

      superf := 100 * cos(sqrt(x1 * x1 + y1 * y1) / 150) - 50 *

                    sin(sqrt((x1 + 75) * (x1 + 75) + (y1 - 120) *

                    (y1 - 120)) / 40);

      x := trunc(superf);

      y := trunc(superf);

      yy := round(cu * 0.50);

      xx := yy * cu;

       for t := 0 to cu do

       begin

       linea(x,y + (t * yy),x + xx,y + (t * yy),15);

       linea(x + (t * yy),y,x + (t * yy),y + xx, 15);

       end;

       cuadro := (yy * cu);

       posxx := x;

       posyy := y;

       posx := trunc((x + xx) / 2);

       posy := trunc((y + xx) / 2);

       logx := x + xx;

       logy := y + xx;

   end;

  procedure calculo_orientacion;

  var

    orient, ejx, ejy, ejxx, ejyy : real;

    i, d : integer;

  begin

     outtextxy(100,2,'Entre Posicion x : ');

     ejx := entradato(244,2);

     outtextxy(100,12,'Entre Posicion xx : ');

     ejxx := entradato(244,12);

     outtextxy(100,22,'Entre Posicion y : ');

     ejy := entradato(244,22);

     outtextxy(100,32,'Entre Posicion yy : ');

     ejyy := entradato(244,32);

     orient := (ejx - ejxx) / (ejy - ejyy);

     outtextxy(100,43,'La Orientacion Es = ' + realstring(orient));

     for i := 0 to 5 do

       for d := 0 to 5 do

       putpixel(posx + trunc(ejx) + i,posy + trunc(ejy) + d,10);

     linea(posx + trunc(ejx),posy + trunc(ejy),

                          posx + trunc(ejxx),posy + trunc(ejyy),10);

     for i := 0 to 5 do

       for d := 0 to 5 do

       putpixel(posx + trunc(ejxx) + i,posy + trunc(ejyy) + d,10);

  end;

  procedure altitud_media;

  var

     yc : array[1..8] of real;

     t, marca, i : integer;

     gf, ent, altu, almed : real;

  begin

     marca := 6;

     outtextxy(100,2,'Entre Mediciones Alturas [Y]');

     i := 1;

      while i < (marca + 1) do

      begin

         outtextxy(100,12 + (i * 8),'Entre Altura Num.[' +

         integerstring(i) + '] y : ');

         ent := entradato(308,12 + (i * 8));

         yc[i] := ent;

         ent := 1;

         i := i + 1;

      end;

       altu := 0;

       gf := 0;

       for t := 1 to i - 1 do

       begin

       altu := altu + yc[t];

       if gf < yc[t] then

       gf := yc[t];

       end;

       almed := (altu / (i - 1));

       linea(posx,(posy * 2),posx,(posy * 2) - trunc(gf),13);

       linea(posx - 5,(posy * 2),posx - 5,(posy * 2) - trunc(almed),10);

       outtextxy(100,14 + ((i + 1) * 8),'La Altura Media Es : ' +

                              realstring(almed));

  end;

  procedure cortes_topograficos(marca : integer);

  var

    ent, xc, xxc, yyc : real;

    yc : array[1..8] of real;

    p, desp, t, i : integer;

  begin

      if marca > 7 then

      marca := 7;

      if marca < 1 then

      marca := 1;

      xc := 4;

      xxc := (logx - posxx);

      i := 1;

      ent := 1;

      outtextxy(100,2,'Entre Mediciones Alturas [Y]');

      while i < (marca + 1) do

      begin

         outtextxy(100,12 + (i * 8),'Entre Altura Num.[' +

         integerstring(i) + '] y : ');

         ent := entradato(308,12 + (i * 8));

         yc[i] := ent;

         ent := 1;

         i := i + 1;

      end;

      if trunc(xxc) > (logx - posxx) then

      xxc := (logx - posxx);

      if trunc(xc) < 1 then

      xc := 1;

      linea(posxx + trunc(xc), posyy + (posy + posy div 2) - 16,

            posxx + trunc(xxc), posyy + (posy + posy div 2) - 16,10);

      desp := trunc((xxc - xc) / i);

      t := 1;

      p := 1;

    repeat

      linea((posxx + trunc(xc)) + p, posyy + (posy + posy div 2) - 16,

      (posxx + trunc(xc)) + p, (posyy + (posy + posy div 2) - 16) -

      trunc(yc[t]),10);

      t := t + 1;

      p := p + round(marca * 7);

    until t > i - 1;

    p := 0;

    for t := 1 to i - 2 do

    begin

    linea((posxx + trunc(xc)) + p,(posyy + (posy + posy div 2) - 16) -

    trunc(yc[t]),(posxx + trunc(xc)) + round(marca * 7) + p,

    (posyy + (posy + posy div 2) - 16) - trunc(yc[t + 1]),10);

    p := p + round(marca * 7);

   end;

  end;

   procedure menu;

   var

     tex : char;

     sal : boolean;

   begin

       sal := false;

       repeat

         Clearscreen;

         outtextxy(4,30,'**** Menu General ****');

         outtextxy(4,50,'1 = Generacion De Una Reticula');

         outtextxy(4,60,'2 = Calculo De La Altitud Media');

         outtextxy(4,70,'3 = Obtencion De Cortes Topograficos');

         outtextxy(4,80,'4 = Calculo De Orientaciones');

         outtextxy(4,90,'5 = Salir');

         repeat

         tex := readkey;

         until tex in[#49..#53];

         Clearscreen;

   case tex of

  #49 : begin

          outtextxy(200,100,'Reticu');

          ck := 29;

          cuadricula(10,10,ck);  {Maximo valor de ck = 29 minimo 4}

          outtextxy(156,80,'Reticula de : ' + integerstring(cuadro) + ' X ' +

          integerstring(cuadro) + ' Pixel');

          readln;

        end;

  #50 : begin

          outtextxy(200,100,'Reticu');

          cuadricula(10,10,25);

          altitud_media;

          readln;

        end;

  #51 : begin

          outtextxy(200,100,'Reticu');

          cuadricula(10,10,25);

          cortes_topograficos(7);

          readln;

        end;

  #52 : begin

          outtextxy(200,100,'Reticu');

          cuadricula(10,10,25);

          calculo_orientacion;

          readln;

        end;

  #53 : sal := true;

   end;

       until sal = true;

   end;

  begin

     iniciografico;

     menu;

     closegraficos;

  end.