неОпытный
Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск
Репутация: нет
Всего: 260
|
под свои нужды написал модуль, который разбирает структуру BMP и перебирает все пиксели, вызывая для каждого функцию, переданную в качестве аргумента. поддерживают несжатые 32, 24, 16, 8, 4, 2 и 1-битные изображения, а также - 8-битные с RLE. не поддерживаются PNG и JPG компрессия, а также почему-то проблема с реализацией 4-битного RLE кодирования - при переборе вполне валидных изображений срабатывает встречается 00 02 - и "выпадают" строки. Может, GIMP косо сохраняет в 4-битный с RLE(и на самом деле 00 02 надо трактовать не как инфорацию о смещении, а как "абсолютный режим" - вывести два пиксела?) | Код |
unit BMP_OP;
interface
const readQuant = 2;
{ методы сжатия }
BI_RGB = $00000000;
BI_RLE8 = $00000001;
BI_RLE4 = $00000002;
BI_BITFIELDS = $00000003;
BI_JPEG = $00000004;
BI_PNG = $00000005;
type
{ в нижеописанных структурах
везде, где используется longint,
должен быть DWORD. Потому возможно
переполнение со сменой знака, т.к.
Pascal не поддерживает тип DWORD
}
TColor = record
R,G,B: byte;
end;
TColorTable = ^TColor;
TBitMapFileHeader = record
bfType: array[0..1] of char;
bfSize: longint;
bfReserved1, bfReserved2: word;
bfOffBits: longint;
end;
TBitMapInfoHeader = record
biSize : longint;
biWidth : longint;
biHeight : longint;
biPlanes : word;
biBitCount : word;
biCompression : longint;
biSizeImage : longint;
biXPelsPerMeter,
biYPelsPerMeter : longint;
biClrUsed : longint;
biClrImportant : longint;
biRedMask : longint;
biGreenMask : longint;
biBlueMask : longint;
{
Описанная в документации структура не "включает"
в себя палитру; но чтоб считать палитру один
раз, а затем пользоваться считанными данными,
надо хрнить указать на область памяти;
поле структуры info подходит под это
как можно лучше, так как структура передается
параметров почти во все функции
}
xPalette : TColorTable;
end;
TPixelsIterateCallback = function(const x,y : longint;
const color: TColor;
const header: TBitmapFileHeader;
const info: TBitmapInfoHeader): boolean;
TIteratePixelsInBMPProcedure = procedure(
var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);
{
Считать из файла основной заголовок
}
procedure fetchBMPHeader(var bitmapFile: file; var header: TBitmapFileHeader);
{
Считать из файла дополнительный заголовок
}
procedure fetchBMPInfoHeader(var bitmapFile: file; var infoHeader: TBitmapInfoHeader);
{
Загрузить из файла палитру
}
procedure loadPalette(var bmpFile: file;
const head: TBitmapFileHeader;
var info: TBitmapInfoHeader
);
procedure enumeratePixels(var bmpFile: file;
const header: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback;
unknownFormatCallback: TIteratePixelsInBMPProcedure);
implementation
uses graph;
type
TGetPixelFromBMPProcedure = procedure(
var bitmapFile: file;
x,y: longint;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
var color: TColor);
function testBMPHeader(header: TBitmapFileHeader; bmpFileSize: longint): boolean;
var result: boolean;
begin
result:= true;
if (bmpFileSize< 0) OR (header.bfSize< 0)
{
переполнение типа longint
для файлов, больших 2Гб;
правда, дождаться
отрисовки таких файлов
все равно маловероятно
}
then
runError(204);
if (header.bfReserved1 <> 0)
OR (header.bfReserved2 <> 0)
{
если в этих полях не 0,
возможно, структура повреждена
}
then
result := false;
if header.bfOffBits >= bmpFileSize
{
смещение до начала данных
изображения не может быть
больше размера файла
}
then
result := false;
testBMPheader := result;
end;
function testBmpInfoHeader(Info: TBitmapInfoHeader): boolean;
var result: boolean;
begin
result := true;
if info.biPlanes <> 1
{
biPlanes должно быть 1
в текущей версии структуры
}
then
result := false;
testBmpInfoHeader := result;
end;
procedure fetchBMPHeader(var bitmapFile: file; var header: TBitmapFileHeader);
var hasBeenRead: word;
begin
{ читаем заголовок }
blockRead(bitmapFile, header, sizeOf(header) div readQuant, hasBeenRead);
if (hasBeenRead <> sizeOf(header) div readQuant)
OR (testBMPHeader(header, fileSize(bitmapFile) * readQuant)=false)
{
если прочитали с ошибкой или, судя по заголовку,
структура не может быть обработана,
вызываем ошибку
}
then
runError(19);
end;
procedure fetchBMPInfoHeader(var bitmapFile: file; var infoHeader: TBitmapInfoHeader);
var hasBeenRead: word;
begin
{ читаем заголовок }
blockRead(bitmapFile, infoHeader, sizeOf(infoHeader) div ReadQuant, hasBeenRead);
if (hasBeenRead <> sizeOf(infoHeader) div readQuant)
OR (testBMPInfoHeader(infoHeader) = false)
{
если прочитали с ошибкой или, судя по заголовку,
структура не может быть обработана,
вызываем ошибку
}
then
runError(19);
end;
procedure scrollColorTable(var colorTable: TColorTable; shift: integer);
begin
colorTable := Ptr(Seg(colorTable^), Ofs(colorTable^) + shift * sizeof(TColor));
end;
procedure loadPalette(var bmpFile: file;
const head: TBitmapFileHeader;
var info: TBitmapInfoHeader
);
var i, j: byte;
temp: integer;
colorTable: TColorTable;
begin
if info.biClrUsed = 0
{
Если у нас безпалитровое изображение,
нет смысла обрабатывать файл
}
then
begin
info.xPalette := nil;
exit;
end;
reset(bmpFile, 1);
getMem(info.xPalette, sizeof(TColor) * info.biClrUsed);
colorTable := info.xPalette;
{
"Пропускаем" в файле структуры TBitMapFileHeader
и TBitMapInfoHeader
}
seek(bmpFile, sizeof(head) + info.biSize);
for i:= 0 to info.biClrUsed - 1 do
begin
blockRead(bmpFile, colorTable^.B, 1, temp);
blockRead(bmpFile, colorTable^.G, 1, temp);
blockRead(bmpFile, colorTable^.R, 1, temp);
{
Четвертый байт каждого элемента палитры
используется только для выравнивания;
прочитали, чтоб сместиться дальше,
и проигнорировали значение
}
blockRead(bmpFile, j, 1, temp);
{
getMem мог выделить память в конце сегмента;
тогда последнее, biClrUsed * sizeof(TColor)
смещение приведет к ошибке переполнения адреса
}
if i <> info.biClrUsed - 1
then
scrollColorTable(colorTable, 1);
end;
end;
function getJunkValue(const info: TBitmapInfoHeader): byte;
var temp: longint;
begin
temp := info.biWidth * info.biBitCount;
if (temp AND 7) <> 0
then
temp := (temp OR 7) + 1;
temp := (temp shr 3) AND 3;
if temp = 0
then
getJunkValue := 0
else
getJunkValue := 4 - temp;
end;
procedure getColorFromPalette(const colorIndex: byte;
var color: TColor;
const info: TBitmapInfoHeader);
var colorTable: TColorTable;
begin
colorTable := info.xPalette;
scrollColorTable(colorTable, colorIndex);
color.R := colorTable^.R;
color.G := colorTable^.G;
color.B := colorTable^.B;
end;
procedure enum_32b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
color: TColor;
temp: byte;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
blockRead(bmpFile, temp, 1, hasBeenRead);
blockRead(bmpFile, color.B, 1, hasBeenRead);
blockRead(bmpFile, color.G, 1, hasBeenRead);
blockRead(bmpFile, color.R, 1, hasBeenRead);
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
end;
end;
procedure enum_24b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
color: TColor;
temp: byte;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
blockRead(bmpFile, color.B, 1, hasBeenRead);
blockRead(bmpFile, color.G, 1, hasBeenRead);
blockRead(bmpFile, color.R, 1, hasBeenRead);
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
for x:= 1 to getJunkValue(info) do
blockRead(bmpFile, temp, 1, hasBeenRead);
end;
end;
procedure enum_16b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
color: TColor;
temp: word;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
blockRead(bmpFile, temp, 2, hasBeenRead);
if (info.biRedMask = info.biGreenMask) AND (info.biGreenMask = info.biBlueMask)
then
{ Цвета хранятся в двойном байте по схеме 5-5-5:
0RRRRRGGGGGBBBBB
}
begin
color.R := (temp AND 31744) shr 7;
color.G := (temp AND 992) shr 2;
color.B := (temp AND 31) shl 3;
end
else
{
Цвета хранятся по схеме 5-6-5:
RRRRRGGGGGGBBBBB
}
begin
color.R := (temp AND 63488) shr 8;
color.G := (temp AND 2016) shr 2;
color.B := (temp AND 31) shl 3;
end;
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
for x:= 1 to getJunkValue(info) div 2 do
blockRead(bmpFile, temp, 2, hasBeenRead);
end;
end;
procedure enum_8b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
colorIndex: byte;
color: TColor;
colorTable: TColorTable;
temp: byte;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
blockRead(bmpFile, colorIndex, 1, hasBeenRead);
getColorFromPalette(colorIndex, color, info);
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
for x:= 1 to getJunkValue(info) do
blockRead(bmpFile, temp, 1, hasBeenRead);
end;
end;
procedure enum_4b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
colorIndex: byte;
color: TColor;
colorTable: TColorTable;
temp: byte;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
if (x AND 1) = 1
then
begin
blockRead(bmpFile, temp, 1, hasBeenRead);
colorIndex := temp shr 4;
end
else
colorIndex := temp AND 15;
getColorFromPalette(colorIndex, color, info);
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
for x:= 1 to getJunkValue(info) do
blockRead(bmpFile, temp, 1, hasBeenRead);
end;
end;
procedure enum_2b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
colorIndex: byte;
color: TColor;
colorTable: TColorTable;
temp: byte;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
if (x AND 3) = 1
then
blockRead(bmpFile, temp, 1, hasBeenRead);
case (x AND 3) of
1: colorIndex := temp shr 6;
2: colorIndex := (temp shr 4) AND 3;
3: colorIndex := (temp shr 2) AND 3;
0: colorIndex := temp AND 3;
end;
getColorFromPalette(colorIndex, color, info);
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
for x:= 1 to getJunkValue(info) do
blockRead(bmpFile, temp, 1, hasBeenRead);
end;
end;
procedure enum_1b_uncompressed(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
colorIndex: byte;
color: TColor;
colorTable: TColorTable;
temp: byte;
hasBeenRead: integer;
begin
callbackResult := true;
for y := info.biHeight downto 1 do
begin
for x := 1 to info.biWidth do
begin
if (x AND 7) = 1
then
blockRead(bmpFile, temp, 1, hasBeenRead);
colorIndex := temp AND (1 shl (7 - ((x - 1) mod 8)));
colorIndex := colorIndex shr (7 - ((x - 1) mod 8));
getColorFromPalette(colorIndex, color, info);
callbackResult := callback(x, y, color, head, info);
if NOT(callbackResult)
then
break;
end;
if NOT(callbackResult)
then
break;
for x:= 1 to getJunkValue(info) do
blockRead(bmpFile, temp, 1, hasBeenRead);
end;
end;
procedure enum_8b_RLE8(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
var x, y: longint;
callbackResult: boolean;
colorIndex, i: byte;
color: TColor;
colorTable: TColorTable;
temp: word;
hasBeenRead: integer;
begin
callbackResult := true;
x := 1;
y := info.biHeight;
while NOT(eof(bmpFile)) do
begin
blockRead(bmpFile, temp, 2, hasBeenRead);
case temp of
0: begin
x := 1;
y := y - 1;
continue;
end;
1: exit;
2: begin
blockRead(bmpFile, temp, 2, hasBeenRead);
x := x + Hi(temp);
y := y - Lo(temp);
continue;
end;
else
begin
if Lo(temp) = 0
then
begin
for i := 1 to Hi(temp) do
begin
blockRead(bmpFile, colorIndex, 1, hasBeenRead);
getColorFromPalette(colorIndex, color, info);
if (x<= info.biWidth) AND (y> 0)
then
callbackResult := callback(x, y, color, head, info);
x := x + 1;
if NOT(callbackResult)
then
exit;
end;
if Hi(temp) AND 1 = 1
then
blockRead(bmpFile, colorIndex, 1, hasBeenRead);
end
else
begin
colorIndex := Hi(temp);
getColorFromPalette(colorIndex, color, info);
for i:= 1 to Lo(temp) do
begin
if (x<= info.biWidth) AND (y> 0)
then
callbackResult := callback(x, y, color, head, info);
x := x + 1;
if NOT(callbackResult)
then
exit;
end;
end;
end;
end;
end;
end;
procedure enumeratePixels(var bmpFile: file;
const header: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback;
unknownFormatCallback: TIteratePixelsInBMPProcedure);
var iterateProc : TIteratePixelsInBMPProcedure;
begin
iterateProc := unknownFormatCallback;
reset(bmpFile, 1);
seek(bmpFile, header.bfOffBits);
if info.biCompression in [BI_RGB, BI_BITFIELDS]
then
case info.biBitCount of
32: begin
iterateProc := enum_32b_uncompressed;
end;
24: begin
iterateProc := enum_24b_uncompressed;
end;
16: begin
iterateProc := enum_16b_uncompressed;
end;
8: begin
iterateProc := enum_8b_uncompressed;
end;
4: begin
iterateProc := enum_4b_uncompressed;
end;
2: begin
iterateProc := enum_2b_uncompressed;
end;
1: begin
iterateProc := enum_1b_uncompressed;
end;
end;
if (info.biBitCount = 8) AND (info.biCompression = BI_RLE8)
then
iterateProc := enum_8b_RLE8;
iterateProc(bmpFile, header, info, callback);
end;
end.
|
пример использования: | Код |
procedure cannt_enum_BMP(var bmpFile: file;
const head: TBitmapFileHeader;
const info: TBitmapInfoHeader;
callback: TPixelsIterateCallback);far;
begin
graph.closeGraph;
writeln('Cannot handle this BMP file');
writeln('Info about file:');
writeln('Size is ', info.biWidth, ' X ', info.biHeight);
writeln('Bit per pixel: ', info.biBitCount);
write('Compression type is: ');
case info.biCompression of
BI_RGB: write('Uncompressed');
BI_BITFIELDS: write('Uncompressed - bitfields');
BI_RLE8: write('RLE - 8');
BI_RLE4: write('RLE - 4');
BI_PNG: write('PNG');
BI_JPEG: write('JPEG');
else
write('Unknown');
end;
writeln('(',info.biCompression,')');
halt(2);
end;
function pixelsIterator(const x,y : longint;
const color: TColor;
const header: TBitmapFileHeader;
const info: TBitmapInfoHeader): boolean; far;
begin
pixelsIterator := true;
if (keypressed) AND (readkey = #27)
then
pixelsIterator := false
else
GRAPH_OP.drawPoint(x, y, info.biWidth, info.biHeight, color.R, color.G, color.B);
{ просто вывод точки с преобразованием координат и цветовой палитры под VGA режим 2 }
end;
cont bmpFilePath = 'c:\8uncompressed.bmp';
var bmpFile: file;
header: TBitMapFileHeader;
info: TBitmapInfoHeader;
begin
assign(bmpfile, bmpFilePath);
reset(bmpFile, 2);
BMP_OP.fetchBMPheader(bmpfile, header);
{ получаем общий заголовок для структуры 3 версии }
BMP_OP.fetchBMPInfoHeader(bmpfile, info);
{загружаем палитру}
BMP_OP.loadPalette(bmpFile, header, info);
{ инициируем перечисление пикселей }
BMP_OP.enumeratePixels(bmpFile, header, info, pixelsIterator, cannt_enum_BMP);
end;
|
|
Графический формат BMP, Статья 
Загрузка ...
