{ *** SHOW ME YOUR BMP by Nail ***}
{wymaga ustawienia trybu 13h (320*200*256) i obrazka tej wielkosci
 w programie trzeba uzywac unitu DOS}
{wywolanie image2('cos.bmp')}
{ta procedura jest dosc uniwersalna (rozne wielkosci, itd) ale przez to
troche wolniejsza mozna ja dostowowac do innej rozdzeilczosci ale
do gry lepiej uzywac 320*200 i troche przyspieszyc dzialanie por. bezposr.
dostep do pamieci i wtedy mozna zmniejszyc rozmiar tablicy}
{przy 320*200 uproscic rysowwanie:
var
   p:pointer;
   wsk_tab:array[0..64000] of byte;
p:=ptr($a000,0);
move(wsk_tab,p^,64000);
to powinow natychmiast narysowac obrazek
}
procedure image2(s:String);

type
    linia=array[0..639] of byte;
    tab=array[0..400] of ^linia; {wirtualna tablica 640*480 mozna zmiejszyc}
var
   p:pointer;
   skala:byte;
   f:File;
   wsk:^tab;
   w:Word;
   x,y:integer;
   c:char;
   px,py,mx,my:integer;
procedure pal;         {ustawiwa palete kolorow}
var
   pal2:array[0..255,1..4] of byte;
   pal:array[0..255,1..3] of byte;
   b,b2:Byte;
   regs:registers;
begin
seek(f,0);
seek(f,filepos(f)+53); {pomin naglowek pliku}

    blockread(f,pal2,sizeof(pal2));
     for b:=0 to 255 do begin                   {w pliku BMP kolory sa troche obrocone }
         pal[b,1]:=pal2[b,3] div 4;
         pal[b,2]:=pal2[b,4] div 4;
         pal[b,3]:=pal2[b,2] div 4;
         if pal2[b,1]<>0 then sound(100);    {sygnalizacja bledu mozna skasowac}
                         end;

 with regs do begin {korzystamy z funcji BIOSU bo Pascal potrafi ustawic tylko 16 kol}
    AX := $1012;
    BX := 0;
    CX := 255;
    ES := Seg(pal);
    DX := Ofs(pal);
    Intr($10, Regs);
        end;
   for b:=0 to 255 do setpalette(b,b); {poprawia jakosc nie wiem dlaczego}
end;
begin

     assign(F,s);
     {$i-}
     reset(F,1);  {otworz plik}
     if ioresult<>0 then begin
     closegraph;
        writeln('Bˆ¥d otwarcia pliku:',s);
        halt(0);
                         end;
     {$i+}
     new(wsk);                 {wczytaj plik do tablicy}
     for y:=0 to 400 do begin
              new(wsk^[y]);
     for x:=1 to 640 do wsk^[y]^[x]:=0;
                        end;
     seek(F,18);
     blockread(f,mx,2); {odczytaj wymiary x}
     seek(F,22);
     blockread(F,my,2); {i y}
     seek(F,53);
     pal;


     if my>400 then begin    {nie potrafi wiecej known limitation}
        write(^g);
        py:=400
                    end
     else py:=my; {jsli z aduzy plik to pokazuje tylko fragment}

     if mx>640 then begin
        write(^g);
        px:=sizeof(wsk^[1]^);

                    end
     else px:=mx; {jw}

 for y:=py-1 downto 0 do  {obrazek w BMP jest do gory nogami downto}
                          {wczytuje plik do pamieci}
    if filepos(f)+px<filesize(f) then blockread(F,wsk^[y]^,px);
    repeat
        x:=1;
          repeat       {pokaz linie mozna to przyspieszyc uzywajac bezposr.
                       dostepu do pamieci zamiast putpixel}
                putpixel(x,y,wsk^[y]^[x]);
                inc(X);
          until x=px;

        inc(y); {nastepna linia}
    until (y=px) or (y=getmaxy); {zakoncz jesli sie nie miesci lub caly pokazany}

 for y:=0 to 400 do dispose(wsk^[y]); {zwolnij pamiec}
end;