Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Вниз

GetDIBBits - нот а гуд!!!   Найти похожие ветки 

 
WondeRu ©   (2004-04-29 10:13) [0]

Здравствуйте!

При вызове GetDIBBits, если изображение больше 64 кб (не точно), происходит отшибка и массив битов, не инициализируется!

Как решить данную проблему? Если ли альтернатива данной функции для больших картинок?

Спасибо!


 
MBo ©   (2004-04-29 11:03) [1]

Код?


 
WondeRu ©   (2004-04-29 11:27) [2]

Сам напросился)))


function TAPlan.PrepareImage(BitMapTemp: TBitmap): Boolean;
 function FindNearest(Value: Integer): Integer;
 var
   i : Integer;
   x1, x2, x3 : Integer;
 begin
   Result := 1024;
   for i := 2 to 11 do
     begin
       x1 := Round(Power(2,i - 1)) - Value;
       x2 := Round(Power(2,i    )) - Value;
       x3 := Round(Power(2,i + 1)) - Value;
       if (x1 <= 0) and (x3 >= 0) and (x2>=0)
         then
           begin
             Result := Round(Power(2, i));
             Break;
           end;
     end;
 end;

var
 Data         : array of Byte;
 P            : Pointer;
 Bitmap       : TBitmap;
 LittleBMP    : TBitmap;
 i, tmpCount  : Integer;
 BMInfo       : TBitmapInfo;
 MemDC        : HDC;
 Size         : DWORD;
 tmp, j       : Integer;
 tmpColor     : TColor;
begin
 Result := True;
 try
   Bitmap := TBitmap.Create;
   Bitmap.PixelFormat := pf32bit;

   Bitmap.Width  := FindNearest(BitmapTemp.Width);
   Bitmap.Height := FindNearest(BitmapTemp.Height);
   GetLastError;
   SetStretchBltMode(dc,HALFTONE);
 
   if not StretchBlt(Bitmap.Canvas.Handle,     // handle to destination DC
                     0,                        // x-coord of destination upper-left corner
                     0,                        // y-coord of destination upper-left corner
                     Bitmap.Width,             // width of destination rectangle
                     Bitmap.Height,            // height of destination rectangle
                     BitmapTemp.Canvas.Handle, // handle to source DC
                     0,                        // x-coord of source upper-left corner
                     0,                        // x-coord of source upper-left corner
                     BitmapTemp.Width,         // width of source rectangle
                     BitmapTemp.Height,        // height of source rectangle
                     SRCCOPY)                  // raster operation code
     then  ShowError(True,"StretchBlt");

   BitMapTemp.Canvas.Pixels[0,0];

   fxmin := 0;
   fxmax := BitmapTemp.Width;
   fymin := 0;
   fymax := BitmapTemp.Height;

   MemDC := CreateCompatibleDC(0);
   GetLastError;

   try
     try
       SetLength(Data, Bitmap.Width * Bitmap.Height * 3);
       GetLastError;
     except
       on e: Exception do
         begin
           OutputDebugString(PChar("TAPlan.PrepareImage1 in uPlanClass with message: " + e.Message));
           GrEvents.OnError("Ошибка выделения памяти для текстуры");
           Exit;
         end;
     end;

     tmpCount := Bitmap.Height div 16;
     for i := 0 to tmpCount - 1 do
       begin
         LittleBMP := TBitmap.Create;
         try
           LittleBMP.Width  := Bitmap.Width;
           LittleBMP.Height := 16;

           BitBlt(LittleBMP.Canvas.Handle,        // handle to destination DC
                  0,                              // x-coord of destination upper-left corner
                  0,                              // y-coord of destination upper-left corner
                  LittleBMP.Width,                // width of destination rectangle
                  LittleBMP.Height,               // height of destination rectangle
                  Bitmap.Canvas.Handle,           // handle to source DC
                  0,                              // x-coordinate of source upper-left corner
                  LittleBMP.Height * i,           // y-coordinate of source upper-left corner
                  SRCCOPY);                       // raster operation code

           FillChar (BMInfo, SizeOf(BMInfo), 0);
           with BMinfo.bmiHeader do
             begin
               biSize        := sizeof(TBitmapInfoHeader);
               biBitCount    := 24;
               biWidth       := LittleBMP.Width;
               biHeight      := LittleBMP.Height;
               biPlanes      := 1;
               biCompression := BI_RGB;

               tmp := (Bitmap.Width * Bitmap.Height - LittleBMP.Height * LittleBMP.Width * (i +1)) * 3;

               if  GetDIBits (MemDC,
                              LittleBMP.Handle,
                              0,
                              biHeight,
                              @Data[tmp],
                              BMInfo,
                              DIB_RGB_COLORS) = 0
                 then
                   try
                     //если GetDIBits завершилась ошибкой, то применяем более медленную модель
                     for j := 0 to  LittleBMP.Height * LittleBMP.Width - 1 do
                       begin
                         tmpColor := LittleBMP.Canvas.Pixels[j mod LittleBMP.Height, j div LittleBMP.Height];
                         try
                         Data[tmp + j * 3    ] := GetBValue(tmpColor);
                         Data[tmp + j * 3 + 1] := GetGValue(tmpColor);
                         Data[tmp + j * 3 + 2] := GetRValue(tmpColor);
                         except
                          // asm
                          //   nop
                          // end;
                         end;
                       end;
                   except
                     on e: Exception do
                       OutputDebugString(PChar(IntTostr(tmp + j * 3) + " TAPlan.PrepareImage.GetDIBits in uPlanClass with message: " + e.Message));
                   end;
             end;
         finally
           LittleBMP.Free;
         end;
       end;
       GetLastError;

       DeleteDC (MemDC);

   finally
     SetLength(Data,0);
     Data := nil;
     Bitmap.Free;
   end;
 except
   on e: Exception do
     OutputDebugString(PChar("TAPlan.PrepareImage3 in uPlanClass with message: " + e.Message));
 end;
