Вывод графики с использованием отображаемых файлов

Спору нет — объект 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. Этот снимок с метеорологического спутника имеет размер десятки мегабайт

 


Знаете ли Вы, как разрешается парадокс Ольберса?
(Фотометрический парадокс, парадокс Ольберса - это один из парадоксов космологии, заключающийся в том, что во Вселенной, равномерно заполненной звёздами, яркость неба (в том числе ночного) должна быть примерно равна яркости солнечного диска. Это должно иметь место потому, что по любому направлению неба луч зрения рано или поздно упрется в поверхность звезды.
Иными словами парадос Ольберса заключается в том, что если Вселенная бесконечна, то черного неба мы не увидим, так как излучение дальних звезд будет суммироваться с излучением ближних, и небо должно иметь среднюю температуру фотосфер звезд. При поглощении света межзвездным веществом, оно будет разогреваться до температуры звездных фотосфер и излучать также ярко, как звезды. Однако в дело вступает явление "усталости света", открытое Эдвином Хабблом, который показал, что чем дальше от нас расположена галактика, тем больше становится красным свет ее излучения, то есть фотоны как бы "устают", отдают свою энергию межзвездной среде. На очень больших расстояниях галактики видны только в радиодиапазоне, так как их свет вовсе потерял энергию идя через бескрайние просторы Вселенной. Подробнее читайте в FAQ по эфирной физике.

НОВОСТИ ФОРУМА

Форум Рыцари теории эфира


Рыцари теории эфира
 10.11.2021 - 12:37: ПЕРСОНАЛИИ - Personalias -> WHO IS WHO - КТО ЕСТЬ КТО - Карим_Хайдаров.
10.11.2021 - 12:36: СОВЕСТЬ - Conscience -> РАСЧЕЛОВЕЧИВАНИЕ ЧЕЛОВЕКА. КОМУ ЭТО НАДО? - Карим_Хайдаров.
10.11.2021 - 12:36: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от д.м.н. Александра Алексеевича Редько - Карим_Хайдаров.
10.11.2021 - 12:35: ЭКОЛОГИЯ - Ecology -> Биологическая безопасность населения - Карим_Хайдаров.
10.11.2021 - 12:34: ВОЙНА, ПОЛИТИКА И НАУКА - War, Politics and Science -> Проблема государственного терроризма - Карим_Хайдаров.
10.11.2021 - 12:34: ВОЙНА, ПОЛИТИКА И НАУКА - War, Politics and Science -> ПРАВОСУДИЯ.НЕТ - Карим_Хайдаров.
10.11.2021 - 12:34: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от Вадима Глогера, США - Карим_Хайдаров.
10.11.2021 - 09:18: НОВЫЕ ТЕХНОЛОГИИ - New Technologies -> Волновая генетика Петра Гаряева, 5G-контроль и управление - Карим_Хайдаров.
10.11.2021 - 09:18: ЭКОЛОГИЯ - Ecology -> ЭКОЛОГИЯ ДЛЯ ВСЕХ - Карим_Хайдаров.
10.11.2021 - 09:16: ЭКОЛОГИЯ - Ecology -> ПРОБЛЕМЫ МЕДИЦИНЫ - Карим_Хайдаров.
10.11.2021 - 09:15: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от Екатерины Коваленко - Карим_Хайдаров.
10.11.2021 - 09:13: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от Вильгельма Варкентина - Карим_Хайдаров.
Bourabai Research - Технологии XXI века Bourabai Research Institution