{ Program : BMP Load/Save
  Programer : FARZAD BADILI (FDB@bigfoot.com)
  http://www.inernettrash.com/users/fdb/ }

uses crt,dos,graph;

type bmptype = record
     bftype          : array [1..2] of char;
     bfsize          : longint;
     bfreserved1     : word;
     bfreserved2     : word;
     bfoffbits       : longint;
     bisize          : longint;
     biwidth         : longint;
     biheight        : longint;
     biplanes        : word;
     bbitcount       : word;
     bicompression   : longint;
     bisizeimage     : longint;
     bixpelspermeter : longint;
     biypelspermeter : longint;
     biclrused       : longint;
     biclrimportant  : longint;
end;

var f           : file;
    bmpheader   : bmptype;
    fln         : string;
    rgb         : array [1..1024] of byte;
    r,g,b       : byte;
    img         : Pointer;
    x,y,y2,size : Longint;
    rr,
    adr1,
    adr2,
    count       : word;
    Driver,
    Mode,
    TestDriver,
    n           : Integer;
    image,
    temp1,
    temp2       : ^byte;

 {$F+}
function TestDetect: Integer;
begin
  TestDetect := 1;
end;
 {$F-}

BEGIN
  write ('Enter File Name :');
    readln(fln);
      If fln ='' then halt;
        assign(f,fln);
          reset(f,1);

 If filesize(f) < 2 then
   begin
     erase(f);
       halt;
   end;
(************************** Read .BMP HEADER *******************************)
blockread(f,bmpheader,sizeof(bmpheader),rr);

with bmpheader do
  begin
    writeln(
     bftype,' ',
     bfsize,' ',
     bfreserved1,' ',
     bfreserved2,' ',
     bfoffbits,' ',
     bisize,' ',
     biwidth,' ',
     biheight,' ',
     biplanes,' ',
     bbitcount,' ',
     bicompression,' ',
     bisizeimage,' ',
     bixpelspermeter,' ',
     biypelspermeter,' ',
     biclrused,' ',
     biclrimportant)
  end;
(************************* Install the driver ******************************)
  TestDriver := InstallUserDriver('svga256', @TestDetect);
    Driver :=testdriver;
      mode :=0;
        InitGraph(Driver, mode, 'svga256');
          clrscr;
          setcolor(2);
          outtext('LOADING...');

(************************** Read and Set RGB *******************************)
    blockread(f,rgb,sizeof(rgb),rr);
      n := 0;
      for count := 0 to 255 do
        begin
          b := rgb[n+count+1] shr 2;
          g := rgb[n+count+2] shr 2;
          r := rgb[n+count+3] shr 2;
          setrgbpalette(count,r,g,b);
            n := n+3;
        end;

(**************************  Read Pic. Data  *******************************)
 x    := bmpheader.biwidth;
 y    := bmpheader.biheight;
 y2   := y ;
 size := x*y;

  If y2 mod 2 = 1 then y2 := y2-1;
    y2 := y2 Div 2;

    GetMem(Img,size);
    getmem(temp2,x);
    adr1 := ofs(img^);
    adr2 := ofs(img^)+size-x;
    image := ptr(seg(img^),adr1);
    temp1 := ptr(seg(img^),adr2);

  BlockRead(F,Img^,size);

for n:=1 to y2 do
  begin
    move(image^,temp2^,x);
    move(temp1^,image^,x);
    move(temp2^,temp1^,x);
    adr1 := adr1+x;
    adr2 := adr2-x;
    image := ptr(seg(img^),adr1);
    temp1 := ptr(seg(img^),adr2);
  end;

     {image := ptr($a000,0000);
     move(img^,image^,size);}

    adr1  := ofs(img^);
    adr2  := 0;
    image := ptr(seg(img^),adr1);
    temp1 := ptr($A000,adr2);

for n := 1 to y do
  Begin
    move(image^,temp1^,x);
    adr1 := adr1+x;
    adr2 := adr2+320;
    image := ptr(seg(img^),adr1);
    temp1 := ptr($A000,adr2);
  End;

Freemem(temp2,x);
  FreeMem(Img,size);
(**************************  End Of Program  *******************************)
sound(1000);
  delay(80);
    sound(500);
      delay(80);
        sound(1000);
          delay(80);
            nosound;
repeat until keypressed;
  close(f);
    CloseGraph;
END.