Вот кусок одного моего класса, в котором есть две интересные вещицы -
проецирование файлов в память и работа с битмэпом в памяти через указатель.
Сразу оговорюсь, что все это работает только под Win95/NT.
type
TarrRGBTriple = array[byte] of TRGBTriple;
ParrRGBTriple = ^TarrRGBTriple;
{организует битмэп размером SX,SY;true_color}procedure TMBitmap.Allocate(SX, SY: integer);
var
DC: HDC;
beginif 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 thenbegin
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 = nilthen
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 dobeginif (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 dofor 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;
beginif (X >= 0) and (X < BI.bmiHeader.biWidth) and
(Y >= 0) and (Y < BI.bmiHeader.biHeight) then
Result := PRGB(PB + (Y) * FLineSize + X * 3)
else
Result := PRGB(PB);
end;
Если у вас на форме есть компонент TImage, то можно сделать так:
var BMP:TMBitmap;
B: TBitmap;
...
BMP.LoadFromFile(..);
B:=TBitmap.Create;
B.Handle:=BMP.Handle;
Image1.Picture.Bitmap:=B;
и загруженный битмэп появится на экране.
Как из Handle битовой картинки, получить адрес битового изображения в памяти.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.