Ugly Images of Disabled Menu Items in Delphi

Ever used 32bit images stored in TImageList in your Delphi application? Toolbars and some other VCL controls have DisabledImages property which is automatically used to get images for disabled toolbar buttons. But what about menu components? They don't have this property and drawing of disabled images is handled by TImageList with original enabled images (TMainMenu.Images property). And the results are really abysmal. How can this be fixed?

One way is to override DoDraw method of TImageList and change the code that draws disabled images. You can do regular RGB to grayscale conversion here or let  Windows draw it for you in grayscale with nearly no work on your part. You can do this by using ImageList_DrawIndirect with ILS_SATURATE parameter. Note that this works only on Windows XP and newer and for 32bit images only. For older targets or color depths doing your own RGB->grayscale conversion is an option (good idea would probably be to cache converted grayscale images somewhere so they won't need to be converted on every draw call).

Here's the code of DoDraw method using  ILS_SATURATE:

type
// Descendant of regular TImageList
TSIImageList = class(TImageList)
protected
  procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
    Style: Cardinal; Enabled: Boolean = True); override;
end;

procedure TSIImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
  Style: Cardinal; Enabled: Boolean);
var
  Options: TImageListDrawParams;

  function GetRGBColor(Value: TColor): Cardinal;
  begin
    Result := ColorToRGB(Value);
    case Result of
      clNone: Result := CLR_NONE;
      clDefault: Result := CLR_DEFAULT;
    end;
  end;

begin
  if Enabled or (ColorDepth <> cd32Bit) then
    inherited
  else if HandleAllocated then
  begin
    FillChar(Options, SizeOf(Options), 0);
    Options.cbSize := SizeOf(Options);
    Options.himl := Self.Handle;
    Options.i := Index;
    Options.hdcDst := Canvas.Handle;
    Options.x := X;
    Options.y := Y;
    Options.cx := 0;
    Options.cy := 0;
    Options.xBitmap := 0;
    Options.yBitmap := 0;
    Options.rgbBk := GetRGBColor(BkColor);
    Options.rgbFg := GetRGBColor(BlendColor);
    Options.fStyle := Style;
    Options.fState := ILS_SATURATE; // Grayscale for 32bit images

    ImageList_DrawIndirect(@Options);
  end;
end;

Important note: For ILS_SATURATE to work correctly source image files must be 32bit with proper alpha channel data, setting color depth of TImageList to 32bit is not enough! If you don't see any images drawn this is probably the cause: 8/24bit image is loaded from file and then inserted into 32bit TImageList. As there is no alpha channel data in source image it is drawn as fully transparent so you don't see anything.

http://msdn.microsoft.com/en-us/library/bb761537(VS.85).aspx

5 thoughts on “Ugly Images of Disabled Menu Items in Delphi

  1. Great post, I think this is a bug in Delphi RTL, and should be reported in QC.

    Thank you for the work around.

    • Drawing of disabled images in default VCL TImageList is probably from the times of 4bit 16 color icons, maybe it worked ok for those.
      I’m not sure reporting this to QC would help. Check QC item 50191 for example – basically the same problem was described
      and the issue was closed with “As designed” resolution.

  2. Many thanks for this. Until now I have been performing my own grey scaling but this is a great improvement. I think that the code can be somewhat simplified though. For my needs at least the following sufficed:

    procedure DrawDisabledImage(DC: HDC; ImageList: TCustomImageList; Index, X, Y: Integer);
    var
    Options: TImageListDrawParams;
    begin
    ZeroMemory(@Options, SizeOf(Options));
    Options.cbSize := SizeOf(Options);
    Options.himl := ImageList.Handle;
    Options.i := Index;
    Options.hdcDst := DC;
    Options.x := X;
    Options.y := Y;
    Options.fState := ILS_SATURATE;
    ImageList_DrawIndirect(@Options);
    end;

Leave a Reply to Warren P. Cancel reply

Your email address will not be published. Required fields are marked *