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

Версия для печати

VCL.TBitmap.Утечка ресурсов в режиме 256 цветов
http://www.delphikingdom.com/asp/viewitem.asp?catalogID=1117
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; все вышеизложенное в полной мере относится и к этой версии.

Типовые решения

Попробуйте заменить конструкцию try...except на try...finally (см.исходный код метода TBitmap.CopyImage).
Не используйте в 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 приводит к тому, что битмап лишается хэндлов сразу после создания, что не есть хорошо. Однако, это исправление решает проблему.

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