unit uBMP;

interface

const
  cWidth=1280;
  cHeight=1024;

type
  TRGB=record
    r,g,b: byte;
  end;
  TPal=array[0..255] of TRGB;

  PLine=^TLine;
  TLine=array[0..cWidth-1]of byte;

  PRect=^TRect;
  TRect=array[0..cHeight-1]of PLine;

  TBMP=object
  private
    constructor Create(w,h: LongInt);
    procedure LoadData(var f: file; dWidth, dHeight: longint; BitCount, Compression: word);
    procedure LoadMS(var f: file);
    procedure LoadOS2(var f: file);
  public
    width,height: LongInt;
    pal: TPal;
    pic: PRect;
    destructor Destroy;
    procedure LoadFromFile(fn: string);
  end;

implementation



type
  TBMPFileHeader=record
    ID: array[0..1] of char;
    Size: longint; { * 4  of file }
    Reserved: longint; { = 0 }
    Offset: longint;
  end;

  TmsBMPInfoHeader=record
    Size: longint; { of TBMPInfoHeader ( = 40 ) }
    Width: longint;
    Height: longint;
    Planes: word; { = 1 }
    BitCount: word;
    Compression: longint; { 0: RGB, 1: RLE8, 2: RLE4 }
    SizeImage: longint; { of Image }
    XPelsPerMeter: longint;
    YPelsPerMeter: longint;
    ColorUsed: longint;
    ColorImportant: longint;
  end;

  TBGRA=record
    b,g,r,a: byte;
  end;

  TmsBMPInfo=record
    Header: TmsBMPInfoHeader;
    Colors: array[byte] of TBGRA;
  end;


  Tos2BMPInfoHeader=record
    Size: longint; { of Tos2BMPHeader ( = 12 ) }
    Width: word;
    Height: word;
    Planes: word; { = 1 }
    BitCount: word;
  end;

  TBGR=record
    b,g,r: byte;
  end;

  Tos2BMPInfo=record
    Header: Tos2BMPInfoHeader;
    Colors: array[byte] of TBGR;
  end;


constructor TBMP.Create(w,h: LongInt);
var
  i: LongInt;
begin
  if (pic<>nil) then Destroy;
  if (w>cWidth)or(h>cHeight) then exit;

  GetMem(pic,4*Height);
  for i:=0 to height-1 do
    GetMem(pic^[i],width);
end;

destructor TBMP.Destroy;
var
  i: LongInt;
begin
  if (pic=nil) then exit;

  for i:=0 to height-1 do
    FreeMem(pic^[i],width);
  FreeMem(pic,4*height);

  pic:=nil;
end;

procedure TBMP.LoadData(var f: file; dWidth, dHeight: longint; BitCount, Compression: word);
var
  y: LongInt;
  r: word;
begin
  if (BitCount<>8)or(Compression>0) then
    exit;

  Create(Width,Height);

  for y:=Height-1 downto 0 do
    BlockRead(f,pic^[y]^[0],Width,r);
end;

procedure TBMP.LoadMS(var f: file);
var
  Info: TmsBMPInfo;
  r: word;
  i,z: longint;
begin
  Info.Header.Size:=40;

  blockread(f,Info.Header.Width,sizeof(TmsBMPInfoHeader)-4,r);

  if (Info.Header.BitCount<=8) then
  begin
    if (Info.Header.ColorUsed=0) then
      z:=1 shl Info.Header.BitCount
    else
      z:=Info.Header.ColorUsed;

    blockread(f,Info.Colors,z*sizeof(TBGRA),r);

    for i:=0 to z-1 do
    begin
      pal[i].r:=Info.Colors[i].r shr 2;
      pal[i].g:=Info.Colors[i].g shr 2;
      pal[i].b:=Info.Colors[i].b shr 2;
    end;
    fillchar(pal[z].r,3*(256-z),0);
  end;

  LoadData(f,Info.Header.Width,Info.Header.Height,Info.Header.BitCount,Info.Header.Compression);
end;

procedure TBMP.LoadOS2(var f: file);
var
  Info: Tos2BMPInfo;
  r: word;
  i,z: longint;
begin
  Info.Header.Size:=12;

  blockread(f,Info.Header.Width,sizeof(Tos2BMPInfoHeader)-4,r);

  if (Info.Header.BitCount<=8) then
  begin
    z:=1 shl Info.Header.BitCount;

    blockread(f,Info.Colors,z*sizeof(TBGR),r);

    for i:=0 to z-1 do
    begin
      pal[i].r:=Info.Colors[i].r shr 2;
      pal[i].g:=Info.Colors[i].g shr 2;
      pal[i].b:=Info.Colors[i].b shr 2;
    end;
    fillchar(pal[z].r,3*(256-z),0);
  end;

  LoadData(f,Info.Header.Width,Info.Header.Height,Info.Header.BitCount,0);
end;

procedure TBMP.LoadFromFile(fn: string);
var
  Header: TBMPFileHeader;

  r: word;
  z: longint;

  f: file;

begin
  assign(f,fn);
  reset(f,1);

  blockread(f,Header,sizeof(TBMPFileHeader),r);

  if (Header.ID[0]='B')and(Header.ID[1]='M') then
  begin
    blockread(f,z,4,r);

    if (z=12) then
    begin
      LoadOS2(f);
    end;

    if (z=40) then
    begin
     LoadMS(f);
    end;
  end;

  close(f);
end;

end.
-------------------
Subject:        Bitmap Unit
   Date:        Thu, 25 Jun 1998 23:46:08 +0200
   From:        bj 
     To:        Franz Glaser 

Hallo,
wie gewünscht ist hier meine Bitmap-Unit,
in diesem Entwicklungsstadium kann sie allerdings nur 8Bit
Bilder, ohne Kompression, im MS und OS2 Format laden.

Die Funktionsweise ist schnell erklärt, man ruft die Prozedur
LoadFromFile vom Objekt TBMP auf und hat danach in den
Variablen pal und pic die Palette und die Bilddaten des
Bitmap und kann mit diesen machen was man will..

Wenn sie Unit veröffentlichen oder sie Ihnen weitergeholfen
hat würde ich mich über eine weitere Mail freuen, auch um
eventuelle Verbesserungen an der Unit an Sie weiterzugeben.

MfG
    Björn Rohreit
-------------------------------------------------------------

    Source: geocities.com/~franzglaser/tpsrc

               ( geocities.com/~franzglaser)