How to create a TImageList that can handle 32bit color images

Mirror

How to create a TImageList that can handle 32bit color images (Views: 31)

Problem/Question/Abstract:

I need a TImagelist which can handle 32 bit color images for WinXP Truecolor support (if I don't use this I get black borders around alpha blended system images, like folders etc.). Can be done like this (Handle is the handle of an existing TImagelist):

Handle := ImageList_Create(16, 16, ILC_COLOR32 or ILC_MASK, 0, 4);

But how can this be done in a TImagelist descendant (I am using already one for other reasons)? If I do this in the constructor it is too early - still black borders. And although HandleNeeded is protected it is not virtual. It calls CreateImageList but this is private. To make this more "interesting", I have also some images already in there which must not get lost when the imagelist (handle) is replaced. What is the easiest way to copy those images from the old list (with DDB colors) to the new one (with 32 bit colors)?

Answer:

Probably, you can recreate the imagelist's handle in the TImageList's Change method. It's virtual and always get called after handle was changed. Also, you'll need a proxy class to get to the private FHandle variable. See the example listed below. I'm not sure will it work right or not, as I don't have a WinXP and therefore can't see any black borders you were talking about.

In order to copy images form one list to another, you can use a TImageList's Assign or AddImages methods. In your case you can create a local imagelist, assign images to it, then do handle changing and then return images back.

{ ... }
TTestImageList = class(TImageList)
protected
  FHandle32: HImageList;
  FUpdateCount: integer;
  procedure Initialize; override;
  procedure Change; override;
end;

{ ... }

{$HINTS OFF}
type
  TProxyTestImageList = class(TComponent)
  private
    FHeight: Integer;
    FWidth: Integer;
    FAllocBy: Integer;
    FHandle: HImageList;
  end;
{$HINTS ON}

procedure TTestImageList.Initialize;
begin
  FUpdateCount := 0;
  inherited Initialize;
end;

procedure TTestImageList.Change;
var
  XImageList: TImageList;
begin
  if FUpdateCount > 0 then
    exit;
  if FHandle32 <> TProxyTestImageList(Self).FHandle then
  begin
    inc(FUpdateCount);
    try
      XImageList := TImageList.Create(nil);
      try
        if TProxyTestImageList(Self).FHandle <> 0 then
        begin
          XImageList.Assign(Self);
          if FHandle32 <> 0 then
            ImageList_Destroy(FHandle32);
          FHandle32 := ImageList_Create(Width, Height, ILC_COLOR32 or ILC_MASK, AllocBy, AllocBy);
          ImageList_Destroy(TProxyTestImageList(Self).FHandle);
          TProxyTestImageList(Self).FHandle := FHandle32;
          Assign(XImageList);
        end
        else if FHandle32 <> 0 then
        begin
          ImageList_Destroy(FHandle32);
          FHandle32 := 0;
        end;
      finally
        XImageList.Free;
      end;
    finally
      dec(FUpdateCount);
    end;
  end;
  inherited Change;
end;

<< Back to main page