Pascal/Turbo Pascal - operaciones simples con registros en pascal

{Esto puede ayudar}

program color_rgb;

  uses

     crt;

   const

      ext : string[3] = 'BMP';

   type

   camposcabecera = record

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

           tamanobmp : longint;

           reserva1  : word;

           reserva2  : word;

           inicioimag : longint;

        end;

   campoinformacion = record

           tamanocabe : longint;

           tamanox    : longint;

           tamanoy    : longint;

           planoscolor : word;

           bitspixel   : word;

           compresion  : longint;

           tamaimagen  : longint;

           resolucionx : longint;

           resoluciony : longint;

           numerocolor : longint;

           coloresimpo : longint;

        end;

    colorreg = record

           Blue : Byte;

          Green : Byte;

            Red : Byte;

          reser : Integer;

        end;

    regcolor = record

          regazul  : byte;

          regverde : byte;

          regrojo  : byte;

          regreser : byte;

        end;

    paletabmp = array[0..255] of regcolor;

    colorrgb = record

          rojo : byte;

          verde : byte;

          azul : byte;

        end;

    paletargb = array[0..255] of colorrgb;

    var

      f : file;

      comp : string[4];

      infocabe : camposcabecera;

      infoinfo : campoinformacion;

      bmpcol   : paletabmp;

      imagcol  : paletargb;

      byt : array[1..1024] of byte;

      nombre : string;

      colores, resul1, resul2 : word;

      colorespixel : byte;

      valido : boolean;

  procedure cargacabecerayinformeycolor(archi : string);

  begin

     assign(f,archi);

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

     if ioresult <> 0 then

     begin

       writeln('Archivo No Encontrado o Da¤ado pulse [Enter]');

       readln;

       halt(1);

     end

  else

  begin

     blockread(f,infocabe,sizeof(camposcabecera),resul1);

     if (upcase(infocabe.idenbmp[0]) = 'B') and

     (upcase(infocabe.idenbmp[1]) = 'M') then

     begin

     ext := 'BMP';

     blockread(f,infoinfo,sizeof(campoinformacion),resul2);

     if infoinfo.bitspixel <= 8 then

     begin

     blockread(f, bmpcol,infocabe.inicioimag - (resul1 + resul2),colores);

     valido := true;

     end

  else

     valido := false;

     end;

     close(f);

  end;

 end;

 procedure presentadatosbmp(nom : string);

 begin

     cargacabecerayinformeycolor(nom);

     if valido = true then

     begin

     if ext = 'BMP' then

     begin

     clrscr;

     writeln('***** Informacion Archivo *****');

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

     writeln;

     writeln('Tipo De Archivo Es            = ',infocabe.idenbmp[0],

                               infocabe.idenbmp[1],'P');

     writeln('tama¤o cabecera y informacion = ',resul1 + resul2,' Bytes');

     writeln('Inicio Imagen En La Posicion  = ',infocabe.inicioimag,' Bytes');

     colorespixel := infoinfo.bitspixel;

     if infoinfo.bitspixel <= 8 then

     begin

     writeln('Tama¤o Paleta de color        = ',infocabe.inicioimag -

                                               (resul1 + resul2),' Bytes');

     writeln('Los Colores De La Paleta Son  = ',

               (infocabe.inicioimag - (resul1 + resul2)) div 4,' colores');

     end

  else

     writeln('Los Colores De La Paleta Son  = ',infoinfo.bitspixel);

     writeln('Los Planos De Color Son       = ',infoinfo.planoscolor);

     writeln('Tama¤o Del Archivo Total      = ',infocabe.tamanobmp,' Bytes');

     writeln('Tama¤o De La Imagen           = ',infoinfo.tamaimagen,' Bytes');

     writeln('Longitud  De X                = ',infoinfo.tamanox,' Pixeles');

     writeln('Longitud  De Y                = ',infoinfo.tamanoy,' Pixeles');

     case infoinfo.compresion of

   0 : comp := 'No';

   1 : comp := 'RLE8';

   2 : comp := 'RLE4';

    end;

     writeln('Compresion                    = ',comp);

     writeln('Resoluccion X                 = ',infoinfo. resolucionx);

     writeln('Resoluccion y                 = ',infoinfo. resoluciony);

     writeln('Numero Colores De La Imagen   = ',infoinfo.numerocolor);

     writeln('Numero De Colores Importantes = ',infoinfo.coloresimpo);

     writeln;

     writeln('***** Pulse [Enter] *****');

     readln;

     end;

   end

 else

    begin

       writeln('   Colores 24 bit ');

       readln;

    end;

 end;

 begin

    clrscr;

    writeln('   Entre Camino Y Nombre De Archivo BMP No Extension');

    writeln;

    write('  Entre Nombre : ');

    readln(nombre);

    presentadatosbmp(nombre + '.' + ext);

 end.