Эта статья про то, что собой представляет графический формат BMP. Хоть это и один из простых форматов, но из-за того, что существует много вариаций этого формата, то не все моменты очевидны.

В этой части попробуем написать программу, работающую с BMP файлами.

Как вы знаете, несжатые битмапы занимают на диске достаточно много места, особенно много занимают изображения в формате 24 бита на пиксель. Фотографии сжимают в jpeg.
Однако такие изображения как чертежи и графики сжимать с потерями, конечно, нельзя.
Очень хорошее сжатие без потерь дает формат png (в настоящее время он очень распространен). Это довольно сложный формат и в рамках этой статьи не рассматривается. Оказывается, некоторые изображения можно в несколько раз уменьшить в размерах не прибегая к другим форматам, а просто уменьшив число байт занимаемых одним пикселем. Многие, наверное, пробовали сохранять изображение True Color в формате 256 цветов – результат жуткое искажение цвета, даже если действительное число цветов не превышало 256. Дело в том, что программы типа Microsft Paint создают свою собственную палитру на 256 цветов и интерполируют исходное изображение при помощи имеющихся цветов. Метод, конечно, универсальный, но совершенным его не назовешь.
Эта программа будет считать количество цветов реально использованных в изображении и если их число не более 256, то создавать новый палитровый битмап с числом цветов 2, 16, 256 – в зависимости от числа использованных цветов. Чтобы сделать программу еще более универсальной, я добавил поддержку беспалитровых изображений не только на 24 бита на пиксель, но и 16 и 32. Как показал мой печальный опыт изображения в формате 16 бит на пиксель не могут быть однозначно прочтены, поскольку программы обычно не оставляют ни каких заметок (хотя MSDN этого требует) какую схему цветов они использовали (5-5-5 или 5-6-5). По умолчанию принимается старый формат 5-5-5. Кроме того введена нестрогая проверка цветов – если хоть один цвет в палитре имеет значение, превышающее 2 в 15 степени, то такое изображение рассматривается по схеме 5-6-5. Буду очень благодарен тому, кто расскажет, как более строго можно отличить такие форматы.

Код снабжен подробными комментариями, а потому дальнейшее описание думаю будет лишним.
 

 

 

type

//Более удобный эквивалент оригинальной структуры
TBitMapFileHeader = packed record
bfType: array[0..1] of Char;
bfSize: DWORD;
bfReserved1: Word;
bfReserved2: Word;
bfOffBits: DWORD;
end;

PBitMapFileHeader = ^TBitMapFileHeader;

PBitmapInfoHeader = ^TBitmapInfoHeader;

TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Image1: TImage;
Button2: TButton;
Label3: TLabel;
Bevel1: TBevel;
OpenPictureDialog1: TOpenPictureDialog;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FH : PBitMapFileHeader;
BIH : PBitmapInfoHeader;
Palette : array[0..255] of Cardinal; //Цветовая палитра
NColors : integer; //Число цветов битмапа
OldDelta : Integer; //Число байт необходимых для выравнивания
bmp : TFileStream; //на границу 4х байт исходного битмапа
mem : TMemoryStream;
memResult : TMemoryStream;
Function TestBmp(IgnoreNonCritical : Boolean) : Integer;
//Проверка на пригодность битмапа
procedure Convert(oldFH : TBitMapFileHeader;
oldBIH : TBitmapInfoHeader);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
uses math;

Const
NoError = 0; //Коды ошибок возможных при загрузке битмапа
FileReadError = 1;
OS2BMP = 2;
UnknownBitmap = 3;
PossibleCorrupt = 4;
PossibleExtended = 5;
CompressedBitMap = 6;
NotHighOrTrueColor = 7;
MoreThan256Colors = 8;

//Проверка Заголовка TBitmapInfoHeader на правильность
//и битмапа на пригодность к сжатию без потерь
Function TestInfoHeader(Header : TBitmapInfoHeader) : Integer;
Begin
Result := NoError;

