Programming: Delphi

Спору нет — объект TBitmap удобен и универсален. Программисты Borland шагают в ногу с разработчиками графического API Windows, и исходный код модуля GRAPHICS.PAS от версии к версии совершенствуется. Но в ряде случаев возможностей, предоставляемых стандартным компонентом, недостаточно. Один из таких случаев — работа с большими и очень большими изображениями (до сотен Мбайт). С ними приходится иметь дело в полиграфии, медицине, при обработке изображений дистанционного зондирования Земли из космоса и т. п. Здесь класс TBitmap не подходит, т. к. запрашивает для хранения и преобразования картинки слишком много ресурсов.

Что делать? На помощь следует призвать Windows API, поддерживающий файлы, отображаемые в память (Memory Mapped Files). У них много полезных свойств, но здесь важно только одно из них. При создании битовой карты Windows распределяет для нее часть виртуального адресного пространства. А оно не безгранично — для выделения 50—100 Мбайт может не хватить размеров файла подкачки, не говоря уже об ОЗУ. Но можно напрямую отобразить файл в виртуальную память, сделав его частью виртуального адресного пространства. В этом случае нашему файлу с изображением будет просто выделен диапазон адресов, которые можно использовать для последующей работы.

Процедура отображения файла в память и присвоения адреса его данным выглядит следующим образом:

Var Memory: pByteArray; 

ес : Integer;

procedure TForml.OpenlClick(Sender: TObject);

 var

i: integer;

bmFile : pBitmapFileHeader; 

bmlnfo : pBitmapInfoHeader;

 begin if not OpenDialogl.execute then Exit;

hf := CreateFile(pChar(OpenDialogl.FileName), GENERIC_READ or GENERIC_WRITE,

FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0) ; if hf=INVALID_HANDLE_VALUE then 

begin

ec:=GetLastError;

ShowMessage(' File opening error Ч-IntTostr (ec) ) ; Exit;

 end;

hm := CreateFileMapping(hf,' nil, PAGE_READONLY, 0,0,nil);

if hm=0 then

 begin

ShowMessage(' File Mapping error %d',[GetLastError]);

 Expend;

pb := MapViewOfFile(hm, FILE_MAP_READ, 0,0,0); 

if pb=nil then

 begin

ec:=GetLastError;

ShowMessage('Mapping error '+IntTostr(ec)); Exit;

 end;

bmFile := pBitmapFileHeader(pb);

if (bmFile".bfTypeO$4D42) then BEGIN 

Exit; 

end;

Memory:=@(рb^[bmFile^.bfOffBits]);

bmlnfo := @(рb^[SizeOf(TBitmapFileHeader)]);

StrLen:=(((bmInfo~.biWidth*bmInfoA.biBitCount)

+31) div 32}*4;

PaintMe(Self);

 end;

В этом коде последовательно получены дескрипторы файла (hf, с использованием функции CreateFile), его отображения в память (hm, с помощью функции CreateFileMapping) и указатель на отображенные данные (pb, посредством MapviewOfFile). He будем вдаваться в детали внутренней реализации битовой карты — графический формат BMP известен достаточно хорошо. Отметим только, что результатом проделанных операций являются структура bminfo типа TBitmapinfo, полностью характеризующая битовую карту, и указатель Memory на данные битовой карты. Теперь загруженные данные нужно суметь нарисовать на канве, в данном случае на канве объекта PaintBox. Делается это следующим образом:

procedure TForml.PaintMe(Sender: TObject);

var OldP : hPalette;i : integer;

 begin

if Memory=nil then Exit;

OldP := SelectPalette(PaintBox.Canvas.Handle, Palette, False);

RealizePalette(PaintBox.Canvas.Handle);

SetStretchBltMode(PaintBox.Canvas.Handle, STRETCH_DELETESCANS);

case ViewMode of

vmStretch:

with bminfo^ do

i : =

StretchDIBits(PaintBox.Canvas.Handle,

0,0,PaintBox.Height,PaintBox.Width,

0,0,biWidth,Abs(biHeight),

Memory, pBitmapInfo(bminfo)^, DIB_RGB_COLORS,

PaintBox.Canvas.CopyMode);

vmlxl:

with bminfoA,PaintBox.ClientRect do

i := SetDIBitsToDevice

(PaintBox.Canvas.Handle,Left,Top,Right-Left,

Bottom-Top,

Left,Top,Top,Bottom-top, 

Memory, pBitmapInfо(bminfo)^, DIB_RGB_COLORS);

vmZoom: 

begin

with bminfo^,PaintBox.ClientRect do

i := StretchDIBits

(PaintBox.Canvas.Handle,Left,Top,Right-Left, 

Bottom-Top,

0,0,biWidth,Abs(biHeight) ,

Memory, pBitmapInfo(bminfo)^, DIB_RGB_COLORS, PaintBox.Canvas.CopyMode);

 end;

end;

if (i=0) or (i=GDI_ERROR) then

begin

ec :=GetLastError;

Forml.Caption := 'Error code '+IntToStr(ec);

end;

SelectPalette(PaintBox.Canvas.Handle, OldP, False); 

end;

В зависимости от установленного режима отображения (vmstretch, vmzoom или vmlxl) применяются разные функции Win API: stretchoisits или SetoiBitsToDevice. Выигрыш в скорости работы приложения особенно ощущается, если загружаемые файлы становятся велики и должны размещаться в файле подкачки. Наше же приложение не использует его и отображает данные прямо из файла на экран (рис. 10.3).

Рис. 10.3. Этот снимок с метеорологического спутника имеет размер десятки мегабайт

Назад | Оглавление | Вперёд