Pascal/Turbo Pascal - registro de datos

{A ver si esto te ayuda}

program registro;

  uses

     crt;

   type

      datoimagen = record

             idenbmp : array[0..1] of char;

             tamanobmp : longint;

             reserva1  : word;

             reserva2  : word;

             inicioimag : longint;

             tamanocabe : longint;

             tamanox    : longint;

             tamanoy    : longint;

             planoscolor : word;

             bitspixel   : word;

             compresion  : longint;

             tamaimagen  : longint;

             resolucionx : longint;

             resoluciony : longint;

             numerocolor : longint;

             coloresimpo : longint;

             infor       : longint;

             codigo : longint;

          end;

   var

     regdato : file of datoimagen;

     dato : datoimagen;

   procedure guarda_datos_imagen(d : datoimagen);

   begin

      assign(regdato,'datimage.img');

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

   if ioresult <> 0 then

   begin

       rewrite(regdato);

       seek(regdato,0);

       write(regdato,d);

       close(regdato);

   end

 else

    begin

       seek(regdato,filesize(regdato));

       write(regdato,d);

       close(regdato);

    end;

   end;

   procedure tomada_datos;

   var

     bytes_per_raster : longint;

     raster_pad : integer;

     x, y, x1, y1 : longint;

     l : Byte;

     intx, inty : longint;

     da : datoimagen;

   begin

      fillchar(da,sizeof(da),0);

      x := 10;

      x1 := 200;

      y := 4;

      y1 := 100;

      bytes_per_raster := (X1 - X + 1) * 3;

      if bytes_per_raster mod 4 = 0 then

        raster_pad := 0

      else

        raster_pad := 4 - (bytes_per_raster mod 4) ;

      bytes_per_raster := bytes_per_raster + raster_pad;

      da.idenbmp[0] := 'B';

      da.idenbmp[1] := 'M';

      da.reserva1 := 0;

      da.reserva2 := 0;

      da.inicioimag := 0;

      da.tamanocabe := 14;

      da.tamanox := x;

      da.tamanoy := y;

      da.planoscolor := 1;

      da.bitspixel := 24;

      da.compresion := 0;

      da.tamaimagen := bytes_per_raster * da.tamanox;

      da.resolucionx := 0;

      da.resoluciony := 0;

      da.numerocolor := 0;

      da.coloresimpo := 0;

      da.infor := 40;

      da.codigo := 2714;

      guarda_datos_imagen(da);

   end;

   procedure presenta_datos;

   var

     i, codi : longint;

     f : file of datoimagen;

     encont : boolean;

   begin

      clrscr;

      writeln('  ***** Presentacion Datos Por Codigo ****');

      writeln;

      write('   Entre Codigo : ');

      readln(codi);

      encont := false;

      assign(f,'datimage.img');

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

   if ioresult <> 0 then

   begin

      writeln('  Error De Archivo O No Existe Pulse Una Tecla');

      readkey;

   end

  else

     begin

        for i := 0 to filesize(f) - 1 do

        begin

        seek(f,i);

        read(f,dato);

        if dato.codigo = codi then

        begin

           encont := true;

           break;

        end;

      end;

       if encont = true then

       begin

          clrscr;

          writeln('  **** Los Datos Del Codigo Entrado Son ****');

          writeln;

          writeln('  Codigo             : ',dato.codigo);

          writeln('  Iden 1             : ',dato.idenbmp[0]);

          writeln('  Iden 2             : ',dato.idenbmp[1]);

          writeln('  Reservado          : ',dato.reserva1);

          writeln('  Reservado          : ',dato.reserva2);

          writeln('  Tama¤o Cavecera    : ',dato.tamanocabe);

          writeln('  Tama¤o X           : ',dato.tamanox);

          writeln('  Tama¤o Y           : ',dato.tamanoy);

          writeln('  Plano Color        : ',dato.planoscolor);

          writeln('  Bit Por Pixel      : ',dato.bitspixel);

          writeln('  Compresion         : ',dato.compresion);

          writeln('  Tama¤o image       : ',dato.tamaimagen);

          writeln('  X Pixel Metro      : ',dato.resolucionx);

          writeln('  Y Pixel Metro      : ',dato.resoluciony);

          writeln('  Colores usad.      : ',dato.numerocolor);

          writeln('  Colores Imp.       : ',dato.coloresimpo);

          writeln('  Tama¤o Informacion : ',dato.infor);

          writeln('  Total Cavecera Y Informacion = ',

                     sizeof(datoimagen) - 8,' Bytes');

          writeln;

          writeln('    Pulse Una Tecla ');

          readkey;

       end

     else

        begin

          clrscr;

          writeln('   Error Codigo No Encontrado Pulse Una Tecla ');

          readkey;

        end;

     end;

   end;

  begin

      tomada_datos; {Esto tendrias que realizerlo con entrada manual o}

                    {por Cartura de los datos corresponde a un BMP}

      presenta_datos; {Recojo datos del archivo y los presento}

      erase(regdato); {Borro Archivo}

                      {Esto Es un Ejemplo normal mente no es asi

                       las imagenes se cargan con blockread y no

                       con seek y read estos archivos suelen tener

                       toda la informacion y imagen y son uno solo}

  end.