end;



 
MBo ©   (2004-04-29 12:09) [3]

;) Да уж, удружил

LittleBMP - какого типа - DIB или DDB?
Какой Pixelformat?
Уверен, что в Data хватает места?

Если нет уверенности, что правмльно заполняешь BMinfo.bmiHeader, стоит вызвать GetDiBits сначала с nil вместо буфера - она сама инициализирует BMinfo.


 
MBo ©   (2004-04-29 12:20) [4]

кроме того - GetDIBits (MemDC...
А LittleBMP не выбраны в нем. Видимо, формат совпадает с экранным, однако стоит LittleBMP.Canvas.Handle использовать для надежности


 
WondeRu ©   (2004-04-29 12:21) [5]

2MBo ©   (29.04.04 12:09) [3]

Как ты понял, если просмотрел все, есть большая картинка, я ее разбиваю на куски по 64к и пытаюсь выдрать биты (когда всю картинку берешь 50% что GetDibits не сработает), но все равно иногда происходят ошибки!

LittleBMP DDB (делфовсий TBitmap);

Data хватает;

PixelFormat:
 Bitmap.PixelFormat := pf32bit;


 
MBo ©   (2004-04-29 12:27) [6]

LittleBMP делай DIB явным указанием PixelFormat

У меня не было проблем с Get/SetDiBits для картинок порядка 1280*1024


 
WondeRu ©   (2004-04-29 12:27) [7]

>А LittleBMP не выбраны в нем. Видимо, формат совпадает с экранным, однако стоит LittleBMP.Canvas.Handle использовать для надежности

Это при инициализации MemDC?

Еще не совсем протестировал, но вставив код после  LittleBMP := TBitmap.Create :

LittleBMP.PixelFormat := pf32bit;

ВРОДЕ заработало корректно, возможно!


 
WondeRu ©   (2004-04-29 12:33) [8]

>LittleBMP делай DIB явным указанием PixelFormat

каким образом? КАк в [7]?

Спасибо!


 
MBo ©   (2004-04-29 12:36) [9]

>каким образом? КАк в [7]?
Да. (можно еще HandleType:=bmDib, но тогда PixelFormat будет зависеть от установленного режима экрана, что с точки зрения переносимости нехорошо)



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.037 c
14-1083007266
GEN++
2004-04-26 23:21
2004.05.16
Раскинем карты и ...... погадаем.


4-1080740994
Lobster
2004-03-31 17:49
2004.05.16
Как добавить русский язык в Windows?


14-1083088242
vic_vm
2004-04-27 21:50
2004.05.16
Хорошие англоязычные сайты по Delphi


1-1083219223
GIL
2004-04-29 10:13
2004.05.16
Форма хочет быть неполноценной MDI


3-1082443117
denmin
2004-04-20 10:38
2004.05.16
Как узнать тип поля таблицы?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский