(* Ukazkovy priklad na prohlizeni BMP obrazku *)
(* Pro int21h napsal BOby v roce 2006         *)

program BMP_reader;

uses crt; {Pouzivam z nej readkey}

type TBMPHeader=record
  ID:array[1..2] of char;{BM - windows bitmap}
  filesize:longint; {Velikost BMP souboru}
  reserved1:longint; {Prvni rezervovane data}
  bof:longint;{Offset na kterem zacinaji obrazova data}
  head_length:longint; {Velikost hlavicky (vzdycky stejna)}
  width:longint; {Sirka obrazku v pixelech}
  height:longint; {Vyska obrazku v pixelech}
  planes:word; {Pocet bitovych rovin 1=monochromaticka (bitova)
                                     4=16 barev}
  bpp:word;{Bitu na pixel (2^bpp=barevna hloubka)}
  compression:longint;{0=zadna,1=RLE 8-bit/Pixel,2=RLE 4-bit/Pixel}
  pictsize:longint; {Velikost obrazovìch dat (WIDTH*HEIGHT/BPP)}
  hres,vres:longint;{Horizontalni a vertikalni rozliseni (rastry v osach x a y)}
  color_used:longint;{Kolik je pouzito barev}
  import_colors:longint; {Dulezite barvy (nechapu)}
 end;


 TRGBQuad=record
  B,G,R,reserved:byte;
 end;
 TPixelBGR=record {Jedna barva z 24b obrazku}
  b,g,r:byte;
 end;

var head:TBMPHeader;
    F:file;
    filename:string[12];
    error,i:byte;
    showinfo:boolean;

function pow(x,n:integer):integer;
var i:byte;
    f:integer;
begin
 {Vypocita x^n}
 f:=1;
 for i:=1 to n do
  f:=f*x;
 pow:=f;
end;

(* Procedury pro praci s modem $13 *)
(*    Muzete nahradit vlastnimi    *)
procedure InitGraph;assembler;
asm
 mov ax,0013h {00=funkce na zmenu modu;13h=320x200x256}
 int 10h
end;
procedure CloseGraph;assembler;
asm
 mov ax,0003h {03h=80x25x16}
 int 10h
end;
procedure setcolor(i,r,g,b:byte);
begin
 {Nastaveni barvy pres port.
  Je to rychlejsi nez pres preruseni}
 port[$3c8]:=i;
 port[$3c9]:=r;
 port[$3c9]:=g;
 port[$3c9]:=b;
end;

procedure putpixel(x,y:word;c:byte);
begin
 {Zapis barvu do obrazove pameti. Proste putpixel}
 mem[segA000:x+y*320]:=c; { $a000=Video pamet pro mod $13}
end;

function getbit(dec,i:byte):byte;
var tmp:integer;
    x:byte;
    i2:byte;
begin
 tmp:=dec;
 x:=0;
 i2:=0;
 repeat
  inc(i2);
  if i2=i then
   x:=(tmp mod 2);
  tmp:=tmp div 2;
 until (tmp=0);
 getbit:=x;
end;


{***********************}
{*    Hlavni funkce    *}
{***********************}
function show_bmp(posx,posy:word;filename:string):byte;
var F:file;
    x,y,x1,y1,i:word;{Citace}
    color:TRGBQuad;  {Jedna barva}
    head:TBMPHeader; {Hlavicka}
    pixbgr:TPixelBGR;{Jedna barva z 24b obrazku}
    pixel:byte;      {Jeden pixel ze souboru}
    n1:integer;      {Obsahuje kolik je na radku nibblu}
    filewidth:word;

