program bmpbild256;
uses crt, graph, dos;

type vierfeld = array[1..4] of byte;

var  farbzahl, farbtiefe, xsize, ysize : integer;

procedure bildzeichnen;

  var x, y : integer;

  begin
    randomize;
    for x:=0 to 639 do
      begin
        setcolor(x div 4);
        line(x, 0, x, 479);
      end;
  end;

{$F+}
function DetectVGA256 : Integer;
  begin
    DetectVGA256 := 2;
  end;
{$F-}

procedure Start {Graphik starten};

  var gdinit, gd, gm : integer;

  begin
    gdinit:= Installuserdriver('SVGA256', @DetectVGA256);       {Graphik}
    gd:=detect;
    initgraph(gd, gm, 'd:\tp\tppas1\bgi');
  end;

procedure vierbyte(z: longint; var feld: vierfeld);
  begin
    write(z:8);
    feld[4]:=0;
    feld[3]:=z div 65536;
    feld[2]:=(z mod 65536) div 256;
    feld[1]:=z mod 256;
  end;

procedure ReadDACColor(farbe : integer; var Pal : vierfeld);

type RGBColor  = record
                     R, G, B : byte;
                   end;

var Regs : Registers;
    Pal1 : RGBColor;

  begin
    with Regs do
      begin
        AH := $10;
        AL := $17;
        BX := farbe;
        CX := 1;
        ES := Seg(Pal1);
        DX := Ofs(Pal1);
      end;
    Intr($10, Regs);
    Pal[1]:=Pal1.B*4; Pal[2]:=Pal1.G*4;
    Pal[3]:=Pal1.R*4; Pal[4]:=0;
end;

function mbyte(z: word): byte;
  begin
    mbyte:=z;
  end;

procedure lesezeile(y: integer; P: pointer);

  var x : integer;
      i : byte;
      feld : array[0..1024] of byte;

  begin
    setcolor(0);
    for x:=0 to xsize-1 do
      begin
        feld[x]:=getpixel(x, y);
        if x<10 then putpixel(x, y, 0);
      end;
    move(feld, P^, xsize);
  end;

procedure bildschreiben;

  var feld  : vierfeld;
      i, j  : byte;
      x, y  : integer;
      f     : file;
      P     : pointer;

  begin
    assign(f, 'd:\tp\arbeit\256farb.bmp');
    rewrite(f, 1);
    i:=ord('B'); blockwrite(f, i, 1);
    i:=ord('M'); blockwrite(f, i, 1);
    writeln;
    {write(ord('B'):4, ord('M'):4);}      {Startsymbol}
    vierbyte(54+farbzahl*4+round(xsize)*round(ysize), feld); {Dateigroesse}
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(0, feld);
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(54+farbzahl*4, feld);            {Anz. Zeichen vor Pixelanfang}
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(40, feld);                   {Anz. Zeichen noch bis Farbanfang}
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(xsize, feld);                        {x-Groesse in Pixeln}
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(ysize, feld);                        {y-Groesse in Pixeln}
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(1+round(farbtiefe)*256*256, feld);          {Farbtiefe}
    for i:=1 to 4 do blockwrite(f, feld[i], 1);
    vierbyte(0, feld);                            {auffuellen}
    for j:=1 to 6 do
      begin
        for i:=1 to 4 do blockwrite(f, feld[i], 1);
      end;
    gotoxy(40, 2);
    for j:=0 to 255 do                             {Farbdefinitionen}
      begin
        readDACcolor(j, feld);
        for i:=1 to 4 do blockwrite(f, feld[i], 1);
      end;
    GetMem(P, xsize); { Get memory from heap }
    for y:=0 to ysize-1 do
      begin
        lesezeile(y, P);
        blockwrite(f, P^, xsize);
      end;
    FreeMem(P, xsize);
    close(f);
  end;

begin
  farbzahl:=256;
  farbtiefe:=8;
  xsize:=640;
  ysize:=480;
  start;
  bildzeichnen;
  readln;
  bildschreiben;
  closegraph;
end.