if Header.biPlanes <> 1 //число плоскостей должно быть равно единице
then
Begin
Result := UnknownBitmap;
exit;
end;
//Проверка действительно ли High или True Color
if not (Header.biBitCount in [16, 24, 32])
then
Begin
Result := NotHighOrTrueColor;
exit;
end;
//Проверка действительно ли несжатое изображение
if not (Header.biCompression in [BI_RGB, BI_BITFIELDS])
then
Begin
Result := CompressedBitMap;
exit;
end;
end;

//Тестируем битмап(целиком) на пригодность
Function TForm1.TestBmp(IgnoreNonCritical : Boolean) : Integer;
var
HSize : DWORD;

Begin
Result := NoError;
bmp := TFileStream.Create(OpenPictureDialog1.FileName, fmOpenRead);
bmp.Seek(0, soFromBeginning);
Try
GetMem(FH, SizeOf(TBitMapFileHeader)); //Выделяем память под структуру
//файлового заголовка
bmp.ReadBuffer(FH^, SizeOf(TBitMapFileHeader)); //Читаем заголовок

if (FH.bfType = 'BA') or //Проверяем не является ли битмап
(FH.bfType = 'CI') or //битмапом стандарта OS/2
(FH.bfType = 'CP') or
(FH.bfType = 'IC') or
(FH.bfType = 'PT')
then
Begin
Result := OS2BMP;
exit;
end;

if FH.bfType <> 'BM' //Windows битмап
then
Begin
Result := UnknownBitmap;
exit;
end;

if bmp.Size <> FH.bfSize //Правельно ли указан размер битмапа
then
Begin
Result := PossibleCorrupt;
if not IgnoreNonCritical
then
exit;
end;

if (FH.bfReserved1 <> 0) or //Если резрвные поля не нулевые возможно
(FH.bfReserved2 <> 0) //мы имеем дело с новым стандартом
then //на настоящий момент
Begin
Result := PossibleCorrupt;
if not IgnoreNonCritical
then
exit;
end;

//Проверяем не является ли битмап битмапом стандарта OS/2

bmp.ReadBuffer(HSize, SizeOf(HSize)); //читаем размер заголовка битмапа
Case HSize //12 - OS/2 version 2.x
of //64 - OS/2 version 3.x
12, 64 : Begin
Result := OS2BMP;
exit;
end;

40, 108, //40, 108, 124 - Windows bitmap
124..255 : Begin //Windows 3.х-XP
if (HSize in [125..255])
then
Begin //125..255 - возможно в новые
Result := PossibleExtended;//версии будут иметь больший размер
if not IgnoreNonCritical //Возможно в будущем сохранится
then //совместимость
exit;
end;
//возвращаемся на SizeOf(HSize)
bmp.Seek(-SizeOf(HSize), soFromCurrent); //байт для чтения
// всей структуры
GetMem(BIH, HSize); //Выделяем память - столько
//сколько структура занимает
//в файле
bmp.ReadBuffer(BIH^, HSize); //Читаем структуру и рассматриваем
Result := TestInfoHeader(BIH^); //ее как TBitmapInfoHeader.
end; //Дополнительные поля (если есть)
else //игнорируем за ненадобнотью
Begin
Result := UnknownBitmap; //Любые другие значения размера
exit; //заголовка считаем неверными
end;
end;

except
Result := FileReadError; //Ошибка чтения из файла
exit;
end;
end;

//Процедура конвертирования изображения
procedure TForm1.Convert(oldFH : TBitMapFileHeader;
oldBIH : TBitmapInfoHeader);
var
FH : TBitMapFileHeader;
BIH : TBitmapInfoHeader;
b1, b2 : Byte; //Служат для набивки байта битами смежных пикселов
i, j, k, l, m : integer; //Переменные циклов
DataSize : Integer; //Размер растра
LineSize : Integer; //Размер строки изображения
Delta : Integer; //Число дополнительных байт выравнивания
pixInByte : Byte; //Число пикселей помещающихся в байте
ReadPix : Pointer; //указтель на переменную в которую читается
//цвет пикселя (размер 2, 3 или 4 байта)
OldPixSize : Integer; //Размер (в байтах) исходного пикселя
PaletteColor : TRGBQuad; //Элемент палитры (один цвет)
DW : DWORD; //для временного хранения данных двойного слова
tocopy : Integer; //Число байт растра еще не скопированных

