Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Курс видеоуроков КРЭКЕРСТВО + ПРОГРАММИРОВАНИЕ 2017
(актуальность: апрель 2017)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как из Handle битовой картинки, получить адрес битового изображения в памяти

Автор: Nomadic

Вот кусок одного моего класса, в котором есть две интересные вещицы - проецирование файлов в память и работа с битмэпом в памяти через указатель.

Сразу оговорюсь, что все это работает только под 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 (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;
 

и загруженный битмэп появится на экране.




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS