Как из HBitmap получить адрес Bitmap в памяти?
Вот кусок одного моего класса, в котором есть две интересные вещицы -
проецирование файлов в память и работа с битмэпом в памяти через указатель.
Сразу оговорюсь, что все это работает только Delphi 2 и Win95/NT.
type
TarrRGBTriple=
array[byte]
of TRGBTriple;
ParrRGBTriple=^TarrRGBTriple;
{организует битмэп размером SX,SY;true_color}
procedure TMBitmap.Allocate(SX,SY:integer);
var DC:HDC;
begin
if BM<>0
then DeleteObject(BM); {удаляем старый битмэп, если был}
BM:=0; PB:=
nil;
fillchar(BI,sizeof(BI),0);
with BI.bmiHeader
do {заполняем структуру с параметрами битмэпа}
begin
biSize:=sizeof(BI.bmiHeader);
biWidth:=SX; biHeight:=SY;
biPlanes:=1; biBitCount:=24;
biCompression:=BI_RGB;
biSizeImage:=0;
biXPelsPerMeter:=0; biYPelsPerMeter:=0;
biClrUsed:=0; biClrImportant:=0;
FLineSize:=(biWidth+1)*3
and (-1
shl 2); {размер строки(кратна 4 байтам)}
if (biWidth
or biHeight)<>0
then
begin
DC:=CreateDC('DISPLAY',
nil,
nil,
nil);
{замечательная функция (см.HELP), возвращает HBITMAP, позволяет сразу
разместить выделяемый битмэп в спроецированном файле, что позволяет
ускорять работу и экономить память при генерировании большого битмэпа}
{!} BM:=CreateDIBSection(DC,BI, DIB_RGB_COLORS, pointer(PB),
nil, 0);
DeleteDC(DC); {в PB получаем указатель на битмэп-----^^}
if BM=0
then Error('error creating DIB');
end;
end;
end;
{эта процедура загружает из файла true-color'ный битмэп}
procedure TMBitmap.LoadFromFile(
const FileName:
string);
var HF:integer; {file handle}
HM:THandle; {file-mapping handle}
PF:pchar; {pointer to file view in memory}
i,j:integer;
Ofs:integer;
begin
{открываем файл}
HF:=FileOpen(FileName,fmOpenRead
or fmShareDenyWrite);
if HF<0
then Error('open file '''+FileName+'''');
try
{создаем объект-проецируемый файл}
HM:=CreateFileMapping(HF,
nil,PAGE_
READONLY,0,0,
nil);
if HM=0
then Error('can''t create file mapping');
try
{собственно проецируем объект в адресное }
PF:=MapViewOfFile(HM,
FILE_MAP_
READ,0,0,0);
{получаем указатель на область памяти, в которую спроецирован файл}
if PF=
nil then Error('can''t create map view of file');
try
{работаем с файлом как с областью памяти через указатель PF}
if PBitmapFileHeader(PF)^.bfType<>$4D42
then Error('file format');
Ofs:=PBitmapFileHeader(PF)^.bfOffBits;
with PBitmapInfo(PF+sizeof(TBitmapFileHeader))^.bmiHeader
do
begin
if (biSize<>40)
or (biPlanes<>1)
then Error('file format');
if (biCompression<>BI_RGB)
or
(biBitCount<>24)
then Error('only true-color BMP supported');
{выделяем память под битмэп}
Allocate(biWidth,biHeight);
end;
for j:=0
to BI.bmiHeader.biHeight-1
do
for i:=0
to BI.bmiHeader.biWidth-1
do
{Pixels - это property, возвр. указатель на соотв. RGBTriple в битмэпе}
Pixels[i,j]^.Tr:=ParrRGBTriple(PF+j*FLineSize+Ofs)^[i];
finally
UnmapViewOfFile(PF);
end;
finally
CloseHandle(HM);
end;
finally
FileClose(HF);
end;
end;
{эта функция - реализация Pixels read}
function TMBitmap.GetPixel(X,Y:integer):PRGB;
begin
if (X>=0)
and (Xand
(Y>=0)
and (Ythen Result:=PRGB(PB+(Y)*FLineSize+X*3)
else Result:=PRGB(PB);
end;
Содержание Назад Вперед