function is16bitPattern : Boolean; //ненадежный вариант позволяющий отличить
var //битмап 5-5-5 от 5-6-5
i : byte; //в случае если интенсивность красной
begin //состовляющей ни одного из пикселей формата
Result := false; //5-6-5 не превысит 15 - дает ложный результат
For i := 0 to 255
do
if palette[i] > High(SmallInt)
then
Begin
Result := True;
break;
end;
end;

function Get15RGBQuad(C : Cardinal) : TRGBQuad;
const
BlueMask = $001F; //Создание цвета палтры из цвета
GreenMask = $03E0; //пикселя формата 5-5-5
RedMask = $7C00;
GreenShift= 5;
RedShift = 10;

Begin
Result.rgbBlue := (C and BlueMask) shl 3;
Result.rgbGreen := ((C and GreenMask) shr GreenShift) shl 3;
Result.rgbRed := ((C and RedMask) shr RedShift) shl 3;
Result.rgbReserved := 0;
end;

function Get16RGBQuad(C : Cardinal) : TRGBQuad;
const
BlueMask = $001F;
GreenMask = $07E0; //Создание цвета палтры из цвета
RedMask = $F800; //пикселя формата 5-6-5
GreenShift= 5;
RedShift = 11;
Begin
Result.rgbBlue := (C and BlueMask) shl 3;
Result.rgbGreen := ((C and GreenMask) shr GreenShift) shl 2;
Result.rgbRed := ((C and RedMask) shr RedShift) shl 3;
Result.rgbReserved := 0;
end;

function Get24RGBQuad(C : Cardinal) : TRGBQuad;
const
BlueMask = $000000FF; //Создание цвета палтры из цвета
GreenMask = $0000FF00; //пикселя формата 8-8-8 или 8-8-8-8
RedMask = $00FF0000;
GreenShift= 8;
RedShift = 16;
Begin
Result.rgbBlue := (C and BlueMask);
Result.rgbGreen := (C and GreenMask) shr GreenShift;
Result.rgbRed := (C and RedMask) shr RedShift;
Result.rgbReserved := 0;
end;

Begin
if mem = nil
then
exit;

FH.bfType := 'BM'; //Заполняем поля файловой структуры
FH.bfReserved1 := 0; //нового битмапа
FH.bfReserved2 := 0;
//Копирум все поля структуры
BIH := oldBIH; //TBitMapInfoHeader
Case NColors
of
0 ..2 : BIH.biBitCount := 1; //Определем необходимое число бит на пиксель
3 ..16 : BIH.biBitCount := 4; //для найденного числа цветов
17..256 : BIH.biBitCount := 8;
end;
BIH.biCompression := BI_RGB; //Несжатый палитровый формат
BIH.biClrUsed := Round(Intpower(2, BIH.biBitCount)); //Число цветов палитры

LineSize := (BIH.biWidth * BIH.biBitCount) div 8; //Длина строки битмапа(в байтах)
if ((BIH.biWidth * BIH.biBitCount) mod 8) <> 0
then //Выравнивание строки на границу
inc(LineSize); //одного байта

Delta := LineSize mod 4;
if Delta <> 0 //Выравнивание строки на границу
then //четырех байт
Delta := 4 - Delta;

inc(LineSize, Delta);
DataSize := LineSize * abs(BIH.biheight); //Определяем размер нового растра
//(в байтах)
pixInByte := 8 div BIH.biBitCount;
memResult := TMemoryStream.Create; //Поток будет содержать растр
memResult.Seek(0, soFromBeginning);
memResult.SetSize(DataSize);

mem.Seek(0, soFromBeginning);
OldPixSize := OldBIH.biBitCount div 8;
GetMem(ReadPix, OldPixSize); //переменная для чтения из исходного
//растра
ProgressBar1.Visible := true;
ProgressBar1.Max := BIH.biHeight;
ProgressBar1.Position:= 0;

