VPF::Bitmap в Icon - Форум программистов

stsm

Дата 22.3.2008, 21:58 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.10.2007

Репутация: нет
Всего: нет

Выручайте, нужно для анимации сделать быстрое преобразование из bmp в ico. Делаю это через TCustomImageList.

Код


function BMPconvICO(BMP: TBitmap):TIcon;
begin 
  with TCustomImageList.CreateSize(BMP.Width, BMP.Height) do
  begin 
    try
      AddMasked(BMP, clblack);
      Result := TIcon.Create;
      try
        GetIcon(0, Result);
      except 
        Result.Free; 
        raise; 
      end; 
    finally 
      Free;
    end; 
  end; 
end;

Проблема в том, что создаются TIcon'ы, рисуются один за другим, но не освобождаются и из-за этого прога начинает кушать много памяти.

Это сообщение отредактировал(а) stsm - 22.3.2008, 21:59

VICTAR

Дата 22.3.2008, 22:05 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 2
Всего: 80

В drkb статья BMP ---> ICO

stsm

Дата 22.3.2008, 22:10 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.10.2007

Репутация: нет
Всего: нет

читал, получался тот же эффект поедания памяти :(

Это сообщение отредактировал(а) stsm - 22.3.2008, 23:02

Alexeis

Дата 23.3.2008, 12:39 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(stsm @ 22.3.2008, 20:58

)

Проблема в том, что создаются TIcon'ы, рисуются один за другим, но не освобождаются и из-за этого прога начинает кушать много памяти.

Кто ж в этом виноват? smile

В Delphi for Win32 память нужно самому освобождать. Функция BMPconvICO вернула иконку, поюзали, затем удалили.
Кроме того AddMasked - битмапка добавлена, но не удалена.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Alix

Дата 23.3.2008, 14:15 (ссылка)

(нет голосов)

Загрузка ...

L45

Профиль
Группа: Участник
Сообщений: 581
Регистрация: 4.5.2005
Где: Pskov/Spb

Репутация: 1
Всего: 23

я когда-то делал так:

Код

type
  TTrayIcon = class
  private
    ...
    fIcon    : HICON;        // current icon (frame)
    ...
  end;

...

// Creates icon 16x16 from source bitmap with offset
procedure TTrayIcon.createIcon(source: TBitmap; xOffset, yOffset : integer);
var
  transparent : TColor;      // цвет, считающийся прозрачным
  andBmp,                    // "AND" - маска изображения
  xorBmp      : TBitmap;     // "XOR" - маска цвета
  iconinfo    : TIconInfo;

begin
  // не забываем удалять старую иконку
  if fIcon <> 0 then
    DestroyIcon(fIcon);
  
  // прозрачным будет цвет левого верхнего пикселя
  transparent := source.Canvas.Pixels[0, 0];

  // создаем "AND" - маску
  andbmp := TBitmap.Create;
  andbmp.Width  := 16;
  andbmp.Height := 16;
  andbmp.Monochrome := true;
  setbkcolor(source.Canvas.Handle, colortorgb(transparent));
  bitblt(andbmp.Canvas.Handle, 0, 0, 16, 16,
         source.canvas.Handle, xOffset, yOffset, SRCCOPY);

  // создаем "XOR" - маску
  xorbmp := TBitmap.Create;
  xorbmp.Width  := 16;
  xorbmp.Height := 16;
  SetBkColor(xorbmp.canvas.Handle, colortorgb(transparent));
  bitblt(xorbmp.Canvas.Handle, 0, 0, 16, 16,
         andbmp.canvas.Handle, 0, 0, SRCCOPY);
  bitblt(xorbmp.Canvas.Handle, 0, 0, 16, 16,
         source.Canvas.Handle, xOffset, yOffset, SRCINVERT);

  // создаем иконку на основе наших масок
  iconInfo.fIcon    := true;
  iconInfo.xHotspot := 0;
  iconInfo.yHotspot := 0;
  iconInfo.hbmMask  := andbmp.Handle;
  iconInfo.hbmColor := xorbmp.Handle;
  fIcon := createIconIndirect(iconInfo);

  xorbmp.Free;
  andbmp.Free;
end;

Добавлено через 1 минуту и 39 секунд
Сделано по материалам, я точно помню, статьи из delphi world, которая потом, судя по ответу VICTAR перекочевала в drkb. Надеюсь, привести пример к TIcon сможешь?

--------------------

Знание только тогда знание, когда оно приобретено усилиями своей мысли, а не памятью (с) Л. Толстой
High tech. Low live. (с) Gardner Dozois

stsm

Дата 23.3.2008, 18:16 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 24.10.2007

Репутация: нет
Всего: нет

Вот!!!

Спасибо всем!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »