Работа с нетипизированным BMP файлом

{$reference 'System.Drawing.dll'}
uses
  System.Drawing;
begin
  var BMP := System.Drawing.Bitmap.Create(10, 10);
  for var x : Byte := 0 to 9 do
    for var y : Byte := 0 to 9 do
      begin
        var c := System.Drawing.Color.FromArgb((x+y)*2, 255, 0, 0);
        BMP.SetPixel(x, y, c);
      end;
  BMP.Save('GradIcon.bmp', System.Drawing.Imaging.ImageFormat.Bmp);
end.

uses GraphABC;
 
const name = '2.bmp'; 
 
function DWord(n:cardinal; b:array of Byte) := cardinal(b[n]) +
  cardinal(b[n+1]) shl 8 + cardinal(b[n+2]) shl 16 + cardinal(b[n+3]) shl 24;
 
function oWord(n:word; b:array of Byte) := word(b[n]) + word(b[n+1]) shl 8;
 
procedure GetBMP;
begin
  var b := System.IO.File.ReadAllBytes(name);
  //========== BitMapFileHeader (14 байт) ======================================
  WriteLn('BitMapFileHeader (14 байт)');
  // Заголовочные символы Word : bfType = "BM" (0,1)
  var bfType := Chr(b[0]) + Chr(b[1]); WriteLn('bfType=', bfType);
  if bfType <> 'BM' then begin WriteLn('error bfType'); Exit; end;
  // Общий размер файла DWord : bfSize (2,3,4,5)
  var bfSize := DWord(2,b); WriteLn('bfSize=', bfSize);
  if bfSize <> b.Length then begin WriteLn('error bfSize'); Exit; end;
  // Не используется (6,7,8,9)
  // Адрес битового массива DWord : bfOffBits (10,11,12,13)
  var bfOffBits := DWord(10,b); WriteLn('bfOffBits=', bfOffBits);
  //========== BitMapInfoHeader ================================================
  WriteLn('BitMapInfoHeader'); // Не обязательно, но чаще всего 40 байт
  // Размер данной структуры DWord : biSize = 40 (14,15,16,17)
  var biSize := DWord(14,b); WriteLn('biSize=', biSize);
  if biSize <> 40 then begin WriteLn('error biSize'); Exit; end;
  // Ширина растра в пикселях Long : biWidth (18,19,20,21)
  var biWidth := DWord(18,b); WriteLn('biWidth=', biWidth);
  // Высота растра в пикселях Long : biHeigth (22,23,24,25)
  var biHeigth := DWord(22,b); WriteLn('biHeigth=', biHeigth);
  // Должно быть равным 1 - Word : biPlanes (26,27)
  var biPlanes := oWord(26,b); WriteLn('biPlanes=', biPlanes);
  if biPlanes <> 1 then begin WriteLn('error biPlanes'); Exit; end;
  // Бит на пиксел (1,4,8,16,24,32) - Word : biBitCount (28,29)
  var biBitCount := oWord(28,b); WriteLn('biBitCount=', biBitCount);
  if arr(1,4,8,16,24,32).IndexOf(biBitCount) < 0 then begin WriteLn('error biBitCount'); Exit; end;
  // Равно нулю DWord : biCompression (30,31,32,33)
  var biCompression := DWord(30,b); WriteLn('biCompression=', biCompression);
  if biCompression <> 0 then begin WriteLn('error biCompression'); Exit; end;
  // Размер в байтах не сжатого битового массива DWord : biSizeImage (34,35,36,37)
  var biSizeImage := DWord(34,b); WriteLn('biSizeImage=', biSizeImage);
  if biSizeImage <> 0 then begin WriteLn('error biSizeImage'); Exit; end;
  // Разрешение по X в пикселах на метр Long : biXPelsPerMeter (38,39,40,41)
  // Разрешение по Y в пикселах на метр Long : biYPelsPerMeter (42,43,44,45)
  // Количество используемых цветов (0 - все) DWord : biClrUsed (46,47,48,49)
  // DWord : biClrImportant (50,51,52,53)
  WriteLn('----------');
  
  case biBitCount of
    1  : // Двухцветное
      begin
        var adr := 14 + biSize; // Начальный адрес палитры
        WriteLn(adr, ':');
        var c : array of Color;
        SetLength(c, 2);
        for var i := 0 to 2 do
          begin
            c[i] := rgb(b[adr+2], b[adr+1], b[adr+0]);
            WriteLn(b[adr+2], #32, b[adr+1], #32, b[adr+0]);
            adr += 4;
          end;
        adr := bfOffBits; // Начальный адрес изображения
        for var Y := biHeigth-1 downto 0 do
          begin
            var d : Byte := 0;
            var r : Byte := 0;
            var u : Byte := 0;
            var X := 0;
            repeat
              if d = 0 then
                begin
                  d := $80;
                  r := 7;
                  u := b[adr]; adr += 1;
                end;
              PutPixel(200+X, Y, c[(u and d) shr r]);
              r -= 1; d := d shr 1; X += 1;
            until X = biWidth;
            while adr mod 4 <> 2 do
              adr += 1;
          end;
      end;
    8  : // 256 цветов
      begin
        var adr := 14 + biSize; // Начальный адрес палитры
        var c : array of Color;
        SetLength(c, 256);
        for var i := 0 to 255 do
          begin
            c[i] := rgb(b[adr+2], b[adr+1], b[adr+0]);
            adr += 4;
          end;
        adr := bfOffBits; // Начальный адрес изображения
        for var Y := biHeigth-1 downto 0 do
          begin
            var X := 0;
            repeat
              PutPixel(200+X, Y, c[b[adr]]);
              adr += 1;
              X += 1;
            until X = biWidth;
          end;
      end;
    24 : // Без палитры 3 байта
      begin
        var adr := bfOffBits; // Начальный адрес изображения
        for var Y := biHeigth-1 downto 0 do
          begin
            var X := 0;
            repeat
              PutPixel(200+X, Y, rgb(b[adr+2], b[adr+1], b[adr+0]));
              adr += 3;
              X += 1;
            until X = biWidth;
          end;
      end;
    32 : // Без палитры 4 байта
      begin
        var adr := bfOffBits; // Начальный адрес изображения
        for var Y := biHeigth-1 downto 0 do
          begin
            var X := 0;
            repeat
              PutPixel(200+X, Y, rgb(b[adr+2], b[adr+1], b[adr+0]));
              adr += 4;
              X += 1;
            until X = biWidth;
          end;
      end;
  else
    WriteLn('Палитра: ', biBitCount);
  end; // case
end;
 
begin
  GetBMP;
end.