Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > Иконки в ImageList


Автор: former 30.5.2007, 21:53
Столкнусля с проблемой отображения 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;

Автор: pseud 31.5.2007, 09:41
former, 
Т.е. ты 
1. сначала запихал картинки в ImageList.
2. они хоть и были 32бит, но стали 24бит.
3. Потом ты заюзал процедуру ConvertTo32BitImageList и картинки стали 32бит.

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

Автор: former 31.5.2007, 14:53
Цитата
pseud, Но альфа-канал уже был потерян на 2м шаге и 3й шаг - бессмысленен. 


Нет pseud. 

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

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

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

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

Этот метод я на шёл http://qc.borland.com/wc/qcmain.aspx?d=4653, но он не работает у меня, почему-то.

Автор: pseud 31.5.2007, 15:12
Цитата

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. 

Автор: former 31.5.2007, 15:25
pseud, это я не внимательно читал. А как в Run-Time их добавлять? Из ресурсов если только. Или есть другой метод?

Автор: pseud 31.5.2007, 15:36
да. правильнее всего из ресурсов.
сам давно хочу побороть этот ImageList, но руки не доходят.
поборешь - выкладывай smile 

Автор: former 31.5.2007, 17:12
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.

Автор: pseud 31.5.2007, 17:25
former. Супер, возьму на вооружение.

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


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

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

Автор: former 31.5.2007, 17:38
Согласен. Да и пользователь в основном используют XP и Vista.

Цитата

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


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

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

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)