Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Иконки в ImageList 
V
    Опции темы
former
Дата 30.5.2007, 21:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


MEMS Expert
***


Профиль
Группа: Завсегдатай
Сообщений: 1166
Регистрация: 1.3.2006
Где: Россия

Репутация: 4
Всего: 17
Столкнусля с проблемой отображения 32-битных иконок в ImageList и на ActionMainMenuBar, ActionToolBar, PopMenu и т.д. и т.п.

Пробовал следующую процедуру, но помогла только в диалоге выбора иконки ImageList-а.

Код

procedure ConvertTo32BitImageList(const ImageList: TImageList);
const
  Mask: array[Boolean] of Longint = (0, ILC_MASK);
var
  TempList: TImageList;
begin
  if Assigned(ImageList) then
  begin
    TempList := TImageList.Create(nil);
    try
      TempList.Assign(ImageList);
      with ImageList do
      begin
        Handle := ImageList_Create(
          Width, Height, ILC_COLOR32 or Mask[Masked], 0, AllocBy);

        if not HandleAllocated then
          raise EInvalidOperation.Create(SInvalidImageList);
      end;

      Imagelist.AddImages(TempList);
    finally
      FreeAndNil(TempList);
    end;
  end;
end;





--------------------
Достаточно снизить уровень мышления, чтобы иные почувствовали почву под ногами.
PM MAIL   Вверх
pseud
Дата 31.5.2007, 09:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
former, 
Т.е. ты 
1. сначала запихал картинки в ImageList.
2. они хоть и были 32бит, но стали 24бит.
3. Потом ты заюзал процедуру ConvertTo32BitImageList и картинки стали 32бит.

Но альфа-канал уже был потерян на 2м шаге и 3й шаг - бессмысленен.


--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
former
Дата 31.5.2007, 14:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


MEMS Expert
***


Профиль
Группа: Завсегдатай
Сообщений: 1166
Регистрация: 1.3.2006
Где: Россия

Репутация: 4
Всего: 17
Цитата
pseud, Но альфа-канал уже был потерян на 2м шаге и 3й шаг - бессмысленен. 


Нет pseud. 

1) Поместил на форму ImageList.

2) Добавил процедуру ConvertTo32BitImageList.

3) Откомпилировал.

4) Попытался добаить иконки.

Этот метод я на шёл здесь, но он не работает у меня, почему-то.


--------------------
Достаточно снизить уровень мышления, чтобы иные почувствовали почву под ногами.
PM MAIL   Вверх
pseud
Дата 31.5.2007, 15:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
Цитата

Run the following procedure *before* adding any icons to the image list (add Consts and CommCtrl units to the uses clause; also add XP manifest to your project):


следовательно
1. Подключили манифест
2. Запустили прогу
3. Вызвали в ней процедуру ConvertTo32BitImageList
4. Добавили видимо в Run-Time рисунки с альфа-каналом
5. юзаем

и все как я понимаю в Run-Time

Добавлено через 2 минуты и 56 секунд

Танец с бубном блин.
Кстати если запустить потом такое приложение в винде ниже XP.
То получим то, что и пишут IMHO:
Цитата

Windows XP icons don't show up correctly in TImageList. They get black outline when displayed. 



--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
former
Дата 31.5.2007, 15:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


MEMS Expert
***


Профиль
Группа: Завсегдатай
Сообщений: 1166
Регистрация: 1.3.2006
Где: Россия

Репутация: 4
Всего: 17
pseud, это я не внимательно читал. А как в Run-Time их добавлять? Из ресурсов если только. Или есть другой метод?


--------------------
Достаточно снизить уровень мышления, чтобы иные почувствовали почву под ногами.
PM MAIL   Вверх
pseud
Дата 31.5.2007, 15:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
да. правильнее всего из ресурсов.
сам давно хочу побороть этот ImageList, но руки не доходят.
поборешь - выкладывай smile 


--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
former
Дата 31.5.2007, 17:12 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


MEMS Expert
***


Профиль
Группа: Завсегдатай
Сообщений: 1166
Регистрация: 1.3.2006
Где: Россия

Репутация: 4
Всего: 17
pseud, в XP получилось. (См. ниже) А в ранних версиях надо пробовать.

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, XPMan, ImgList, Consts, CommCtrl, StdCtrls;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    XPManifest1: TXPManifest;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure ChangeIcons(IconNum:integer; ImageList:TImageList);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R icons.RES}

procedure ConvertTo32BitImageList(const ImageList: TImageList);
const
  Mask: array[Boolean] of Longint = (0, ILC_MASK);
var
  TempList: TImageList;
begin
  if Assigned(ImageList) then
  begin
    TempList := TImageList.Create(nil);
    try
      TempList.Assign(ImageList);
      with ImageList do
      begin
        Handle := ImageList_Create(
          Width, Height, ILC_COLOR32 or Mask[Masked], 0, AllocBy);

        if not HandleAllocated then
          raise EInvalidOperation.Create(SInvalidImageList);
      end;

      Imagelist.AddImages(TempList);
    finally
      FreeAndNil(TempList);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  ConvertTo32BitImageList(ImageList1);
  for i:=1 to 4 do ChangeIcons(i,ImageList1);
end;

//---Ïðîöåäóðà çàãðóçêè èêîíîê
procedure TForm1.ChangeIcons(IconNum:integer; ImageList:TImageList);
var CLC:TIcon;
    ResStream : TResourceStream;
begin
  try
    CLC:=TIcon.Create;
    ResStream := TResourceStream.CreateFromID(HInstance, IconNum,RT_RCDATA);
    CLC.LoadFromStream(ResStream);
    ImageList.AddIcon(CLC);
  finally
    CLC.Free;
    ResStream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
  for i:=1 to 4 do ChangeIcons(i,ImageList1);
end;

end.



--------------------
Достаточно снизить уровень мышления, чтобы иные почувствовали почву под ногами.
PM MAIL   Вверх
pseud
Дата 31.5.2007, 17:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
former. Супер, возьму на вооружение.

Насчет других виндов - IMHO можно не беспокоиться. 
Они впринципе не поддерживают альфа-канал. 
Ведь не зря тут и там говоря об 32битных иконках используют выражение Windows XP icons .


P.S. Перед тем как копировать в буфер переходи на русский язык, чтоб не получалось такого:
Цитата

//---Ïðîöåäóðà çàãðóçêè èêîíîê




--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
former
Дата 31.5.2007, 17:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


MEMS Expert
***


Профиль
Группа: Завсегдатай
Сообщений: 1166
Регистрация: 1.3.2006
Где: Россия

Репутация: 4
Всего: 17
Согласен. Да и пользователь в основном используют XP и Vista.

Цитата

P.S. Перед тем как копировать в буфер переходи на русский язык


Спасибо. Учту.

Добавлено через 25 секунд
Тема закрыта.


--------------------
Достаточно снизить уровень мышления, чтобы иные почувствовали почву под ногами.
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0856 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.