Os mostramos el código fuente/source code de una utilidad que obtiene la información de un fichero BMP (Bitmap file): tamaño (bytes), ancho (píxeles), alto (píxeles), profundidad de color (bits):

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, shellapi;

type
  TformMenuPrincipal = class(TForm)
    bInfo: TButton;
    txtFichero: TEdit;
    txtPropiedades: TMemo;
    bSel: TButton;
    dlAbrir: TOpenPictureDialog;
    LWEB: TLabel;
    procedure bInfoClick(Sender: TObject);
    procedure bSelClick(Sender: TObject);
    procedure LWEBClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

implementation

{$R *.dfm}

procedure propiedadesBMP (fichero : string; var tamano : integer; 
    var ancho : integer; var alto : integer; var profundidadColor : integer);
var
  ficheroEncabezado: TBitmapfileheader;
  infoEncabezado: TBitmapinfoheader;
  sFichero  : TFilestream;
begin
  sFichero := TFilestream.Create(fichero, fmOpenRead);
  sFichero.Read(ficheroEncabezado, SizeOf(ficheroEncabezado));
  sFichero.Read(infoEncabezado, SizeOf(infoEncabezado));
  sFichero.Free;
  tamano := ficheroEncabezado.bfSize;
  ancho := infoEncabezado.biWidth;
  alto := infoEncabezado.biHeight;
  profundidadColor := infoEncabezado.biBitCount;
end;

procedure TformMenuPrincipal.bInfoClick(Sender: TObject);
var
  profundidadColor, ancho, alto, tamano : integer;
begin
  if FileExists(txtFichero.Text) then
  begin
    propiedadesBMP(txtFichero.Text, tamano, ancho, alto, profundidadColor);
    txtPropiedades.Lines.Clear;
    txtPropiedades.Lines.Add(txtFichero.Text);
    txtPropiedades.Lines.Add('Tamaño: ' + IntToStr(tamano) + ' bytes');
    txtPropiedades.Lines.Add('Ancho: ' + IntToStr(ancho) + ' píxeles');
    txtPropiedades.Lines.Add('Alto: ' + IntToStr(alto) + ' píxeles');
    txtPropiedades.Lines.Add('Profundidad de color: ' + IntToStr(profundidadColor) + ' bits');
  end;
end;

procedure TformMenuPrincipal.bSelClick(Sender: TObject);
begin
  if dlAbrir.Execute then
  begin
    txtFichero.Text := dlAbrir.FileName;
    bInfoClick(Self);
  end;
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

end.

Publicado el: 2005-08-27