Pascal/Turbo Pascal - Compilador de pascal 7.7

program prueba;

uses

   crt, dos;

  var

    minombre : string;

    ayo, mes, dia, diase : word;

  begin

      clrscr;

      writeln('Mi Nombre Es : ');

      readln(minombre);

      clrscr;

      gotoxy((80 div 2) - 10,24 div 2);write('Escribi el Nombre = ',minombre);

      getdate(ayo,mes,dia,diase);

      gotoxy((80 div 2) - 10,(24 div 2) + 2);write('En Fecha    = ',

                                                  dia,'/',mes,'/',ayo);

      readln;

  end.

{Esto solo es una prueba para ver si las direcciones son correctas si no dará error}

{Seguimos conociendo mas de pascal y programación}

  {Manejando la pantalla en modo testo:

 La pantalla esta formada por pixeles o puntos en el caso del

 modo texto tiene 1 a 80 X 1 a 25 o lo que es lo mismo 80X25.

 1........................................80

 1.

  .

  .

  .

  .

  .

  .

 25

 Podemos posicionarnos en la zona que queramos de estas dimensiones,

 lo cual nos permite el desplazamiento por ello por ejemplo:

 la instruccion [write('Pantalla');] nos presentaria la frase Pantalla,

 en la posicion 1/1 de la pantalla y el cursor seguiria en la line 1/1.

 Si pusieramos [write(' Pantalla');] la posicion de Pantalla estaria

 en 2/1 en lugar de 1/1 ya que delante de Pantalla tenemos insertado

 un caracter en blanco o sea un espacio.

 La sentencia [writeln('Pantalla');] seria lo mismo que lo anterior pero

 ahora la posicion del cursor en la pantalla seria 1/2 al causar la

 sentencia writeln un desplazamiento de linea acia abajo.

 Como podreis apreciar para escribir cosas peque¤as va que va pero cuando

 se intenta formatear la salida mal este sistema por ejemplo para poner

 un nombre en el centro de la pantalla seria una labor como se suele decir

 de chinos (pido disculpas a los chinos no intento ofender).

 Como podemos comprender tenemos que emplear otros medios mas practicos

 que write o writeln solos, esto se consigue con la instruccion gotoxy(x,y),

 hablemos un poco para comprenderla.

 El pascal nos sirve en su [unit crt] de la instruccion gotoxy con dos

 parametros pasados que son x e y en nuestro caso [x de 1 a 80] y

 [y de 1 a 25], <que hace> coloca el cursor en la posicion x e y de la

 pantalla para escribir lo que queramos en ella ejemplo:

 gotoxy(10,10);write('*');

 nos presentara el asterisco en la posicion 10,10 de la pantalla.

 (Comento) esto mismo lo podemos implementar con un procedimiento en

 enssamblador, o con funciones de la bios, pero eso sera mas adelante esto

 es mas facil de realizar de momento.

 Veamos un peque¤o ejemplo: }

 {program disparo;

 uses

    crt;

  var

    i, x, y : integer;

    tecla : char;

  begin

      clrscr;

      gotoxy(3,1);write('Dispara con barra espaciadora a los blancos flechas',

                     ' mueven [Enter] termina');

      gotoxy(10,4);write('***');

      gotoxy(40,4);write('***');

      gotoxy(70,4);write('***');

      x := 40;

      y := 22;

    repeat

      gotoxy(x,y - 1);write('!');

      gotoxy(x,y);write('*');

      gotoxy(x,y + 1);write('*');

      tecla := readkey;

      gotoxy(x,y - 1);write(' ');

      gotoxy(x,y);write(' ');

      gotoxy(x,y + 1);write(' ');

      if tecla = #32 then

      begin

         for i := 21 downto 4 do

         begin

             gotoxy(x,y);write('*');

             gotoxy(x,y + 1);write('*');

             gotoxy(x,i);write('!');

             delay(50);

             gotoxy(x,i);write(' ');

         end;

          gotoxy(x,y - 1);write('!');

      end;

      if tecla = #75 then

      begin

          x := x - 1;

          if x < 1 then

          x := 1;

      end;

      if tecla = #77 then

      begin

         x := x + 1;

         if x > 79 then

         x := 79;

      end;

   until tecla = #13;

  end.}

 {En este pequeño ejemplo aparte del goto y write presento un pequeño

  manejo del teclado fuera de read o readln que veremos proxima mente.

  Los numeros que se encuentran como [#77/#75/#13] corresponden a los

  valores numericos de las teclas de flecha, derecha, izquierda y   retun

  a sin como [#32] barra espaciadora.

  A unque mas adelante veremos como trabajar con estos datos.

  Espero practiquéis con el programa para que le toméis la medida al

  gotoxy puesto que trabajaremos con el en muchas ocasiones.

  debéis modificar la posición de los asteriscos en pantalla y probar

  en otras posiciones de ellas.

  A continuación tratemos un comando expuesto en este programa ese es

  readkey :

  este es una función de la unidad [crt] que nos devuelve un carácter

  del teclado o sea el carácter de la tecla pulsada este no es   presentado

  en pantalla solo lo entrega para ello empleamos una variable char   que

  recogerá dicho carácter, al mismo tiempo esta función nos retiene la

  ejecución del programa con lo cual podemos tomar decisiones en razón

  a lo que nos entregue readkey, un ejemplo es el desplazamiento a   derecha

  o izquierda y disparo dependiendo de la tecla pulsada.

  Iremos viendo como lo emplearemos en diversas ocasiones.}

  {Este programa os mostrara los números y caracteres de las teclas}

 { program teclado;

  uses

   crt;

   var

       tecla : char;

       x, y, nume : integer;

   begin

   clrscr;

   sound(100);

   delay(129);

   nosound;

   x := 1;

   y := 1;

   nume := 9;

   repeat

       textcolor(14);

       gotoxy(x,y);write(nume);

       textcolor(15);

       gotoxy(x + 4,y);write(tecla);

       inc(nume);

       tecla := chr(nume);

       inc(y,1);

       if y > 23 then

       begin

           y := 1;

           x := x + 8;

       end;

   until nume > 232;

   gotoxy(10,24);write('pulse una tecla o ESC');

   repeat

      tecla := readkey;

      if tecla = #0 then

      begin

      tecla := readkey;

      gotoxy(32,24);write('       ');

      gotoxy(32,24);write(ord(tecla),'  ',tecla);

      end

   else

      begin

          gotoxy(32,24);write('       ');

          gotoxy(32,24);write(ord(tecla),'  ',tecla);

      end;

   until tecla = #27;

   end. }

  {Veréis alguna instrucción nueva pero solo observarlas ya las

  Veremos mas adelante esto es para que valláis tomando nociones poco

  a poco.}

{ hoy pasamos a tratar los comandos read y readln como entradas

   de valores en variables, retenciones ose espera y ficheros.

  [Read/readln] :

  Como sistema de entrada permite introducir datos el una variable

 cualquiera, pero no informara si la entrada en la variables numéricas

 se ingresa un carácter en vez de un numero, causando a la salida error.

 Ejemplo:

 var

    dat : string;

    nu : integer;

  begin

  read(dat); {Si entramas numero no pasa nada lo toma como carácter}

  {read(nu);} {Si entramos un carácter a la salida dará error de formato}

  {end;}

  {var

    dat : string;

    nu : integer;

  begin

  readln(dat);} {Si entramas numero no pasa nada lo toma como carácter}

  {readln(nu);} {Si entramos un carácter a la salida dará error de formato}

  {end;

  Diferencia entre [read y readln] read sigue la entrada en la línea y

  readln pasa a la siguiente línea.

En ficheros con tipo, lee un componente del fichero y lo introduce en

la variable.

Ejemplo:

type

regdato = record

         nombre : string;

         direccion : string;

         telefono : word;

        end;

 var

    f : file of regdato;

    dato : regdato;

    assign(f,'xxxxxx.xxx');

    reset(f);

    seek(f,0);

    read(f,dato);

    close(f);

  Leera el primer registro del fichero [f] completo.

  Para ficheros tipo texto, lee uno o m s valores y los introduce en una o

  m s variables.

  Ejemplo:

  var

    tex : text;

    cha : char;

    assign(tex,'xxxxxx.xxx');

    reset(tex);

    while not Eof(tex) do

    begin

        read(tex,cha);

        write(cha);

    end;

  Leerá todo el archivo de texto presentándolo en pantalla.}

  {Ejemplo:}

    program leetexto;  {Este Programa leerá un archivo de texto entero}

    uses

      crt;

    var

      f : text;

      dato : char;

      nombrearchivo : string;

   begin

      nombrearchivo := 'c:\tp\cursopas\numero3.pas'; {Archivo a leer}

      assign(f,nombrearchivo); {Le abrimos}

    {$I-} reset(f); {$I+}   {Comprobamos si existe error}

    if ioresult <> 0 then   {Si error salimos del programa}

    halt(1);   {Detiene el programa y vuelve al dos}

    while not Eof(F) do  {leemos asta el final de archivo}

    begin

      read(f,dato);  {Leemos los datos carácter a carácter}

      write(dato);  {Los presentamos en pantalla}

    end;

    close(f); {cerramos el archivo siempre que se abra un archivo

               se debe de cerrar para no perder los datos o que se

               dañen}

    readln;  {Detenemos la salida para ver que presento solo se

              verán las 25 líneas intimas}

  end.    {final del programa}

  {Con esto de momento quedan explicados los comandos read y readln

   practicar con entradas a variables y comprobación de las salida de

   archivos de texto este otro programa mostrara como se controla la

   entrada de datos sin read ni readln}

   program entradas;

   uses

     crt;

   var

     tecla : char;

     result, dato : string;

     dareal : real;

     dainte : integer;

     dastri : string;

     error, cont : integer;

   function datosalida(x1, y1 : integer; cual : char) : string;

   {las x1 y y1 posicionan la entrada donde queramos en la pantalla}

   begin

       cont := 1;

       datosalida := ' ';

       gotoxy(x1,y1);  {posicionamos cursor}

     repeat

       tecla := readkey;

       if cual in['n','N'] then  {solo entrada numérica}

       begin

          if tecla in[#48..#57,#46] then {verificamos que es numérica}

          begin

             dato[cont] := tecla;  {entramos el carácter pulsado}

             dato[0] := chr(cont); {en la variable dato y el numero

                                    de entradas de caracteres realizadas}

             gotoxy((x1 - 1) + cont,y1);write(dato[cont]); {lo presentamos}

             cont := cont + 1;   {incrementamos el contador}

             if cont > 255 then {comprobamos si la entrada es mayor que}

             cont := 255;       {la cadena no entramos mas datos de 255}

          end;

       end;

       if cual = ' ' then   {esto es como lo anterior pero en este caso}

       begin                {cualquier carácter es valida su entrada}

           dato[cont] := tecla;

           dato[0] := chr(cont);

           gotoxy((x1 - 1) + cont,y1);write(dato[cont]);

           cont := cont + 1;

           if cont > 255 then

           cont := 255;

       end;

       if tecla = #8 then  {aquí borramos las entradas realizadas}

       begin               {o erróneas}

           cont := cont - 1; {decremento contador}

           if cont < 1 then  {si es menor de 1 lo dejamos a 1}

           cont := 1;

           dato[cont] := ' ';  {borramos carácter de la posición cont}

           dato[0] := chr(cont);  {actualizamos entradas}

           gotoxy((x1 - 1) + cont,y1);write(dato[cont]); {lo presentamos}

       end;

     until (tecla = #13) or (tecla = #27);

     {si pulsamos enter finaliza entrada y actualiza si pulsa esc sale sin

      realizar nada deja [datosalida] limpio}

     if tecla = #13 then

     datosalida := copy(dato,1,length(dato)); {carga datos en función}

   end;

  begin

      clrscr;  {limpiamos pantalla}

      gotoxy(1,10);write('Entre Numero : ');

      result := datosalida(16,10,'n');{tomamos la entrada es numérica}

      val(result,dareal,error); {convertimos a numérica}

      if error > 0 then   {comprobamos si hay error en la conversión}

      begin

         delete(result,1,error); {si hay error lo quitamos}

         val(result,dareal,error); {volvemos a convertir}

      end;

      gotoxy(1,10);clreol; {borramos la entrada solo una línea}

      writeln(dareal:8:2); {presentamos resultados numéricos}

      readln; {espera asta pulsar enter}

      clrscr;  {limpiamos pantalla}

      gotoxy(1,10);write('Entre Texto : ');

      result := datosalida(15,10,' ');{tomamos la entrada es texto}

      gotoxy(1,10);clreol; {borramos la entrada solo una línea}

      writeln(result); {salida del testo no se modifica nada}

      readln; {espera asta pulsar enter}

  end.

{En esta veremos datos que no hemos tocado todavía  pero es bueno irles conociendo

 en la pro sima veremos las const,  arrays, record, types y algo de ensamblador de pascal

para ir abriendo boca}

{veremos las const,  arrays, record, types y algo de ensamblador de pascal

  trabajando con const,arrays,record,types y ensamblador inicio programación}

 {las constantes como su nombre indica son valores fijos que podremos

  consultar durante todo el proceso del programa por ejemplo el valor

  pi = 3.1416 nos puede valer para cálculos en diferentes procedimientos

  o funciones sin tener que insertar el numero solo poniendo pi.

  Ejemplo:}

  uses

     crt;

  const

     pi = 3.1416; {fijaros que 3.1416 va con punto tener en cuenta que

                    la coma en pascal no vale para separar decimales

                    esto seria error pi := 3,1416}

   var

      diame : real;

   begin

      write('Entre diametro : ');

      read(diame);

      writeln;

      write('Circunferencia = ',pi * diame:8:2);

      readkey;

   end.

  {O cualquier otro servicio en que lo requiera como ya se comento existen

  las constantes variables las cuales se emplean cuando un valor de inicio

  queremos que varié durante el proceso.

  Ejemplo :}

  uses

    crt, dos;

  const

     horari : string = ' ';

  var

    ho, mi, se, de : Word;

  function worstring(w : word) : string; {Esta function nos convierte}

  var                                    {un numero word en estringe}

     s : string;                         {insertando un cero si solo}

  begin                                  {tuviera un numero 4 pondra}

      str(w:0,s);                        {04 en su lugar}

      if length(s) = 1 then

       s := '0' + s;

      worstring := s;

   end;

   begin

     clrscr;

    repeat

       gettime(ho,mi,se,de);

       horari := worstring(ho) + ':' + worstring(mi) + ':' + worstring(se);

       gotoxy(10,10);write('La Hora Es = ',horari);

    until keypressed;

   end.

 {Se puede ver como cambia la hora en la constante}

 {Los Arrays son variables múltiples en una sola variable se expresa así

  dias : array[0..6] of string[12]; esto sera Como variable,

  dias = array[0..6] of string[12]; esto seria como type;

  dias : array[0..6] of string[12] = ('Lunes','Martes','Miercoles','Jueves',

                                      'Viernes','Savado','Domingo');

  seria como constante.

  como veis el array puede tomar diferentes condiciones dependiendo de lo

  que queramos.

  En este caso toma 7 variables string de 12 caracteres que seria

  dias0 : string[12]; asta dias6 se maneja mejor el array que tantas

  variables.

  Como manejamos un array vamos a ver.}

  program arrays;

uses

   crt;

 const

   dias : array[0..6] of string[12] = ('Lunes','Martes','Miercoles',

                               'Jueves','Viernes','Savado','Domingo');

  type

    semana = array[0..3] of integer;

  var

    mes : semana;

    sem, cual : integer;

  begin

     clrscr;

     for sem := 0 to 3 do

     mes[sem] := sem + 1;

     for sem := 0 to 3 do

     begin

      write(' semana ',mes[sem]);

      for cual := 0 to 6 do

      begin

      write('  ',dias[cual]);

      end;

        writeln;

     end;

      readln;

  end.

  {vemos como cargamos los valores en el array mes que corresponde a

   semana y luego presentamos los datos y el contenido de la constante

   array días}

  {como manejamos un record en este entraran los arrays también}

  program recordes;

uses

   crt;

 type

   datos = array[1..6] of string[20];

   sueld = array[1..6] of real;

   currante = record

        nombre : string;

        dias : datos;

        dinese : sueld;

       end;

   var

     trabajo : currante;

     dat : string;

     dsem : string[20];

     sueldo : real;

     error, dr, cont : integer;

     tecla : char;

     suel, dato : string;

  function datosalida(x1, y1 : integer; cual : char) : string;

   begin

       cont := 1;

       datosalida := ' ';

       gotoxy(x1,y1);

     repeat

       tecla := readkey;

       if cual in['n','N'] then

       begin

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

          begin

             dato[cont] := tecla;

             dato[0] := chr(cont);

             gotoxy((x1 - 1) + cont,y1);write(dato[cont]);

             cont := cont + 1;

             if cont > 255 then

             cont := 255;

          end;

       end;

       if cual = ' ' then

       begin

          if (tecla = #8) or (tecla = #13) then

          begin

          end

        else

          begin

           dato[cont] := tecla;

           dato[0] := chr(cont);

           gotoxy((x1 - 1) + cont,y1);write(dato[cont]);

           cont := cont + 1;

           if cont > 255 then

           cont := 255;

       end;

     end;

       if tecla = #8 then

       begin

           cont := cont - 1;

           if cont < 1 then

           cont := 1;

           dato[cont] := ' ';

           dato[0] := chr(cont);

           gotoxy((x1 - 1) + cont,y1);write(dato[cont]);

       end;

     until (tecla = #13) or (tecla = #27);

     if tecla = #13 then

     datosalida := copy(dato,1,cont - 1);

   end;

   begin

      clrscr;

      gotoxy(2,2);write('Entre Nombre  : ');

      trabajo.nombre := datosalida(18,2,' ');

      dr := 1;

    repeat

      gotoxy(2,3);clreol;

      gotoxy(2,4);clreol;

      gotoxy(2,3);write('Entre El Dia  : ');

      dsem := datosalida(18,3,' ');

      trabajo.dias[dr] := copy(dsem,1,length(dsem));

      gotoxy(2,4);write('Dinero De Hoy : ');

      suel :=  datosalida(18,4,'n');

      val(suel,sueldo,error);

      if error > 0 then

      begin

         delete(suel,error,1);

         val(suel,sueldo,error);

      end;

      trabajo.dinese[dr] := sueldo;

      dr := dr + 1;

    until dr > 6;

    clrscr;

    writeln('Nombre = ',trabajo.nombre);

    for dr := 1 to 6 do

    begin

      write('El DIA : ',trabajo.dias[dr],'     Importe : ',

                                         trabajo.dinese[dr]:8:2);

    writeln;

    end;

    for dr := 1 to 6 do

    sueldo := sueldo + trabajo.dinese[dr];

    writeln('Sueldo total Semana = ',sueldo:8:2);

      readln;

   end.

  {En caso de querer guardar el registro solo tendremos que realizar

   esto.}

   procedure guardarecord(nom : string); {Este es el nombre del archivo}

   var

     f : file of currante;

   begin

       assign(f,nom);

    {$I-} reset(f); {$I+} {esto nos permite conozer si salio error}

    if ioresult <> 0 then {si es mayor de 0 el archivo no esiste}

    begin                 {por lo tanto lo creamos}

       rewrite(f); {Crea y abre un fichero nuevo}

       seek(f,0); {posicionamos el puntero en la posicion 0 del archivo}

       write(f,trabajo); {guardamos el registro}

       close(f); {cerramos el archivo}

     end

   else   {si la condicion anterios fue 0 se realiza lo sigiente}

       begin

          seek(f,filesize(f)); {posicionamos el puntero al final}

          write(f,trabajo);    {del archivo y guardamos los datos}

          close(f); {cerramos el archivo}

       end;

   end;

  {Este procedimiento guarda los datos anteriores del registro entrado

   del trabajador si quisiéramos cargar datos casi seria igual ejemplo:}

   procedure cargaregistro(nom : string);

   var

     f : file of currante;

     nomb : string;

     gf : longint;

     salir : boolean;

     suel : real;

   begin

      assign(f,nom);

    {$I-} reset(f); {$I+} {esto nos permite conozer si salio error}

    if ioresult <> 0 then {si es mayor de 0 el archivo no esiste}

    begin

       halt(1); {salimos el archivo no existe}

    end

  else    {el archivo existe lo cargamos}

      begin

          gotoxy(2,3);write('Entre Nombre Trabajador a Visualizar : ');

          gotoxy(41,3);read(nomb); {pedimos el nombre del trabajador}

        gf := 0;

        salir := false; {condicion para la salida true}

     repeat

        seek(f,gf);  {nos posicionamos en la primera posicion [0]}

        read(f,trabajo); {leemos el registro}

        if trabajo.nombre = nomb then  {comparamos el nombre}

        salir := true;  {si es igual salimos}

     gf := gf + 1;   {contador de registros}

     until (gf > filesize(f) - 1) or (salir = true); {salir o encontrado}

     close(f);             {o final del archivo y cerramos}

     if salir = true then  {si se encontro lo presentamos}

     begin

        writeln('Nombre = ',trabajo.nombre);

        for gf := 1 to 6 do

        begin

        write('El DIA : ',trabajo.dias[gf],'     Importe : ',

                                         trabajo.dinese[gf]:8:2);

    writeln;

    end;

    suel := 0;

    for gf := 1 to 6 do

    suel := suel + trabajo.dinese[gf];

    writeln('Sueldo total Semana = ',sueldo:8:2);

      readln;

     end;

   end;

  end;

 {como veis es facil todo es empezar a conocerlo}

 Los types nos permiten especificar:

  arrays, fichero, objeto, puntero, registro, conjunto :

 arrays :

 integers  = array[1..100] of Integer;

 chares = array['A'..'Z']   of byte;

 matrixreal = array[0..9, 0..9] of real;

 ficheros y registros :

 Persona = record

  nombre : string[15];

  apellido : string[25];

  direccion  : string[35];

 end;

  archivo = file of Persona;

  objeto :

   unpunto = objeto

          x, y : integer;

          procedure puntover(x,y);

          procedure puntovorra(x,y);

         end;

  punteros :

    puntbyte  = ^Byte;

    puntword  = ^Word;

    puntident = ^regident;

     regident = record

         nombre : string[30];

            dni : Word;

           sigi : puntident;

         end;

  conjuntos :

      dia = (lun, mar, mir, juv, vir, sav, dom);

      cart = set of char;

      num = set of 0..9;

      dias = set of dia;

 {Esto empieza como sigue se trata de un procedimiento y función

  en ensamblador dentro de un programa en pascal como también veréis

  se puede implementar con interrupciones del dos es solo para que

  tengáis un conocimiento algo mas avanzado para no bloquearos en

  su momento ya que camino conocido mejor se anda.}

program ejemplo;

 uses

   crt, dos;   {entrada de la unit dos para manejar las interruciones}

  var

    regs : registers; { Registers = record

                        case Integer of

                   0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);

                   1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);

                   end;}

    raton : boolean;  {variable para informacion del la presencia del mouse}

    pulsado : integer;

     function raton_presente : boolean; {comprovamos presencia false/true}

     begin

      regs.ah := $00;  {valores para ah} Înicia mouse}

      regs.al := $00;  {valores para al}

      intr($33,regs);  {interruccion del mouse}

      if regs.ax <> 0 then  {comprovamos si exite mouse}

      raton_presente := true {si}

    else

      raton_presente := false; {no}

  end;

     procedure muestra_ratonint;

     begin

      raton := false;  {informacion para el cierre}

      if raton_presente then  {si existe segimos}

      begin

          regs.ah := $00; {valor ah} {muestra cursor del mouse}

          regs.al := $01; {valor al}

          intr($33,regs); {interruccion}

          raton := true;  {si se cargo}

      end;

   end;

    procedure oculta_ratonint;

    begin

      if raton = true then {comprovacion se activo}

      begin

         regs.ah := $00; {valor ah}

         regs.al := $02; {valor al} {Oculta el cursor del mouse}

         intr($33,regs);  {interruccion}

         raton := false;  {anulamos true}

       end;

   end;

   function pulsa_botonint:word;

   begin

      regs.ah := $00; {indica el boton pulsado del mouse}

      regs.al := $05;

      intr($33,regs);

      pulsa_botonint := regs.ax;

  end;

   function raton_presenteasm : boolean;assembler;

    asm

      mov ah,$00

      mov al,$00

      int $33

    end;

  procedure muestra_ratonasm;assembler;

  asm

     mov ah,$00

     mov al,$01

     int $33

  end;

  procedure oculta_ratonasm;assembler;

  asm

    mov ah,$00

    mov al,$02

    int $33

  end;

  function pulsa_botonasm : word;assembler;

   asm

     mov ah,$00

     mov al,$05

     int $33

   end;

   begin

      clrscr;

       writeln('Mouse con Registros pulsa botones');

       muestra_ratonint;

       repeat

       case  pulsa_botonint of

     1 : begin gotoxy(20,10);write('Izq');end;

     2 : begin gotoxy(20,10);write('Drch');end;

     0 : begin gotoxy(20,10);write('    ');end;

       end;

       until keypressed;

       readln;

       oculta_ratonint;

       clrscr;

       writeln('Mouse en Ensamblador pulsa botones');

       if raton_presenteasm then

       muestra_ratonasm;

       repeat

       case  pulsa_botonasm of

     1 : begin gotoxy(20,10);write('Izq');end;

     2 : begin gotoxy(20,10);write('Drch');end;

     0 : begin gotoxy(20,10);write('    ');end;

       end;

       until keypressed;

       oculta_ratonasm;

  end.

  {Este programa muestra la llamada al Mouse de dos maneras pero

   el mismo resultado.

   Si tenéis dudas decírmelo intentare quitároslas.}

{ejemplo:}

  program prueva;

  uses

    crt;

   type

      ciudad = record

             nombre : string[60];

             pais   : string[60];

             region : string[70];

           end;

  var

     datosciudades : ciudad;

     f : file of ciudad;

  procedure entradas;

  begin

     clrscr;

     gotoxy(1,1);write('NOMBRE ES    : ');

     readln(datosciudades.nombre);

     gotoxy(1,2);write('EL PAIS ES   : ');

     readln(datosciudades.pais);

     gotoxy(1,3);write('LA REGION ES : ');

     readln(datosciudades.region);

  end;

  procedure presenta;

  begin

     clrscr;

     gotoxy(1,1);write('NOMBRE ES    : ',datosciudades.nombre);

     gotoxy(1,2);write('EL PAIS ES   : ',datosciudades.pais);

     gotoxy(1,3);write('LA REGION ES : ',datosciudades.region);

     gotoxy(1,5|);write('Pulse [Enter]');

     readln;

  end;

  procedure guarda;

  begin

      assign(f,'TEMPORAL.DAT');

    {$I-} reset(f); {$I+}

    if ioresult <> 0 then

    begin

       rewrite(f);

       seek(f,0);

       write(f,datosciudades);

       close(f);

    end

  else

     begin

         seek(f,filesize(f));

         write(f,datosciudades);

         close(f);

     end;

  end;

  procedure menu;

  var

    tec : char;

    sal : boolean;

  begin

    sal := false;

    repeat

      clrscr;

      gotoxy(1,1);write('<<<< MENU GENERAL >>>>');

      gotoxy(1,3);write(' 1 = ENTRADAD');

      gotoxy(1,4);write(' 2 = PRESENTAR');

      gotoxy(1,5);write(' 3 = GUARDAR');

      gotoxy(1,6);write(' 4 = SALIR');

      gotoxy(1,8);write(' **** ELIJA OPCION ****');

      tec := readkey;

    case tec of

  #49 : entradas;

  #50 : presenta;

  #51 : guardar;

  #52 : sal := true;

    end;

   until sal = true;

  end;

  begin

     menu;

  end.

  {Una vez revisado el programa y funcionando todo bien se modifica}

  {para que sea unidad sigamos}

  unit prueva;

  interface

  uses

    crt;

   type

      ciudad = record

             nombre : string[60];

             pais   : string[60];

             region : string[70];

           end;

  var

     datosciudades : ciudad;

     f : file of ciudad;

   procedure entradas;

   procedure presenta;

   procedure guarda;

   procedure menu;

   implementation

  procedure entradas;

  begin

     clrscr;

     gotoxy(1,1);write('NOMBRE ES    : ');

     readln(datosciudades.nombre);

     gotoxy(1,2);write('EL PAIS ES   : ');

     readln(datosciudades.pais);

     gotoxy(1,3);write('LA REGION ES : ');

     readln(datosciudades.region);

  end;

  procedure presenta;

  begin

     clrscr;

     gotoxy(1,1);write('NOMBRE ES    : ',datosciudades.nombre);

     gotoxy(1,2);write('EL PAIS ES   : ',datosciudades.pais);

     gotoxy(1,3);write('LA REGION ES : ',datosciudades.region);

     gotoxy(1,5|);write('Pulse [Enter]');

     readln;

  end;

  procedure guarda;

  begin

      assign(f,'TEMPORAL.DAT');

    {$I-} reset(f); {$I+}

    if ioresult <> 0 then

    begin

       rewrite(f);

       seek(f,0);

       write(f,datosciudades);

       close(f);

    end

  else

     begin

         seek(f,filesize(f));

         write(f,datosciudades);

         close(f);

     end;

  end;

  procedure menu;

  var

    tec : char;

    sal : boolean;

  begin

    sal := false;

    repeat

      clrscr;

      gotoxy(1,1);write('<<<< MENU GENERAL >>>>');

      gotoxy(1,3);write(' 1 = ENTRADAD');

      gotoxy(1,4);write(' 2 = PRESENTAR');

      gotoxy(1,5);write(' 3 = GUARDAR');

      gotoxy(1,6);write(' 4 = SALIR');

      gotoxy(1,8);write(' **** ELIJA OPCION ****');

      tec := readkey;

    case tec of

  #49 : entradas;

  #50 : presenta;

  #51 : guardar;

  #52 : sal := true;

    end;

   until sal = true;

  end;

  begin

  end.

{Este programa tiene muchos de los procedimientos y funciones con los cuales

trabajaremos en adelante.}

 {programa ejemplo pascal comentado realizaremos un pequeño editor.}

 {Para evitar fallos de presentación de símbolos expongo el tipo de}

 {configuración en Windows 7 profesional 32 bit.}

 {teclado PS/2 estándar configuración Español (Espada - alfab.}

 {Internacional con el representare los caracteres del programa.}

 program minieditor;

 {$M 65000,0,650000}

 uses

   crt, dos;

  const

     archivo : string = 'NombArch.xxx';

  type

     string7 = string[7];

     dattexto = array[0..500] of string[79];

  var

     dia, mes, ayo, diasem : word;

     xo, yo, opcion : integer;

     tecla : char;

     ejecuta, salir : boolean;

     texto : dattexto;

     tt, cont : integer;

  function toma_hora : string;

  var

     hor, min, seg, m : string[2];

     i : byte;

     regs : registers;

  begin

     regs.ah := $2c;

     msdos(regs);

     str(regs.cl:2,min);

     str(regs.dh:2,seg);

     for i := 1 to 2 do

     begin

        if min[i] = ' ' then

        min := '0';

        if seg[i] = ' ' then

        seg := '0';

     end;

   case regs.ch of

      0 : i := 12;

 13..23 : i := regs.ch - 12;

 else

     i := regs.ch;

   end;

   str(i:2,hor);

   if hor[1] = ' ' then

   hor[1] := '0';

   toma_hora := 'Hora : ' + hor + ':' + min;

 end;

  procedure marcadormenu(x,y : integer; menu : string7);

  begin

     TextBackground(7);

     gotoxy(x,y);write('        ');

     TextColor(0);

     gotoxy(x + 1,y);write(menu);

     TextBackground(0);

     TextColor(15);

  end;

  procedure Varramenu(x1, y1, opci : integer);

  var

    men : string7;

  begin

      gotoxy(2,1);write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ',

                          'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');

      gotoxy(2,2);write('³');

      gotoxy(77,2);write('³');

      gotoxy(2,3);write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ',

                          'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');

      gotoxy(78,2);write('Û');

      gotoxy(78,3);write('Û');

      gotoxy(3,4);write('ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß',

                        'ßßßßßßßßßßßßßßßßßßßßßßßßßßßß');

      gotoxy(4,2);write('Cargar    Salvar    Editar    Salir   Fecha : ');

      getdate(ayo,mes,dia,diasem);

      gotoxy(50,2);write(dia,'/',mes,'/',ayo);

      gotoxy(4,2);

   case opci of

  1 : men := 'Cargar';

  2 : men := 'Salvar';

  3 : men := 'Editar';

  4 : men := 'Salir';

   end;

      marcadormenu(x1,y1,men);

  end;

  procedure cargaarchivo;

  var

     nomb : string[12];

     f : text;

     pu, cha : char;

     n : integer;

  begin

      window(2,5,79,24);

      gotoxy(2,2);write('Entre Nombre Archivo : ');

      gotoxy(25,2);readln(nomb);

      assign(f,nomb);

      {$I-} reset(f); {$I+}

      if ioresult <> 0 then

      begin

         exit;

      end

   else

      begin

       clrscr;

       writeln('Contenido Del Archivo Nombre : ',nomb);

       writeln('---------------------------------------------');

       n := 0;

       window(2,8,79,24);

       while not Eof(F) do

       begin

         Read(F, Cha);

         Write(Cha);

         if cha = #10 then

         n := n + 1;

         if n > 16 then

         begin

            n := 0;

            textcolor(12);

            gotoxy(1,24);write('Pulse [ ',chr(25),' ]');

            textcolor(15);

            repeat

              pu := readkey;

            until pu = #80;

            clrscr;

         end;

       end;

         writeln;

         textcolor(12);

         gotoxy(2,17);write('Final Archivo Pulsa [Enter]');

         textcolor(15);

         readln;

         close(f);

         window(2,5,79,24);

         clrscr;

      end;

  end;

  procedure salvaarchivo(nu : integer;tex : dattexto);

  var

     nomb : string[12];

     f : text;

  begin

      if nu > 0 then

      begin

      window(2,5,79,24);

      gotoxy(2,1);write('Entre nombre y Extension : ');

      gotoxy(29,1);readln(nomb);

      assign(f,nomb);

   {$I-} reset(f); {$I+}

   if ioresult <> 0 then

   begin

       rewrite(f);

       for tt := 0 to cont do

       writeln(f,texto[tt]);

       close(f);

   end

  else

      begin

         writeln('El fichero Existe Pulse [Enter]');

         readln;

      end;

     end;

  end;

  procedure editartexto;

  var

    salir : boolean;

  begin

      window(2,5,79,24);

      gotoxy(5,1);write('*** EDITOR TEXTO 500 LINRAS CON READLN ',

                                          '[Espacio] Termina ***');

      window(2,7,79,24);

      salir := false;

      cont := 0;

    repeat

     readln(texto[cont]);

     if texto[cont] <> ' ' then

     cont := cont + 1;

    until texto[cont] = ' ';

    window(2,5,79,24);

    clrscr;

  end;

  procedure oculta_cursor;assembler;

  asm

     mov ah,3

     mov bh,0

     int $10

     or ch,$20

     mov ah,1

     int $10

  end;

  procedure muestra_cursor;assembler;

  asm

    mov ah,3

    mov bh,0

    int $10

    and ch,not $20

    mov ah,1

    int $10

  end;

  procedure menugeneral;

  begin

      TextBackground(0);

      clrscr;

      salir := false;

      opcion := 1;

      yo := 2;

      xo := 4;

      ejecuta := false;

      window(1,1,79,24);

      cont := 0;

     repeat

      varramenu(xo,yo,opcion);

      repeat

      gotoxy(62,2);write(toma_hora);

      oculta_cursor;

      until keypressed;

      tecla := readkey;

      muestra_cursor;

      if tecla = #77 then

      begin

         opcion := opcion + 1;

         if opcion > 4 then

         opcion := 4;

      end;

      if tecla = #75 then

      begin

          opcion := opcion - 1;

         if opcion < 1 then

         opcion := 1;

      end;

    if tecla = #13 then

    begin

        ejecuta := true;

    end;

   case opcion of

  1 : begin

        xo := 4;

        if ejecuta = true then

        begin

          cargaarchivo;

          ejecuta := false;

          clrscr;

          window(1,1,79,24);

        end;

      end;

  2 : begin

        xo := 14;

        if ejecuta = true then

        begin

          salvaarchivo(cont,texto);

          ejecuta := false;

          clrscr;

          window(1,1,79,24);

        end;

      end;

  3 : begin

         xo := 24;

         if ejecuta = true then

         begin

          editartexto;

          ejecuta := false;

          clrscr;

          window(1,1,79,24);

         end;

      end;

  4 : begin

         xo := 34;

         if ejecuta = true then

         begin

            salir := true;

            window(1,1,79,24);

         end;

      end;

    end;

      varramenu(xo,yo,opcion);

      until salir = true;

  end;

  begin

     menugeneral;

  end.

program arraymatriz;

  uses

     crt;

   var

      numeros : array[1..10] of integer; (un array de numeros enteros)

      matriz2 : array[1..6,1..10] of integer; (matriz de numeros enteros)

      matriz3 : array[1..3,1..4,0..1] of integer;(matriz de numeros enteros)

      i, s, p : integer; (apuntadores a las posiciones de las matriz y array)

   begin

      clrscr;

      for i := 1 to 10 do  (for para cargar el array)

      numeros[i] := 10 * i; (numero a cagar)

      for i := 1 to 6 do    (for para la matriz2 primera 1 a 6)

        for s := 1 to 10 do (for para la matriz2 segunda 1 a 10)

        begin

           matriz2[i,s] := 5 * s + i; (numero a cargar)

        end;

      for i := 1 to 3 do   (for matriz3 primero 1 a 3)

        for s := 1 to 4 do (for matriz3 segundo 1 a 4)

        begin

           for p := 0 to 1 do (for matriz3 tercero 0 a 1)

           matriz3[i,s,p] := 5 * p + s * i; (numero a cargar)

        end;

        writeln('El Array 1 a 10');   (presentamos Contenido Cargado)

        for i := 1 to 10 do

        write('  ',numeros[i]);

        writeln;

        writeln('Pulsa Enter');

        readln;

        writeln('La matriz 1 a 6 de 1 a 10');

        for i := 1 to 6 do

        begin

            for s := 1 to 10 do

            write('  ',matriz2[i,s]);

            writeln;

        end;

        writeln;

        writeln('Pulsa Enter');

        readln;

        writeln('La matriz 1 a 3 de 1 a 4 de 0 a 1');

        for i := 1 to 3 do

        begin

          for s := 1 to 4 do

          begin

             for p := 0 to 1 do

             write('  ',matriz3[i,s,p]);

             writeln;

           end;

           writeln;

           end;

           writeln('Pulsa Enter');

        readln;

   end.

program  memoria;

   uses

      crt;

    var

      memori : longint;

    begin

       clrscr;

       memori := maxavail;

       writeln('   ',memori / 1024:8:2,' Kb el tama¤o mayor libre del heap');

       readln;

    end.

program pequenaajenda;

  uses

    crt;

    type

      regajenda = record  {El registro de la ajenda}

            nombre  : string[40];

            apelli1 : string[40];

            apelli2 : string[40];

            direcci : string[80];

            telefon : word;

            movil   : longint;

            fnacim  : string[10];

          end;

  var

    ajenda : array[1..50] of regajenda; {Un array de registros 50}

    cont   : integer; {Contador del array}

    tecla  : char; {Para la seleccion del menu}

        f  : file of regajenda;  {Para guardar la ajenda}

  function entrada(xp, yp : integer;tip : char; td : integer) : string;

  var

    tre : char;

    dat : string[80];

    ps : integer;

  begin

      entrada := ' ';

      gotoxy(xp,yp);

      ps := 1;

    repeat

    tre := readkey;

    if tip in['n','N'] then

    begin

       if tre in[#48..#57] then

       begin

          dat[ps] := tre;

          dat[0] := chr(ps);

          gotoxy((xp - 1) + ps,yp);write(dat[ps]);

          ps := ps + 1;

          if ps > td then

          ps := td;

       end;

    end;

    if tip in['t','T'] then

    begin

        if tre in[#30..#126,#164,#167] then

        begin

        dat[ps] := tre;

        dat[0] := chr(ps);

        gotoxy((xp - 1) + ps,yp);write(dat[ps]);

          ps := ps + 1;

          if ps > td then

          ps := td;

       end;

      end;

    if tre = #8 then

    begin

       ps := ps - 1;

       if ps < 1 then

       ps := 1;

        dat[0] := chr(ps);

        dat[ps] := ' ';

        gotoxy((xp - 1) + ps,yp);write(dat[ps]);

    end;

    until tre = #13;

    if (tre = #13) and (ps > 1) then

    begin

       entrada := copy(dat,1,ps - 1);

    end;

  end;

procedure mascaraentrada(cual : char);

  begin

      if upcase(cual) = 'E' then

      begin

      gotoxy(3,2);write('*** Entrada Datros Ajenda ***');

      end;

      if upcase(cual) = 'M' then

      begin

      gotoxy(3,2);write('*** Ver Datros Ajenda ***');

      end;

      gotoxy(5,5);write('Nombre           : ');

      gotoxy(5,6);write('1§ Apellido      : ');

      gotoxy(5,7);write('2§ Apellido      : ');

      gotoxy(5,8);write('Direccion        : ');

      gotoxy(5,9);write('N§ Telefon       : ');

     gotoxy(5,10);write('N§ Movil         : ');

     gotoxy(5,11);write('Fecha Nacimiento : ');

  end;

  procedure entrada_datos(h : integer;ne : char);

  var

     fin : boolean;

     tec : char;

      error, co : integer;

      tt : longint;

      tomado : string[80];

  begin

     fin := false;

     clrscr;

     co := h;

   repeat

     mascaraentrada('e');

     ajenda[co].nombre := entrada(24,5,'t',40);

     ajenda[co].apelli1 := entrada(24,6,'t',40);

     ajenda[co].apelli2 := entrada(24,7,'t',40);