Наследник TImageList

← →
Gero © (2004-08-26 22:21) [0]

Взялся я писать наследника TImageList, с целью включить в него поддержку 32-битных иконок.
Для этого нужно переписать несколько его методов, например Draw.
Задача казалась мне простой, пока я не увидел, что все методы, которые подлежат переделке, не-virtual.
Не знаю, почему парни из Borland решили сделать так, но это так.

Идеальным вариантом конечно было бы написать новый ImageList, но тогда возникнет проблема с его использованием: ведь свойство Images у компонентов не захочет принимать чужой ImageList.
Можно конечно делать OwnerDraw для всех контролов использующих ImageList, но это большой гемор.

Как в этом случае лучше всего поступить?
Очень надеюсь на вашу помощь, господа форумчане.

← →
slym (2004-08-27 06:02) [1]

procedure TCustomImageList.CreateImageList;
const
Mask: array[Boolean] of Longint = (0, ILC_MASK);
begin
FHandle := ImageList_Create(Width, Height, ILC_COLORDDB or Mask[Masked],
AllocBy, AllocBy);
if not HandleAllocated then raise EInvalidOperation.Create(SInvalidImageList);
if FBkColor <> clNone then BkColor := FBkColor;
end;

Скопируй ImgList.pas в папку проекта
замени ILC_COLORDDB на ILC_COLOR32 и радуйся

← →
Slym (2004-08-27 07:49) [2]

Первый вариант не работает....
Нашел!!!

function TCustomImageList.InternalGetInstRes(Instance: THandle;
ResType: TResType; Name: PChar; Width: Integer; LoadFlags: TLoadResources;
MaskColor: TColor): Boolean;
const
ResMap: array [TResType] of Integer = (IMAGE_BITMAP, IMAGE_CURSOR, IMAGE_ICON);
var
hImage: HImageList;
Flags: Integer;
begin
Flags := 0; //замени на LR_CREATEDIBSECTION;
if lrDefaultColor in LoadFlags then Flags := Flags or LR_DEFAULTCOLOR;
if lrDefaultSize in LoadFlags then Flags := Flags or LR_DEFAULTSIZE;
if lrFromFile in LoadFlags then Flags := Flags or LR_LOADFROMFILE;
if lrMap3DColors in LoadFlags then Flags := Flags or LR_LOADMAP3DCOLORS;
if lrTransparent in LoadFlags then Flags := Flags or LR_LOADTRANSPARENT;
if lrMonoChrome in LoadFlags then Flags := Flags or LR_MONOCHROME;
hImage := ImageList_LoadImage(Instance, Name, Width, AllocBy, MaskColor,
ResMap[ResType], Flags);
if hImage <> 0 then
begin
CopyImages(hImage);
ImageList_Destroy(hImage);
Result := True;
end
else Result := False;
end;

> Slym (27.08.04 07:49)

Ну и что это?

Наследник TImageList Найти похожие ветки