Try //Защищеный блок записи в файла
For j := 1 to abs(BIH.biheight) //цикл по строкам
do
Begin
ProgressBar1.Position := j;
application.ProcessMessages;
i := 1;
Repeat //цикл по пикселям строки
K := (pixInByte - 1) * BIH.biBitCount; //Сдвиг текущего пикселя в байте
m := 0; //номер пикселя в байте
b2 := 0; //"тот самый" байт данных
Repeat //нового растра
mem.ReadBuffer(ReadPix^, OldPixSize);
For l := 0 to NColors - 1 //определяем номерцвета в палитре
do //Сравнивая текущий цвет с цветом
if CompareMem(ReadPix, @Palette[l], OldPixSize) //палитры
then
Begin
b1 := l; //Сохраняем номер цвета
break; //(при выходе из цикла значение
end; //l может быть произвольным)

b2 := b2 or (b1 shl K); //Сдвигаем цвет на k разрядов
//и записываем его в байт данных
Dec(K, BIH.biBitCount); //следующий пиксель находится
//в более младшем разряде
inc(m);
until (m = pixInByte) or ((i + m) > BIH.biWidth); //последний байт данных строки
//может быть не заполнен до конца
memResult.WriteBuffer(b2, SizeOf(b2)); //запись байта
inc(i, m);
until i > BIH.biWidth;

mem.Seek(OldDelta, soFromCurrent); //Выравнивание на границу 4 байт
memResult.Seek(Delta, soFromCurrent); //как по входу так и по выходу
end;
ProgressBar1.Visible := False;

bmp := TFileStream.Create(Edit2.Text, fmCreate);
bmp.Seek(0, soFromBeginning);


bmp.WriteBuffer(FH, SizeOf(FH)); //Запись заголовков битмапа
bmp.WriteBuffer(BIH, SizeOf(BIH));

if oldBIH.biBitCount = 16 //Определяем тип исходного
then //High Color битмапа
if not is16bitPattern //по умалчанию - 5-5-5
then
oldBIH.biBitCount := 15;

Case oldBIH.biBitCount //Конвертируем цвета в
of //палитру и пишем палитру в файл
15 :
For i := 0 to BIH.biClrUsed - 1
do
Begin
PaletteColor := Get15RGBQuad(palette[i]);
bmp.WriteBuffer(PaletteColor, SizeOf(PaletteColor));
end;

16 :
For i := 0 to BIH.biClrUsed - 1
do
Begin
PaletteColor := Get16RGBQuad(palette[i]);
bmp.WriteBuffer(PaletteColor, SizeOf(PaletteColor));
end;

24, 32 :
For i := 0 to BIH.biClrUsed - 1
do
Begin
PaletteColor := Get24RGBQuad(palette[i]);
bmp.WriteBuffer(PaletteColor, SizeOf(PaletteColor));
end;
end;

DW := bmp.Position; //Определяем начало растра
bmp.Seek(10, soFromBeginning); //Записываем это значение
bmp.WriteBuffer(DW, SizeOf(DW)); //в файловый заголовок

bmp.Seek(DW, soFromBeginning);
memResult.Seek(0, soFromBeginning);

ProgressBar1.Visible := true;
ProgressBar1.Max := memResult.Size div 100000;
ProgressBar1.Position:= 0;
tocopy := memResult.Size;
While (tocopy - 100000) > 0 //Записываем растр блоками по
do // 100000 байт (нужно более
Begin // для progressbar а и важно)
bmp.CopyFrom(memResult, 100000); // для сверхбольших битмапов
tocopy := tocopy - 100000; // размером от 100 МБ
ProgressBar1.Position := ProgressBar1.Position + 1;
end;
bmp.CopyFrom(memResult, tocopy);
ProgressBar1.Visible := false;

DW := bmp.Size; //Читаем размер файла и пишем
bmp.Seek(2, soFromBeginning); //в файловый заголовок
bmp.WriteBuffer(DW, SizeOf(DW));
Except
ShowMessage('Fail to Write File');
end;
bmp.Free;
memResult.Free;
end;

//Загружает битмап в память и определяет число цветов

procedure TForm1.Button1Click(Sender: TObject);
var
DataSize: Integer;
LineSize: Integer;
i, j, k : Integer;
ReadPix : Pointer;
PixSize : Integer;
Found : Boolean;
err : Integer;
tocopy : Integer;

