TVirtualExplorerTree Icons

[RenaldoGlobe]

Folder Icons vanish, while the VirtualExplorerTree is disabled. Using Delphi 11.1 and Windows 10 21H2. As workarround I changed in the Procedure "TCustomVirtualExplorerTreeoptions.SetVETImageOptions" in the unit VirtualExplorerTree.pas, from Line: 9536

if toImages in Value then {$IF CompilerVersion >=33} Owner.Images := Owner.FScaledSmallSysImages to Owner.Images := SmallSysImages

It works for me. Maybe someone has a better idea.

[romankassebaum]

I use the common SysImages, but without a test project I cannot verify if this is correct. Do you have a test project?

[RenaldoGlobe]

Unfortunately it doesn't work.

Have a look to the test project in the attached zip-file.

Am .06.2022, 23:10 Uhr, schrieb Roman Kassebaum @.***>:

I use the common SysImages, but without a test project I cannot verify
if this is correct. Do you have a test project?

— Reply to this email directly, view it on GitHub, or unsubscribe. You are receiving this because you authored the thread.

[RenaldoGlobe]

ExplorerTree.zip Maybe the zip file was missing.

[romankassebaum]

You are right, the normal images are correct. I fixed this.

[romankassebaum]

I had to change it again, since there were problems with HighDPI.

[pyscripter]

The problem is in VirtualTrees.Utils DrawImage. It uses a low level way to paint disabled images.

procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);

  procedure DrawDisabledImage(ImageList: TCustomImageList; Canvas: TCanvas; X, Y, Index: Integer);
  var
    Params: TImageListDrawParams;
  begin
    FillChar(Params, SizeOf(Params), 0);
    Params.cbSize := SizeOf(Params);
    Params.himl := ImageList.Handle;
    Params.i := Index;
    Params.hdcDst := Canvas.Handle;
    Params.x := X;
    Params.y := Y;
    Params.fState := ILS_SATURATE;
    ImageList_DrawIndirect(@Params);
  end;

begin
  if Enabled then
    TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled)
  else
    DrawDisabledImage(ImageList, Canvas, X, Y, Index);
end;

If you replace the above with

procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
begin
    TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled)
end;

the disabled images are painted OK.

In fact what VirtualTrees does is totally unnecessary since TCustomImageList.DoDraw uses the exact same routine if appropriate and GrayscaleFactor = 0 (default). See local routine DrawDisabled of TCustomImageList.DoDraw.

I have submitted an issue at VirtualTrees to change DrawImage (see below). I also suggest that the current fix is removed and we just wait for the true issue to be resolved. In the mean time you can apply the fix to DrawImage at your local repo of VirtualTrees.

[romankassebaum]

I know , that's why I already have overridden PaintImage and replace the APaintInfo.ImageInfo

{code} procedure TCustomVirtualExplorerTree.PaintImage(var APaintInfo: TVTPaintInfo; AImageInfoIndex: TVTImageInfoIndex; ADoOverlay: Boolean); var lNewImages: TCustomImageList; begin if (not Enabled) and (APaintInfo.ImageInfo[AImageInfoIndex].Images is TCommonVirtualImageList) then begin lNewImages := TCommonVirtualImageList(APaintInfo.ImageInfo[AImageInfoIndex].Images).GetImageListWidth; if Assigned(lNewImages) then APaintInfo.ImageInfo[AImageInfoIndex].Images := lNewImages; end; inherited PaintImage(APaintInfo, AImageInfoIndex, ADoOverlay); end; {code}

[pyscripter]

The issue is now fixed on the VirtualTrees side. I think there is no need for a fix here.

[romankassebaum]

Okay, I removed PaintImage.

[RenaldoGlobe]

After install the latest version of VIRTUALEXPLORERTREE and
MPCOMMONOBJECTS, without modifying VIRTUALTREES.UTILS, it works fine for
me.

Am .06.2022, 14:46 Uhr, schrieb Roman Kassebaum @.***>:

I know , that's why I already have overridden PaintImage and replace the
APaintInfo.ImageInfo

{code} procedure TCustomVirtualExplorerTree.PaintImage(var APaintInfo:
TVTPaintInfo; AImageInfoIndex: TVTImageInfoIndex; ADoOverlay: Boolean); var lNewImages: TCustomImageList; begin if (not Enabled) and (APaintInfo.ImageInfo[AImageInfoIndex].Images is
TCommonVirtualImageList) then begin lNewImages :=
TCommonVirtualImageList(APaintInfo.ImageInfo[AImageInfoIndex].Images).GetImageListWidth; if Assigned(lNewImages) then APaintInfo.ImageInfo[AImageInfoIndex].Images := lNewImages; end; inherited PaintImage(APaintInfo, AImageInfoIndex, ADoOverlay); end; {code}

— Reply to this email directly, view it on GitHub, or unsubscribe. You are receiving this because you authored the thread.

[RenaldoGlobe]

Now it works fine. Thank you.

Am .06.2022, 02:20 Uhr, schrieb Roman Kassebaum @.***>:

You are right, the normal images are correct. I fixed this.

— Reply to this email directly, view it on GitHub, or unsubscribe. You are receiving this because you authored the thread.