begin
 Assign(F,filename);
 {$I-}
 Reset(F,1);
 {$I+}
 if (IOResult<>0) then
  begin
   show_bmp:=1; {1=Dosova chyba}
   exit;
  end;

 blockread(F,head,sizeof(TBMPHeader));

 if ((head.bpp>24) or (head.ID<>'BM')) then
  begin
   show_bmp:=2; {2=Nepodporovany format}
   exit;
  end;

 if ((head.bpp=1) or (head.bpp=8) or (head.bpp=4)) then
  for i:=0 to pow(2,head.bpp)-1 do
   begin
    blockread(F,color,sizeof(TRGBQuad));
    setcolor(i,color.r div 4,color.g div 4,color.b div 4);
   end;
 if (head.bpp=24) then {Pro 16M obrazky se paleta musi prevadet do 256-barevne }
  for i:=0 to 255 do
   begin
    {Tohle nemuzu popsat protoze to neni z moji hlavy}
    setcolor(i,(i and 7)*8+7,((i shr 3) and 7)*8+7,(i shr 6)*16+15);
   end;

 {*              HLAVNI ROZKODOVANI DAT               *}
 {*         Podporu pro 16M napsal Boris Valejo       *}
 {*          Jinak je vsechno ma tvrda prace :)       *}

 if (head.bpp=1) then {2-BAREVNE OBRAZKY}
 begin
  x:=posx;
  y:=posy+head.HEIGHT;

  n1:=(head.WIDTH div 8);{Kolik je pixelu na radku}
  if ((head.WIDTH mod 8)<>0) then
   inc(n1,3);

  for y1:=1 to head.HEIGHT do
   begin
    for x1:=1 to n1 do
     begin
      blockread(F,pixel,sizeof(pixel));
      if (x<head.WIDTH) then
       for i:=1 to 8 do
        begin
         putpixel((x1*8+i)+posx-9,y+posy,getbit(pixel,9-i));{9-i = obraceni bitu}
         inc(x);
        end;
      end;
     x:=posx;
     dec(y);
   end;
 end;{Konec 16}

 if (head.bpp=4) then {16-BAREVNE OBRAZKY}
 begin
  x:=posx;
  y:=posy+head.HEIGHT;

  n1:=(head.WIDTH div 8)*4; {Kolik barev nibblu je na radku}
                            {Pozor neni to to same jako WIDTH div 2 (zaokrouhlovani)}
  if ((head.WIDTH mod 8)<>0) then
   inc(n1,4);

  for y1:=1 to head.HEIGHT do
   begin
    for x1:=1 to n1 do
     begin
      blockread(F,pixel,sizeof(pixel));
      if (x<head.WIDTH) then
       begin
        putpixel(x,y,pixel div 16);{Vyssi nibble (4 bity) z bytu}
        inc(x);
       end;
      if (x<head.WIDTH) then
       begin
        putpixel(x,y,pixel mod 16);{Nizsi nibble z bytu}
        inc(x);
       end;
      end;
     x:=posx;
     dec(y);
   end;
 end;{Konec 16}

 if (head.bpp=8) then {256-BAREVNE OBRAZKY}
  begin
   filewidth:=((head.WIDTH+3) div 4)*4;
   for y:=head.HEIGHT-1 downto 0 do
    begin
     seek(F,head.BOF+filewidth*(head.HEIGHT-Y-1));{Preskoc v souboru na linku Y}
     for x:=0 to n1-1 do
      begin
       blockread(F,pixel,sizeof(pixel));
       putpixel(x+posx,y+posy,pixel);
      end;
    end;
  end;{Konec 256}

 if (head.bpp=24) then {16M-BAREVNE OBRAZKY}
  begin
   FileWidth:=((head.WIDTH*3+3) div 4)*4;
   for y:=head.HEIGHT-1 downto 0 do
    begin
     seek(F,head.BOF+filewidth*(head.HEIGHT-Y-1));{Preskoc v souboru na linku Y}
     for x:=0 to head.WIDTH-1 do
      begin
       blockread(F,pixbgr,sizeof(pixbgr));
       pixel:=pixbgr.r shr 5+((pixbgr.g shr 5) shl 3)+(pixbgr.b and 192);
       putpixel(x+posx,y+posy,pixel);
      end;
    end;
  end;{Konec 16M}
 Close(F);
 show_bmp:=0;
end;


Begin
 if (paramcount=0) then
  begin
   writeln('BitmapViewer');
   writeln('Ussage: ',paramstr(0),' [-i] bitmap.bmp');
   writeln;
   writeln('Supported 2,16,256,16M-colored pictures');
   halt(0);
  end;
 for i:=1 to paramcount do
   if (copy(paramstr(i),1,1)='-') then
    if (copy(paramstr(i),2,1)='i') then
     showinfo:=true
    else
     writeln('Bad parameter!')
   else
    filename:=paramstr(i);

 if showinfo then
 begin
  Assign(F,filename);
  {$I-}
  Reset(F,1);
  {$I+}
  if (IOResult<>0) then
   begin
    writeln('File not found!');
    exit;
   end;

  blockread(F,head,sizeof(TBMPHeader));
  writeln;
  writeln('BitmapViewer v0.9');
  writeln('INFO');
  with head do
  begin
   writeln('Filename: ',filename);
   writeln('File size: ',filesize);
   writeln('Width: ',width);
   writeln('Height: ',height);
   writeln('Number of colors: ',pow(2,bpp));
  end;
  readkey;
  Close(F);
 end;

 InitGraph;
 error:=show_bmp(0,0,filename);
 if (error=0) then
  begin
   readkey;
   CloseGraph;
   writeln('Done.');
  end
 else
  begin
   CloseGraph;
   case error of
    1:writeln('File not found!');
    2:writeln('Unsupported format! '+
         'Supported color depths: 2,16,256,16M');
   end;
  end;
End.