begin
if OpenPictureDialog1.Execute
then
Begin
Edit1.Text := OpenPictureDialog1.FileName;
Edit2.Text := ExtractFilePath(OpenPictureDialog1.FileName) +
'Compressed_' + ExtractFileName(OpenPictureDialog1.FileName);
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);

err := TestBmp(False); //Проверяем годится ли битмап и читаем заголовки
if err = NoError
then
Begin
NColors := 0;
bmp.Seek(FH.bfOffBits, soFromBeginning);

OldDelta := (BIH.biWidth * BIH.biBitCount div 8) mod 4;
if OldDelta <> 0 //Считаем число байт выравнивания
then
OldDelta := 4 - OldDelta;

LineSize := BIH.biWidth * BIH.biBitCount div 8 + OldDelta;
//Вычисляем полную длину строки
DataSize := LineSize * abs(BIH.biHeight); //Размер растра
mem := TMemoryStream.Create;
mem.SetSize(DataSize); //Выделяем память под растр

ProgressBar1.Visible := true;
ProgressBar1.Max := DataSize div 100000;
ProgressBar1.Position:= 0;
try
tocopy := DataSize; //Читаем растр блоками по 100000
While (tocopy - 100000) > 0 //байт
do //Позволяет отоброзить прогресс
Begin //Важно для битмапов более 10Мб
mem.CopyFrom(bmp, 100000);
tocopy := tocopy - 100000;
ProgressBar1.Position := ProgressBar1.Position + 1;
end;
mem.CopyFrom(bmp, tocopy);
ProgressBar1.Visible := false;
except
ShowMessage('File Read Error');
exit;
end;
bmp.Free;
mem.Seek(0, soFromBeginning);

PixSize := BIH.biBitCount div 8; //Размер пикселя в байтах
GetMem(ReadPix, PixSize);
FillChar(Palette, 256, 0); //Зануляем палитру
ProgressBar1.Visible := true;
ProgressBar1.Max := BIH.biHeight;
ProgressBar1.Position:= 0;
For i := 1 to BIH.biHeight
do
Begin
ProgressBar1.Position := i;
application.ProcessMessages;
For j := 1 to BIH.biWidth
do
Begin
mem.ReadBuffer(ReadPix^, PixSize); //Читаем очередной пиксель

found := false;
For k := 0 to NColors - 1
do
if CompareMem(ReadPix, @Palette[k], PixSize)
then //Если такой цвет есть в палитре
Begin //переходим к следующему
found := True;
Break;
end;

if not Found //Если такого цвета еще нет
then //то добавляем
Begin
inc(NColors);
if NColors > 256 //Если число цветов перевалило через
then //256 завершаем работу
Begin
ProgressBar1.Visible := False;
err := MoreThan256Colors;
ShowMessage('More than 256 colors Detected');
mem.Free;
mem := nil;
exit;
end; //Иначе копируем цвет в палтру
Move(ReadPix^, Palette[NColors - 1], PixSize);
end
end;
mem.Seek(OldDelta, soFromCurrent);
end;

ProgressBar1.Visible := False;
end
else
Begin
Case err
of
FileReadError : ShowMessage('Error file data accessing');
OS2BMP : ShowMessage('OS/2 BMP Detected');
UnknownBitmap : ShowMessage('Unknown BMP type');
PossibleCorrupt : ShowMessage('Bitmap is Corrupt or incorect');
PossibleExtended : ShowMessage('Possible Extended format or corrupt');
CompressedBitMap : ShowMessage('BitMap is already compressed');
NotHighOrTrueColor : ShowMessage('BitMap is not High or True Color');
end;
FH := Nil;
BIH := Nil;
mem := Nil;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FH := Nil;
BIH := Nil;
mem := Nil;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
mem.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if (FH <> nil) and (BIH <> nil)
then
Convert(FH^, BIH^);
end;

end.

Скачать проект: http://forum.vingrad.ru/act-Attach/type/post/id-734368.html

 

Автор: Alexeis (С) ( http://forum.vingrad.ru/index.php?showuser=777&nickname=Alexeis )