Rambler's Top100
"Knowledge itself is power"
F.Bacon
Поиск | Карта сайта | Помощь | О проекте | ТТХ  
 Подводные камни
  
О разделе

Список по категориям
Общий список

 
 К н и г и
 
Книжная полка
 
 
Библиотека
 
  
  
 


Поиск
 
Поиск по КС
Поиск в статьях
Яndex© + Google©
Поиск книг

 
  
Тематический каталог
Все манускрипты

 
  
Карта VCL
ОШИБКИ
Сообщения системы

 
Форумы
 
Круглый стол
Новые вопросы

 
  
Базарная площадь
Городская площадь

 
   
С Л С

 
Летопись
 
Королевские Хроники
Рыцарский Зал
Глас народа!

 
  
ТТХ
Конкурсы
Королевская клюква

 
Разделы
 
Hello, World!
Лицей

Квинтана

 
  
Сокровищница
Подземелье Магов
Подводные камни
Свитки

 
  
Школа ОБЕРОНА

 
  
Арсенальная башня
Фолианты
Полигон

 
  
Книга Песка
Дальние земли

 
  
АРХИВЫ

 
 

Сейчас на сайте присутствуют:
 
  
 
Во Флориде и в Королевстве сейчас  22:09[Войти] | [Зарегистрироваться]

VCL.TBitmap.Утечка ресурсов в режиме 256 цветов

Cepгей Poщин
дата публикации 11-02-2005 04:01

КАТЕГОРИЯБИБЛИОТЕКА.VCL.TBitmap.Утечка ресурсов в режиме 256 цветов
ПРОДУКТDelphi
ПЛАТФОРМА


При создании и разрушении изображений TBitmap в режиме 256 цветов происходит утечка памяти, что наблюдалось в Windows 2000 и Windows 98. При работе с 4- и 24-битными изображениями утечки не наблюдается. Предлагаю вашему вниманию программу, которая демонстрирует проявление этой проблемы. Обычно это не вызывает проблем и вряд ли повлечет нехватку системных ресурсов, но в некоторых случаях может приводить к необъяснимым ошибкам в Win98.

Например: моя программа (давно работающая и вполне отлаженная) на некоторых компьютерах при запуске "завешивала" компьютер (переставал двигаться курсор, работал только reset), на других это происходило при втором запуске программы, на некоторых работала нормально (включая, естественно, мой рабочий комп). Переустановка системы не помогла, хотя всё очень походило на работу недописанного вируса. Никаких ошибок отладка не выявила. Как оказалось, в разделе initialization одного из модулей программы загружалась из ресурса картинка, а затем удалялась. Программа работала нормально, пока картинка в ресурсе была записана в формате 24 bit. Когда я изменил формат на 8 bit, началось описанное поведение программы, примерно на половине компьютеров работающих под windows 98. Файл ресурсов создавался с помощью программы Restorator. Программа написана на Delphi 7.

Возможно, ошибка кроется в методе TBitmap.CopyImage (см. модуль Graphics). Параметр APalette - это описатель палитры. Переменная SystemPalette16 содержит описатель системной 16-цветной палитры, и присваивается в процедуре InitScreenLogPixels, которая вызывается в разделе initialization. Если параметр APalette равен SystemPalette16, что наблюдается в 4-битном изображении, то переменная NewPalette просто получает значение APalette. В противном случае вызывается метод CopyPalette, который создает новую палитру и возвращает её описатель, причем, если входной параметр равен нулю (в случае 32-битного изображения) ничего не происходит (см. функцию CopyPalette). Т.о. в режиме 8-бит создается новая палитра, которая уничтожается только в случае возникновения ошибки вызовом метода InternalDeletePalette, а если ошибки не происходит, то созданная палитра не уничтожается, а её описатель теряется.

procedure TBitmap.CopyImage(AHandle: HBITMAP; APalette: HPALETTE; DIB: TDIBSection);
var
  NewHandle, NewPalette: THandle;
begin
  FreeContext;
  NewHandle := 0;
  NewPalette := 0;
  try
    if APalette = SystemPalette16 then
      NewPalette := APalette
    else
      NewPalette := CopyPalette(APalette);
    NewHandle := CopyBitmap(AHandle, APalette, NewPalette, DIB, FCanvas);
    NewImage(NewHandle, NewPalette, DIB, FImage.FOS2Format);
  except    //попробуйте заменить на finally
    InternalDeletePalette(NewPalette);
    if NewHandle <> 0 then DeleteObject(NewHandle);
    raise;  //а эту строку закомментируйте
  end;
end;

function CopyPalette(Palette: HPALETTE): HPALETTE;
var
  PaletteSize: Integer;
  LogPal: TMaxLogPalette;
begin
  Result := 0;
  if Palette = 0 then Exit;
  PaletteSize := 0;
  if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
  if PaletteSize = 0 then Exit;
  with LogPal do
  begin
    palVersion := $0300;
    palNumEntries := PaletteSize;
    GetPaletteEntries(Palette, 0, PaletteSize, palPalEntry);
  end;
  Result := CreatePalette(PLogPalette(@LogPal)^);
end;

procedure InternalDeletePalette(Pal: HPalette);
begin
  if (Pal <> 0) and (Pal <> SystemPalette16) then
    DeleteObject(Pal);
end;
P.S. Поставил Delphi 2005; все вышеизложенное в полной мере относится и к этой версии.


Типовые решения
  1. Попробуйте заменить конструкцию try...except на try...finally (см.исходный код метода TBitmap.CopyImage).
  2. Не используйте в runtime 8 битные изображения. Лучше замените их на 24 битные.



Дополнительные ссылки и прилагаемые файлы
Скачать пример: StoneTest_80.zip


Комментарий
Действительно, тестовый пример обнаруживает утечку тесурсов GDI при создании/освобождении TBitmap с PixelFormat = pf8bit, по одному хэндлу на каждую итерацию. Когда количество объектов GDI, занятых приложением, доходит до 10000 (Win2000), то начинаются глюки в интерфейсе и выскакивает сообщение о системной ошибке с кодом 87 "Parameter is incorrect".

Анализ исходников TBitmap показывает, что хэндлы битмапы и палитры после NewImage принадлежат FImage:TBitmapImage и корректно освобождаются при уничтожении TBitmap или любой операции с заменой картинки. Но при отладке с трассировкой модуля Graphics видно, что один из вызовов DeleteObject с хэндлом палитры отрабатывает с ошибкой (функция возвращает 0). Причина этого неясна. Вызов GetLastError дает код 8, что соответствует ERROR_NOT_ENOUGH_MEMORY.

Предлагаемое автором решение заменить except на finally приводит к тому, что битмап лишается хэндлов сразу после создания, что не есть хорошо. Однако, это исправление решает проблему.


Смотрите также материалы по темам:




 Обсуждение материала [ 19-03-2006 14:45 ] 7 сообщений
  
Время на сайте: GMT минус 5 часов

Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter.
Функция может не работать в некоторых версиях броузеров.

Web hosting for this web site provided by DotNetPark (ASP.NET, SharePoint, MS SQL hosting)  
Software for IIS, Hyper-V, MS SQL. Tools for Windows server administrators. Server migration utilities  

 
© При использовании любых материалов «Королевства Delphi» необходимо указывать источник информации. Перепечатка авторских статей возможна только при согласии всех авторов и администрации сайта.
Все используемые на сайте торговые марки являются собственностью их производителей.

Яндекс цитирования