View Issue Details

IDProjectCategoryView StatusLast Update
0018247LazarusLCLpublic2021-05-02 13:14
Reporterlainz Assigned Towp  
PrioritynormalSeverityfeatureReproducibilityunable to reproduce
Status assignedResolutionopen 
Platformi386OSWindows 
Product Version0.9.29 (SVN) 
Summary0018247: [Request] TShellListView show Shell System Icons
DescriptionInstead using images to show the file icons in TShellListView use the icons used by the system, in Windows the associated icon to an specific file extension.
TagsListView
Fixed in Revision
LazTarget-
WidgetsetWin32/Win64
Attached Files

Relationships

related to 0038831 resolvedwp Qt5 for Windows is broken, because WSShellCtrls uses BaseUnix in a non-ifdefed manner 

Activities

Bart Broersma

2013-07-27 00:32

developer   ~0069126

The ShellTreeView should probably be totally rewritten to be integrated with the underlying WS and OS.

lainz

2015-08-13 13:35

reporter   ~0085331

This seems like impossible and a task for a custom drawn component. Sorry for suggesting this in the past please close it as can't solve.

Felipe Monteiro de Carvalho

2015-08-15 09:01

developer   ~0085363

Maybe its possible, you need to search for an API to get the icon for a given extension ... but its just very low priority to me. Patches are welcome, however.

Janusz Tomczak

2015-08-16 00:26

reporter   ~0085384

http://stackoverflow.com/questions/829843/how-to-get-icon-and-description-from-file-extension-using-delphi

PeterX

2017-11-23 10:01

reporter   ~0104220

http://www.delphipraxis.net/152464-post.html

This is how it works with Delphi ..

Bart Broersma

2017-11-23 15:29

developer   ~0104231

And now for the cross-platform solution ...

Juha Manninen

2021-02-24 18:53

developer   ~0129149

wp, you implemented it for ShellTreeView in r64575, didn't you?

wp

2021-02-24 19:44

developer   ~0129150

Yes, but only for Windows. I had begun with TShellListView as well, essentially what's proposed by PeterX, but this is fairly slow on large folders because the ListView must iterate through all files and determine the icon index. It would be much faster if the ShellListView could be customdrawn to search only for the images of the visible items, similar to the ShellTreeView, but the complexity of custom drawing the ShellListView exceeds my brain, it never produced the result that I intended (it could also be that we are carrying a bug with us in TShellListView custom painting). And still, it would be a Windows-only solution.

Anton Kavalenka

2021-02-24 20:32

reporter   ~0129151

Last edited: 2021-02-24 20:32

View 2 revisions

In attachment - cross-platform engine for icon extraction both for servers and documents.
Works properly for both Windows and Linux, MacOS/X is not implemented
desk.pas (12,353 bytes)   
unit desk;

interface
uses Graphics;

type
  { Shell }

  Shell=class
  class function GetServerPathUTF8(const Doc:utf8string):utf8string;
  class function GetServerPathW(const Doc:widestring):widestring;
  class function GetServerIcon(const path:widestring;gr:TPicture):boolean;
  class function GetSmallDocumentIcon(const path:widestring;gr:TPicture):boolean;
  class function GetMimeTypeUTF8(const path: utf8string):utf8string;
  class function GetMimeTypeW(const path: widestring):widestring;
  class function OpenDocumentW(const path:widestring):widestring;
  class function OpenDocumentUTF8(const path:utf8string):utf8string;
  {$ifdef UNIX}
  class function FindIcon(icon:string; size:integer):string;
  class function FindIconHelper(icon:string; size:integer; theme:string):string;
  class function LookupIcon (const iconname:string; size:integer;const theme:string):string;
  class function LookupFallbackIcon (const iconname:string):string;
  class function DirectoryMatchesSize(const subdir:string; iconsize:integer):boolean;
  {$endif}
  end;

implementation
uses classes,procexec,SysUtils,inifiles,pathtools,lxmlnode,options,strtools
     {$ifdef MSWINDOWS}
     ,windows,shellapi
     {$endif};

class function Shell.GetServerPathW(const Doc:widestring):widestring;
{$IFDEF MSWINDOWS}
var
  bs:ansistring;
  wBuf:array[0..1023] of widechar;
  sbuf:array[0..2047] of ansichar absolute wbuf;
  fMod:THandle;
begin
  Result:='?';
  fMod:=FindExecutableW(PWideChar(Doc),nil,wBuf);
  if fMod>hinstance_error then
    Result:=wBuf
  else
  begin
    bs:=Doc;
    fMod:=FindExecutableA(PAnsiChar(bs),nil,sBuf);
    if fMod>hinstance_error then
      Result:=sBuf
  end;
end;
{$ENDIF}
{$IFDEF UNIX}
begin
  Result:=utf8decode(GetServerPathUTF8(utf8encode(Doc)));
end;
{$ENDIF}

class function Shell.GetServerIcon(const path: widestring; gr: TPicture
  ): boolean;
{$ifdef MSWINDOWS}
type
  PHIcon=^HICON;
var
  cnt,ndx:integer;
  fIcon:HICON;
begin
  Result:=false;
  cnt:=ExtractIconExW(PWideChar(path),-1,PHIcon(nil)^,PHIcon(nil)^,1);
  // no icons in file
  if cnt=0 then exit;
  ndx:=0; // use 1-st icon, extract large icon (1st non-null argument)
  cnt:=ExtractIconExW(PWideChar(path),ndx,fIcon,PHIcon(nil)^,1);
  if cnt>0 then
  begin
    gr.icon.handle:=fIcon;
    Result:=true;
  end;
end;

(*var
  ico:HICON;
begin
  Result:=false;
  Ico:=ExtractIconW(hInstance,PWideChar(path),1);
  if (Ico<>1) and (Ico<>0) then
  begin
    gr.Icon.Handle:=Ico;
    Result:=true;
  end;
end;*)
{$else}
var
  ini:TIniFile;
  sicon:utf8string;
  lst:TwStringList;
begin
  try
    try
      lst:=TwStringList.Create;
      ini:=TMemIniFile.Create('/usr/share/applications/'+path);
      sicon:=ini.ReadString('Desktop Entry','Icon','');
      if sicon<>'' then
      begin
        FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/hicolor/32x32/apps/'+sicon+'.*',faAnyFile,lst);
        if Lst.Count=0 then
        FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/hicolor/48x48/apps/'+sicon+'.*',faAnyFile,lst);
        if lst.Count=0 then
        FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/hicolor/64x64/apps/'+sicon+'.*',faAnyFile,lst);
        if lst.Count>0 then
        begin
          gr.LoadFromFile(lst.uItem[0]);
          Result:=true;
        end;
      end;
    except
    end;
  finally
    ini.Free;
    lst.Free;
  end;
end;
{$endif}

class function Shell.GetServerPathUTF8(const Doc: utf8string): utf8string;
var
  bs:utf8string;
begin
  {$ifdef UNIX}
  bs:=GetMimeTypeUTF8(doc);
  Result:=''; // clear result
  if procexec.CallProcessSelector(
  	'xdg-mime',['query','default',bs],Result) then
  	Result:=Trim(Result)
  else
    Result:='?';

  {$else}
  Result:=utf8encode(GetServerPathW(utf8decode(Doc)));
  {$endif}
end;

class function Shell.GetMimeTypeUTF8(const path: utf8string):utf8string;
var
  bs:utf8string;
  lst:TStrLst;
begin
  Result:='';
  {$ifdef UNIX}
  bs:='';
  {$ifdef LINUX}
  if not procexec.CallProcessSelector(
  	'xdg-mime',['query','filetype',Path],bs) then
    exit;
  Result:=Trim(bs); // mime-type
  {$else}
  if not procexec.CallProcessSelector(
  	'file',['--mime',Path],bs) then
    exit;
  splitresp(bs,';:',lst);
  if length(lst)<2 then exit;
  Result:=Trim(lst[1]);
  {$endif}

  {$else}
  Result:='unimplemented';
  {$endif}
end;

class function Shell.GetMimeTypeW(const path: widestring):widestring;
begin
  Result:=utf8decode(GetMimeTypeUTF8(utf8encode(path)));
end;

class function Shell.OpenDocumentW(const path: widestring): widestring;
{$ifdef MSWINDOWS}var h:Hinst;{$endif}
begin
  Result:='';
  {$ifdef MSWINDOWS}
  h:=ShellExecuteW(GetDesktopWindow(),
                nil,
                PWideChar(path),
                '','',sw_show {na});
  {$else}
   Result:=utf8decode(Shell.OpenDocumentUTF8(utf8encode(path)));
  {$endif}
end;

class function Shell.OpenDocumentUTF8(const path: utf8string): utf8string;
var
  sproc:utf8string;
begin
  Result:='';
  {$ifdef MSWINDOWS}
  {$else}
    {$ifdef DARWIN}
    sproc:='open';
    {$else}
    sproc:='xdg-open';
    {$endif}
    procexec.CallProcessSelector(sproc,[path],Result);
  {$endif}
end;

class function Shell.GetSmallDocumentIcon(const path: widestring; gr: TPicture
  ): boolean;
{$ifdef MSWINDOWS}
type
  PHIcon=^HICON;
var
  wbuf:widestring;
  cnt,ndx:integer;
  fIcon:HICON;
begin
  Result:=false;
  wbuf:=GetServerPathW(path);
  cnt:=ExtractIconExW(PWideChar(wbuf),-1,PHIcon(nil)^,PHIcon(nil)^,1);
  // no icons in file
  if cnt=0 then exit;
  ndx:=1; // use 2-nd icon
  if cnt<2 then ndx:=0;
  cnt:=ExtractIconExW(PWideChar(wbuf),ndx,PHIcon(nil)^,fIcon,1);
  if cnt>0 then
  begin
    gr.icon.handle:=fIcon;
    Result:=true;
    //deleteobject(fLargeIcon);
  end;
end;
{$else}
var
  smime:utf8string;
  xml:TltParser;
  fs:TFileStream;
  sicon:utf8string;
  lst:TwStringList;
  nd:TltNode;
begin
  Result:=false;

  smime:=GetMimeTypeUTF8(utf8encode(path));
  try
    try
      fs:=TFileStream.Create('/usr/share/mime/'+smime+'.xml',fmOpenRead);
    except
      exit;
    end;
    lst:=TwStringList.Create;
    xml:=TltParser.Create();
    xml.Parse(fs);
    nd:=xml.Root.Find('icon');
    if not Assigned(nd) then
    nd:=xml.Root.Find('generic-icon');
    if Assigned(nd) then
      sicon:=options.GetValueByName(nd.Attr,'name',1,'')
    else
    begin
      // mime-type description has no icon,
      // the file is image itself like "image/jpeg"
      try
        gr.LoadFromFile(path);
        if not gr.Graphic.Empty then
        begin
      	  gr.Bitmap.SetSize(16,16);
          Result:=true;
          exit;
        end;
      except
      end;
      // try to resolve generic type
      sicon:=StringReplace(smime,'/','-',[rfReplaceAll]);
    end;

    if sicon<>'' then
    begin
      FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/Adwaita/16x16/mimetypes/'+sicon+'.*',faAnyFile,lst);
      if Lst.Count=0 then
      FileSystem.BuildFileListWithMaskUTF8('/usr/share/icons/Adwaita/32x32/mimetypes/'+sicon+'.*',faAnyFile,lst);
      if lst.Count>0 then
      begin
        gr.LoadFromFile(lst.uItem[0]);
        Result:=true;
      end;
    end;
  finally
    xml.free;
    fs.Free;
    lst.Free;
  end;


end;
{$endif}

{$ifdef UNIX}
class function Shell.FindIcon(icon:string; size:integer):string;
var
  filename,stheme:string;
begin
  stheme:='Adwaita';
  filename := Shell.FindIconHelper(icon, size, sTheme);
  if filename <>'' then
    exit(filename);

  filename := Shell.FindIconHelper(icon, size, 'hicolor');
  if filename <>'' then
    exit(filename);

  exit(LookupFallbackIcon(icon));
end;

class function Shell.FindIconHelper(icon:string; size:integer; theme:string):string;
var
  ini:TMemIniFile;
  i:integer;
  filename,parents:string;
  lst:TStrLst;
begin
  filename := LookupIcon (icon, size, theme);
  if filename<>'' then
    exit(filename);

  // if theme has parents
  ini:=TMemIniFile.Create('/usr/share/icons/'+theme+'/index.theme');
  try
    parents:=ini.ReadString('Icon Theme','inherits','');
    if parents='' then exit('');
  finally
    ini.Free;
  end;
  splitresp(parents,',',lst);
  for i:=0 to high(lst) do
  begin
    filename := FindIconHelper (icon, size, lst[i]{parent});
    if (filename<>'') then
      exit(filename);
  end;

  Result:='';
end;

const ext_list:array[0..2] of string[3]=('png', 'svg', 'xpm');

class function Shell.LookupIcon(const iconname:string; size:integer;const theme:string):string;
var
  ini:TMemIniFile;
  filename,subdir,dirs,closest_filename:string;
  i,j,minimal_size,sz:integer;
  lst,slst:TStrLst;
begin
 (* Result:='';
  ini:=TmemIniFile.Create('/usr/share/icons/'+theme+'/index.theme');
  try
    dirs:=ini.ReadString('Icon Theme','','Directories');
    if dirs='' then exit('');
  finally
    ini.Free;
  end;
  splitresp(dirs,',',lst);
  for i:=0 to high(lst) do
  begin
    splitresp(lst[i],'/',slst);
    for j:=0 to high(ext_list) do
    begin
      if DirectoryMatchesSize(slst[0],size) then
      begin
        filename:='/usr/share/icons/'+theme+'/'+lst[i]+'/'+iconname+'.'+ext_list[j];
        if FileSystem.FileExistsUTF8(filename) then
        exit(filename);
      end;
    end;
  end;

  closest_filename:='';
  minimal_size := MAXINT;
  for i:=0 to high(lst) do
  begin
    splitresp(lst[i],'/',slst);
    for j:=0 to high(ext_list) do
    begin
      filename:='/usr/share/icons/'+theme+'/'+lst[i]+'/'+iconname+'.'+ext_list[j];
      if FileSystem.FileExistsUTF8(filename) then
      begin
        sz:=DirectorySizeDistance(lst[i], size);
        if sz< minimal_size then
        begin
          closest_filename := filename;
          minimal_size := sz;
        end;
      end;
      exit(filename);

    end;
  end;

  if closest_filename<>'' then
     exit(closest_filename);
  *)
end;

class function Shell.LookupFallbackIcon (const iconname:string):string;
begin
 (* for each directory in $(basename list) {
    for extension in ("png", "svg", "xpm") {
      if exists directory/iconname.extension
        return directory/iconname.extension
    }
  }*)
  exit('');// none
end;

class function Shell.DirectoryMatchesSize(const subdir:string; iconsize:integer):boolean;
begin
 (* read Type and size data from subdir
  if Type is Fixed
    return Size == iconsize
  if Type is Scaled
    return MinSize <= iconsize <= MaxSize
  if Type is Threshold
    return Size - Threshold <= iconsize <= Size + Threshold
    *)
end;

type

  { TfdTheme }

  // FreeDesktop theme loader
  TfdTheme=class
    ini:TMemIniFile;
    constructor Create(const theme:string);
    destructor Destroy;override;
    function DirectorySizeDistance(const subdir:string; size:integer):integer;
  end;

{ TfdTheme }

constructor TfdTheme.Create(const theme: string);
begin
  ini:=TMemIniFile.Create('/usr/share/icons/'+theme+'/index.theme');
end;

destructor TfdTheme.Destroy;
begin
  ini.free;
  inherited Destroy;
end;

function TfdTheme.DirectorySizeDistance(const subdir:string; size:integer):integer;
var
  iconsize,minsize,maxsize,threshold:integer;
  stype,smin,smax:string;
begin
  stype:=ini.ReadString(subdir,'Type','');
  iconsize:=ini.ReadInteger(subdir,'Size',0);

  if stype='Fixed' then
     exit(abs(size-iconsize));

  if stype='Scaled' then
  begin
    minsize:=ini.ReadInteger(subdir,'MinSize',0);
    maxsize:=ini.ReadInteger(subdir,'MaxSize',0);
    if (iconsize<minsize) then
      exit(MinSize - iconsize);
    if (iconsize>MaxSize) then
      exit(iconsize - MaxSize);
    exit(0); // exact
  end;

  if stype='Threshold' then
  begin

  end;

  (*

  if Type is Scaled
    if iconsize < MinSize
        return MinSize - iconsize
    if iconsize > MaxSize
        return iconsize - MaxSize
    return 0
  if Type is Threshold
    if iconsize < Size - Threshold
        return MinSize - iconsize
    if iconsize > Size + Threshold
        return iconsize - MaxSize
    return 0
  *)
end;
{$endif}


end.
desk.pas (12,353 bytes)   

jcmartini

2021-02-25 11:39

reporter   ~0129156

Thanks a lot Anton

wp

2021-03-05 19:25

developer   ~0129406

Last edited: 2021-03-06 12:33

View 2 revisions

Anton, maybe I am blind (as usual...), but I think your unit is not very helpful because it seems ti require a variety of non-standard units. Are you sure that the directories mentioned in your code are valid for all Linux systems? Has can I determine which theme is used currently?

wp

2021-03-07 16:07

developer   ~0129486

Widgetset-based solutions for TShellTreeView in r64747 and for TShellListView in r64764., windows-only for the moment.

I am a bit in doubt whether Anton Kavalenka's code is general enough to hold for all kinds of Linux installations. I think it would be better to seek for solutions provided by the gtk2/gkt3 and qt4/qt5 libraries directly. Keeping the issue open...

Salvadorbs

2021-04-23 16:08

reporter   ~0130540

Make patch for GTK2, GTK3 and QT5. I honestly don't know if the patch is enough to be applied in Lazarus. In fact, in my opinion, it contains a lot of duplicate code between the various widgetsets and I don't have enough knowledge of Lazarus' heart to suggest the best way to fix it.

Also for the GTK3 widgetset, apart from the different units (GTK2-> GTK3), the code is identical to that present in GTK2. Besides the fact that the TShellListview is broken on GTK3 (also the TListview, from my tests) and therefore the code is poorly tested on this widgetset.
0001-LCL-ShellTreeView-Shell-icons-QT5-GTK2-GTK3.patch (50,292 bytes)   
From e92a9e40b52a8cfaacc0a1658f480ef8faf1e6a3 Mon Sep 17 00:00:00 2001
From: Matteo Salvi <salvadorbs@gmail.com>
Date: Thu, 22 Apr 2021 08:05:49 +0200
Subject: [PATCH] LCL/ShellTreeView: Implemented automatic shell icons for
 QT5/GTK2/GTK3

---
 lcl/interfaces/fpmake.pp                |   6 +
 lcl/interfaces/gtk2/gtk2wsfactory.pas   |   9 +-
 lcl/interfaces/gtk2/gtk2wsshellctrls.pp | 478 ++++++++++++++++++++++++
 lcl/interfaces/gtk3/gtk3wsfactory.pas   |  12 +-
 lcl/interfaces/gtk3/gtk3wsshellctrls.pp | 478 ++++++++++++++++++++++++
 lcl/interfaces/qt5/qtwsfactory.pas      |  11 +-
 lcl/interfaces/qt5/qtwsshellctrls.pp    | 424 +++++++++++++++++++++
 lcl/shellctrls.pas                      |   8 +-
 8 files changed, 1413 insertions(+), 13 deletions(-)
 create mode 100644 lcl/interfaces/gtk2/gtk2wsshellctrls.pp
 create mode 100644 lcl/interfaces/gtk3/gtk3wsshellctrls.pp
 create mode 100644 lcl/interfaces/qt5/qtwsshellctrls.pp

diff --git a/lcl/interfaces/fpmake.pp b/lcl/interfaces/fpmake.pp
index 0afb851e2b..8a37aa438e 100644
--- a/lcl/interfaces/fpmake.pp
+++ b/lcl/interfaces/fpmake.pp
@@ -177,6 +177,7 @@ begin
     t.Dependencies.AddUnit('gtk2wsmenus');
     t.Dependencies.AddUnit('gtk2wspairsplitter');
     t.Dependencies.AddUnit('gtk2wsprivate');
+    t.Dependencies.AddUnit('gtk2wsshellctrls');
     t.Dependencies.AddUnit('gtk2wsspin');
     t.Dependencies.AddUnit('gtk2wsstdctrls');
     t.Dependencies.AddUnit('unitywsctrls');
@@ -255,6 +256,7 @@ begin
     t.Dependencies.AddUnit('qtwsimglist');
     t.Dependencies.AddUnit('qtwsmenus');
     t.Dependencies.AddUnit('qtwspairsplitter');
+    t.Dependencies.AddUnit('qtwsshellctrls');
     t.Dependencies.AddUnit('qtwsspin');
     t.Dependencies.AddUnit('qtwsstdctrls');
     t.Dependencies.AddUnit('cocoawsbuttons');
@@ -317,6 +319,7 @@ begin
     t.Dependencies.AddUnit('gtk3wsimglist');
     t.Dependencies.AddUnit('gtk3wsmenus');
     t.Dependencies.AddUnit('gtk3wsspin');
+    t.Dependencies.AddUnit('gtk3wsshellctrls');
     t.Dependencies.AddUnit('gtk3wsstdctrls');
     t.Dependencies.AddUnit('gtk3wscalendar');
     t.Dependencies.AddUnit('lazatk1');
@@ -509,6 +512,7 @@ begin
     P.Targets.AddImplicitUnit('gtk2/gtk2wsmenus.pp');
     P.Targets.AddImplicitUnit('gtk2/gtk2wspairsplitter.pp');
     P.Targets.AddImplicitUnit('gtk2/gtk2wsprivate.pp');
+    P.Targets.AddImplicitUnit('gtk2/gtk2wsshellctrls.pp');
     P.Targets.AddImplicitUnit('gtk2/gtk2wsspin.pp');
     P.Targets.AddImplicitUnit('gtk2/gtk2wsstdctrls.pp');
     P.Targets.AddImplicitUnit('gtk2/unitywsctrls.pas');
@@ -588,6 +592,7 @@ begin
     P.Targets.AddImplicitUnit('qt/qtwsmenus.pp');
     P.Targets.AddImplicitUnit('qt/qtwspairsplitter.pp');
     P.Targets.AddImplicitUnit('qt/qtwsspin.pp');
+    P.Targets.AddImplicitUnit('qt/qtwsshellctrls.pp');
     P.Targets.AddImplicitUnit('qt/qtwsstdctrls.pp');
     P.Targets.AddImplicitUnit('cocoa/cocoawsbuttons.pas');
     P.Targets.AddImplicitUnit('customdrawn/customdrawn_winproc.pas');
@@ -649,6 +654,7 @@ begin
     P.Targets.AddImplicitUnit('gtk3/gtk3wsimglist.pp');
     P.Targets.AddImplicitUnit('gtk3/gtk3wsmenus.pp');
     P.Targets.AddImplicitUnit('gtk3/gtk3wsspin.pp');
+    P.Targets.AddImplicitUnit('gtk3/gtk3wsshellctrls.pp');
     P.Targets.AddImplicitUnit('gtk3/gtk3wsstdctrls.pp');
     P.Targets.AddImplicitUnit('gtk3/gtk3wscalendar.pp');
     P.Targets.AddImplicitUnit('gtk3/gtk3bindings/lazatk1.pas');
diff --git a/lcl/interfaces/gtk2/gtk2wsfactory.pas b/lcl/interfaces/gtk2/gtk2wsfactory.pas
index e061b8e0f6..e1a72d04cb 100644
--- a/lcl/interfaces/gtk2/gtk2wsfactory.pas
+++ b/lcl/interfaces/gtk2/gtk2wsfactory.pas
@@ -8,7 +8,7 @@ uses
   // RTL
   Classes,
   // LCL
-  Controls, ComCtrls, Calendar, StdCtrls, Spin,
+  Controls, ComCtrls, Calendar, StdCtrls, Spin, ShellCtrls,
   Dialogs, ExtCtrls, ExtDlgs, Buttons, CheckLst, Forms, Grids, Menus,
   PairSplitter, WSLCLClasses;
 
@@ -124,6 +124,7 @@ uses
   Gtk2WSStdCtrls,
   Gtk2WSPairSplitter,
   Gtk2WSPrivate,
+  Gtk2WSShellCtrls,
   UnityWSCtrls;
 
 // imglist
@@ -624,12 +625,14 @@ end;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomShellTreeView, TGTK2WSCustomShellTreeView);
+  Result := True;
 end;
 
 function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomShellListView, TGTK2WSCustomShellListView);
+  Result := True;
 end;
 
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
diff --git a/lcl/interfaces/gtk2/gtk2wsshellctrls.pp b/lcl/interfaces/gtk2/gtk2wsshellctrls.pp
new file mode 100644
index 0000000000..2f29b068ae
--- /dev/null
+++ b/lcl/interfaces/gtk2/gtk2wsshellctrls.pp
@@ -0,0 +1,478 @@
+{
+ *****************************************************************************
+ *                              WSShellCtrls.pp                              *
+ *                              -------------                                *
+ *                                                                           *
+ *                                                                           *
+ *****************************************************************************
+
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+unit gtk2wsshellctrls;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, ComCtrls, ShellCtrls, Types,
+////////////////////////////////////////////////////
+// To get as little as posible circles,
+// uncomment only when needed for registration
+////////////////////////////////////////////////////
+//  Graphics, ImgList, Controls, ShellCtrls,
+////////////////////////////////////////////////////
+  WSShellCtrls;
+
+type
+
+  { TGTK2WSCustomShellTreeView }
+
+  TGTK2WSCustomShellTreeView = class(TWSCustomShellTreeView)
+  published
+    class function DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+      ANode: TTreeNode; ARect: TRect): Types.TSize; override;
+    class function GetBuiltinIconSize: Types.TSize; override;
+  end;
+
+  { TGTK2WSCustomShellListView }
+  TGTK2WSCustomShellListView = class(TWSCustomShellListView)
+  published
+    class function GetBuiltInImageIndex(AListView: TCustomShellListView;
+      const AFileName: String; ALargeImage: Boolean): Integer; override;
+  end;
+
+implementation
+
+uses
+  gtk2, gdk2pixbuf, glib2, gdk2, GraphType, IntfGraphics,
+  graphics, Contnrs, LCLType, SyncObjs, BaseUnix, StrUtils,
+  LazFileUtils, Controls, StringHashList, IniFiles;
+
+var
+  FExtToMimeIconName: TFPDataHashTable = nil;
+  FLock: TCriticalSection = nil;
+  FImageList: TImageList = nil;
+  FCacheIcon: TStringHashList = nil;
+
+const
+  ICON_SIZE_SMALL = 16;
+  ICON_SIZE_LARGE = 32;
+
+procedure LoadMimeIconNames;
+const
+  mime_globs = '/usr/share/mime/globs';
+  mime_generic_icons = '/usr/share/mime/generic-icons';
+var
+  I, J: Integer;
+  globs: TStringList = nil;
+  generic_icons: THashedStringList = nil;
+  sMimeType,
+  sMimeIconName,
+  sExtension: String;
+  node: THTDataNode = nil;
+  iconsList: TStringList;
+begin
+  if not Assigned(FLock) then
+    FLock := TCriticalSection.Create;
+
+  if not Assigned(FExtToMimeIconName) then
+    FExtToMimeIconName := TFPDataHashTable.Create;
+
+  FLock.Acquire;
+  try
+    if FExtToMimeIconName.Count = 0 then
+    begin
+      if FpAccess(mime_globs, R_OK) = 0 then
+      begin
+        // Load mapping: MIME type -> file extension.
+        globs:= TStringList.Create;
+        globs.NameValueSeparator:= ':';
+        globs.LoadFromFile(mime_globs);
+
+        // Try to load mapping: MIME type -> generic MIME icon name.
+        if FileExists(mime_generic_icons) then
+          begin
+            generic_icons:= THashedStringList.Create;
+            generic_icons.NameValueSeparator:= ':';
+            generic_icons.LoadFromFile(mime_generic_icons);
+          end;
+
+        // Create mapping: file extension -> list of MIME icon names.
+        for I:= 0 to globs.Count - 1 do
+          if (globs.Strings[I]    <> EmptyStr) and   // bypass empty lines
+             (globs.Strings[I][1] <> '#') then // and comments
+          begin
+            sMimeType := globs.Names[I];
+            sMimeIconName:= StringReplace(sMimeType, '/', '-', []);
+            sExtension:= globs.ValueFromIndex[I];
+
+            // Support only extensions, not full file name masks.
+            if (sExtension <> EmptyStr) and (sExtension <> '.*') then
+            begin
+              node := THTDataNode(FExtToMimeIconName.Find(sExtension));
+              if not Assigned(node) then
+                begin
+                  iconsList := TStringList.Create;
+                  FExtToMimeIconName.Add(sExtension, iconsList);
+                end
+              else
+                iconsList := TStringList(node.Data);
+
+              if iconsList.IndexOf(sMimeIconName) < 0 then
+                iconsList.Add(sMimeIconName);
+
+              // Shared-mime-info spec says:
+              // "If [generic-icon] is not specified then the mimetype is used to generate the
+              // generic icon by using the top-level media type (e.g. "video" in "video/ogg")
+              // and appending "-x-generic" (i.e. "video-x-generic" in the previous example)."
+              if Assigned(generic_icons) then
+                begin
+                  J := generic_icons.IndexOfName(sMimeType);
+                  if J <> -1 then
+                    sMimeIconName := generic_icons.ValueFromIndex[J] // found generic icon
+                  else
+                    sMimeIconName := Copy2Symb(sMimeIconName, '-') + '-x-generic';
+                end
+              else
+                sMimeIconName := Copy2Symb(sMimeIconName, '-') + '-x-generic';
+
+              if iconsList.IndexOf(sMimeIconName) < 0 then
+                iconsList.Add(sMimeIconName);
+            end;
+          end;
+      end;
+    end;
+
+  finally
+    if Assigned(globs) then
+      FreeAndNil(globs);
+    if Assigned(generic_icons) then
+      FreeAndNil(generic_icons);
+    FLock.Release;
+  end;
+
+end;   
+
+function IsDirectory(AFilename: String): Boolean;
+var
+  Info: BaseUnix.Stat;
+begin
+  Result := False;
+  if fpStat(AFilename, Info) >= 0 then
+    Result := fpS_ISDIR(Info.st_mode);
+end;
+
+function CheckIconName(const AIconName: String): Boolean;
+begin
+  Result := ((AIconName <> EmptyStr) and (gtk_icon_theme_has_icon(gtk_icon_theme_get_default, PChar(AIconName)) or
+             FileExists(AIconName)));
+end;
+
+function PixBufToBitmap(Pixbuf: PGdkPixbuf): TBitmap;
+var
+  width, height, rowstride, n_channels, i, j: Integer;
+  pixels: Pguchar;
+  pSrc: PByte;
+  pDst: PLongWord;
+  BmpData: TLazIntfImage;
+  hasAlphaChannel: Boolean;
+  QueryFlags: TRawImageQueryFlags = [riqfRGB];
+  Description: TRawImageDescription;    
+  ARawImage: TRawImage;
+begin
+  Result := nil;
+
+  n_channels:= gdk_pixbuf_get_n_channels(Pixbuf);
+
+  if ((n_channels <> 3) and (n_channels <> 4)) or  // RGB or RGBA
+     (gdk_pixbuf_get_colorspace(pixbuf) <> GDK_COLORSPACE_RGB) or
+     (gdk_pixbuf_get_bits_per_sample(pixbuf) <> 8) then Exit;
+
+  width:= gdk_pixbuf_get_width(Pixbuf);
+  height:= gdk_pixbuf_get_height(Pixbuf);
+  rowstride:= gdk_pixbuf_get_rowstride(Pixbuf);
+  pixels:= gdk_pixbuf_get_pixels(Pixbuf);
+  hasAlphaChannel:= gdk_pixbuf_get_has_alpha(Pixbuf);
+
+  if hasAlphaChannel then
+    Include(QueryFlags, riqfAlpha);
+
+  BmpData := TLazIntfImage.Create(width, height, QueryFlags);
+  try
+    BmpData.CreateData;
+    Description := BmpData.DataDescription;
+
+    pDst := PLongWord(BmpData.PixelData);
+    for j:= 0 to Height - 1 do
+    begin
+      pSrc := PByte(pixels) + j * rowstride;
+      for i:= 0 to Width - 1 do
+      begin
+        pDst^ := pSrc[0] shl Description.RedShift +
+                 pSrc[1] shl Description.GreenShift +
+                 pSrc[2] shl Description.BlueShift;
+
+        if hasAlphaChannel then
+          pDst^ := pDst^ + pSrc[3] shl Description.AlphaShift;
+
+        Inc(pSrc, n_channels);
+        Inc(pDst);
+      end;
+    end;
+
+    Result := TBitmap.Create;
+
+    BmpData.GetRawImage(ARawImage, True);
+    // Simply change raw image owner without data copy
+    Result.LoadFromRawImage(ARawImage, True);
+
+    if not hasAlphaChannel then
+      Result.Transparent := True;
+
+  finally
+    BmpData.Free;
+  end;
+end;
+
+function ExtractIcon(const sIconName: String; ALargeImage: Boolean): TBitmap;
+var            
+  pbPicture: PGdkPixbuf = nil;
+  Size: Integer;
+begin
+  Result := nil;
+
+  if ALargeImage then
+    Size := ICON_SIZE_LARGE
+  else
+    Size := ICON_SIZE_SMALL;
+
+  try
+    if CheckIconName(sIconName) then
+    begin
+      if FileExists(sIconName) then
+        pbPicture := gdk_pixbuf_new_from_file_at_size(PChar(sIconName), Size, Size, nil)
+      else
+        pbPicture := gtk_icon_theme_load_icon(gtk_icon_theme_get_for_screen(gdk_screen_get_default), Pgchar(sIconName), Size, GTK_ICON_LOOKUP_USE_BUILTIN, nil);
+    end;
+
+    if Assigned(pbPicture) then
+      Result := PixBufToBitmap(pbPicture)
+    else
+      Result := TBitmap.Create;
+  finally
+    g_object_unref(pbPicture);
+  end;
+end;
+
+function GetIconByDesktopFile(AFileName: String): String;
+var
+  iniDesktop: TIniFile = nil;
+begin
+  Result := EmptyStr;
+
+  try
+    iniDesktop := TIniFile.Create(AFileName);
+    try
+      Result := iniDesktop.ReadString('Desktop Entry', 'Icon', EmptyStr);
+    finally
+      FreeAndNil(iniDesktop);
+    end;
+  except
+    Exit;
+  end;
+end;
+
+function GetIconName(const AFileName: String): String;
+var
+  I: Integer;
+  node: THTDataNode;
+  iconList: TStringList;
+  Extension: String;
+begin
+  LoadMimeIconNames;
+
+  Result := EmptyStr;
+
+  //It is a link? Ok, get target file icon
+  if FpReadLink(AFilename) <> EmptyStr then
+    Extension := '*' + ExtractFileExt(FpReadLink(AFileName))
+  else
+    Extension := '*' + ExtractFileExt(AFileName);
+
+  Extension := LowerCase(Extension);
+
+  //TODO: Special folders icon https://gitlab.gnome.org/GNOME/glib/-/commit/129eb074823101102611690f053ffa246bb7784d#3549e1301fc4c17bf0dd809eca0a36fb87aac264_1582_1582
+
+  if IsDirectory(AFileName) then
+  begin
+    if FileExists(AFileName + PathDelim + '.directory') then
+      Result := GetIconByDesktopFile(AFileName + PathDelim + '.directory')
+    else
+      Result := 'folder';
+  end
+  else if (Extension = '*.desktop') then
+  begin
+    Result := GetIconByDesktopFile(AFileName);
+  end
+  else if FileIsExecutable(AFileName) then
+  begin
+    Result := 'application-x-executable';
+  end
+  else if (Extension = '*.ico') then
+  begin
+    Result := AFileName;
+  end
+  else if (Extension <> '*') then
+  begin
+    node := THTDataNode(FExtToMimeIconName.Find(Extension));
+    if Assigned(node) then
+      begin
+        iconList := TStringList(node.Data);
+
+        //First valid icon wins
+        for I := 0 to iconList.Count - 1 do
+          begin
+            Result := iconList.Strings[I];
+            if gtk_icon_theme_has_icon(gtk_icon_theme_get_default, PChar(Result)) then
+              break;
+          end;
+      end;
+  end;
+
+  //Not found icon? No problem. Use generic icon
+  if (not CheckIconName(Result)) or (Result = EmptyStr) then
+  begin
+    if FileIsText(AFileName) then
+      Result := 'text-x-generic'
+    else
+      Result := 'unknown';
+  end;
+end;
+
+procedure CreateLVImageList;
+begin
+  if Assigned(FImageList) then
+    Exit;
+
+  FImageList := TImageList.Create(nil);
+
+  FImageList.RegisterResolutions([ICON_SIZE_SMALL, ICON_SIZE_LARGE]);
+end;
+
+{ TGTK2WSCustomShellTreeView }
+
+class function TGTK2WSCustomShellTreeView.DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+  ANode: TTreeNode; ARect: TRect): Types.TSize;
+var
+  filename: String;
+  bmp: TBitmap;
+  iconName: String;
+begin
+  fileName := ATreeView.GetPathFromNode(ANode);
+  iconName := GetIconName(fileName);
+  bmp := ExtractIcon(iconName, False);
+  try
+    ATreeView.Canvas.Draw(ARect.Left, (ARect.Top + ARect.Bottom - bmp.Height) div 2, bmp);
+    Result := Types.Size(bmp.Width, bmp.Height);
+  finally
+    bmp.Free;
+  end;
+end;
+
+class function TGTK2WSCustomShellTreeView.GetBuiltinIconSize: Types.TSize;
+begin
+  Result := Types.Size(ICON_SIZE_SMALL, ICON_SIZE_SMALL);
+end;
+
+
+{ TGTK2WSCustomShellListView }
+
+class function TGTK2WSCustomShellListView.GetBuiltInImageIndex(
+  AListView: TCustomShellListView; const AFileName: String;
+  ALargeImage: Boolean): Integer;
+var
+  bmpSmall, bmpLarge: TBitmap;
+  iconName: String;
+  FCacheImageIndex: Integer;
+begin
+  Result := -1;
+
+  CreateLVImageList;
+
+  if ALargeImage then
+  begin
+    AListView.SmallImages := nil;
+    AListView.SmallImagesWidth := 0;
+    AListView.LargeImages := FImageList;
+    AListView.LargeImagesWidth := ICON_SIZE_LARGE;
+  end
+  else begin
+    AListView.SmallImages := FImageList;
+    AListView.SmallImagesWidth := ICON_SIZE_SMALL;
+    AListView.LargeImages := nil;
+    AListView.LargeImagesWidth := 0;
+  end;
+
+  if FCacheIcon = nil then
+    FCacheIcon := TStringHashList.Create(True);
+
+  iconName := GetIconName(AFileName);
+
+  FCacheImageIndex := FCacheIcon.Find(iconName);
+  if FCacheImageIndex < 0 then
+  begin
+    bmpSmall := ExtractIcon(iconName, False);
+    bmpLarge := ExtractIcon(iconName, True);
+    try
+      Result := FImageList.AddMultipleResolutions([bmpSmall, bmpLarge]);
+
+      FCacheIcon.Add(iconName, Pointer(Result));
+    finally
+      bmpSmall.Free;
+      bmpLarge.Free;
+    end;
+  end
+  else begin
+    Result := PtrInt(FCacheIcon.List[FCacheImageIndex]^.Data);
+  end;
+end;
+
+procedure ClearExtToMimeList;
+var
+  nodeList: TFPObjectList;
+  I, J : Integer;
+begin
+  for I := 0 to FExtToMimeIconName.HashTable.Count - 1 do
+  begin
+    begin
+      nodeList := TFPObjectList(FExtToMimeIconName.HashTable.Items[I]);
+      if Assigned(nodeList) then
+        for J := 0 to nodeList.Count - 1 do
+          TStringList(THtDataNode(nodeList.Items[J]).Data).Free;
+    end;
+  end;
+end;
+
+finalization
+  if Assigned(FExtToMimeIconName) then
+  begin
+    ClearExtToMimeList;
+    FExtToMimeIconName.Free;
+  end;
+
+  if Assigned(FLock) then
+    FLock.Free;
+
+  if Assigned(FImageList) then
+    FImageList.Free;
+
+  if Assigned(FCacheIcon) then
+    FCacheIcon.Free;
+
+end.
\ No newline at end of file
diff --git a/lcl/interfaces/gtk3/gtk3wsfactory.pas b/lcl/interfaces/gtk3/gtk3wsfactory.pas
index 20367ac893..10447fb0b4 100644
--- a/lcl/interfaces/gtk3/gtk3wsfactory.pas
+++ b/lcl/interfaces/gtk3/gtk3wsfactory.pas
@@ -20,7 +20,8 @@ unit Gtk3WSFactory;
 interface
 uses
   Classes, Controls, ComCtrls, Calendar, StdCtrls, Dialogs, ExtCtrls, ExtDlgs,
-  Buttons, Spin, CheckLst, Forms, Menus, ImgList, PairSplitter, WSLCLClasses;
+  Buttons, Spin, CheckLst, Forms, Menus, ImgList, PairSplitter, WSLCLClasses,
+  ShellCtrls;
 
 
 // imglist
@@ -139,7 +140,8 @@ uses
 uses
   Gtk3WSImgList, Gtk3WSControls, Gtk3WSForms, Gtk3WSButtons, Gtk3WSStdCtrls,
   Gtk3WSComCtrls, Gtk3WSExtCtrls, Gtk3WSSpin, Gtk3WSMenus, Gtk3WSCalendar,
-  Gtk3WSDialogs, Gtk3WSCheckLst, Gtk3WSExtDlgs, gtk3wssplitter, Gtk3WSTrayIcon;
+  Gtk3WSDialogs, Gtk3WSCheckLst, Gtk3WSExtDlgs, gtk3wssplitter, Gtk3WSTrayIcon,
+  Gtk3WSShellCtrls;
 
 // imglist
 function RegisterCustomImageListResolution: Boolean; alias : 'WSRegisterCustomImageListResolution';
@@ -625,12 +627,14 @@ end;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomShellTreeView, TGTK3WSCustomShellTreeView);
+  Result := True;
 end;
 
 function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomShellListView, TGTK3WSCustomShellListView);
+  Result := True;
 end;
 
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
diff --git a/lcl/interfaces/gtk3/gtk3wsshellctrls.pp b/lcl/interfaces/gtk3/gtk3wsshellctrls.pp
new file mode 100644
index 0000000000..d466743bf7
--- /dev/null
+++ b/lcl/interfaces/gtk3/gtk3wsshellctrls.pp
@@ -0,0 +1,478 @@
+{
+ *****************************************************************************
+ *                              WSShellCtrls.pp                              *
+ *                              -------------                                *
+ *                                                                           *
+ *                                                                           *
+ *****************************************************************************
+
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+unit gtk3wsshellctrls;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, ComCtrls, ShellCtrls, Types,
+////////////////////////////////////////////////////
+// To get as little as posible circles,
+// uncomment only when needed for registration
+////////////////////////////////////////////////////
+//  Graphics, ImgList, Controls, ShellCtrls,
+////////////////////////////////////////////////////
+  WSShellCtrls;
+
+type
+
+  { TGTK3WSCustomShellTreeView }
+
+  TGTK3WSCustomShellTreeView = class(TWSCustomShellTreeView)
+  published
+    class function DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+      ANode: TTreeNode; ARect: TRect): Types.TSize; override;
+    class function GetBuiltinIconSize: Types.TSize; override;
+  end;
+
+  { TGTK3WSCustomShellListView }
+  TGTK3WSCustomShellListView = class(TWSCustomShellListView)
+  published
+    class function GetBuiltInImageIndex(AListView: TCustomShellListView;
+      const AFileName: String; ALargeImage: Boolean): Integer; override;
+  end;
+
+implementation
+
+uses
+  lazgtk3, lazgdkpixbuf2, LazGLib2, LazGdk3, LazGObject2,
+  GraphType, IntfGraphics, graphics, Contnrs, LCLType, SyncObjs, BaseUnix,
+  StrUtils, LazFileUtils, Controls, StringHashList, IniFiles;
+
+var
+  FExtToMimeIconName: TFPDataHashTable = nil;
+  FLock: TCriticalSection = nil;
+  FImageList: TImageList = nil;
+  FCacheIcon: TStringHashList = nil;
+
+const
+  ICON_SIZE_SMALL = 16;
+  ICON_SIZE_LARGE = 32;
+
+procedure LoadMimeIconNames;
+const
+  mime_globs = '/usr/share/mime/globs';
+  mime_generic_icons = '/usr/share/mime/generic-icons';
+var
+  I, J: Integer;
+  globs: TStringList = nil;
+  generic_icons: THashedStringList = nil;
+  sMimeType,
+  sMimeIconName,
+  sExtension: String;
+  node: THTDataNode = nil;
+  iconsList: TStringList;
+begin
+  if not Assigned(FLock) then
+    FLock := TCriticalSection.Create;
+
+  if not Assigned(FExtToMimeIconName) then
+    FExtToMimeIconName := TFPDataHashTable.Create;
+
+  FLock.Acquire;
+  try
+    if FExtToMimeIconName.Count = 0 then
+    begin
+      if FpAccess(mime_globs, R_OK) = 0 then
+      begin
+        // Load mapping: MIME type -> file extension.
+        globs:= TStringList.Create;
+        globs.NameValueSeparator:= ':';
+        globs.LoadFromFile(mime_globs);
+
+        // Try to load mapping: MIME type -> generic MIME icon name.
+        if FileExists(mime_generic_icons) then
+          begin
+            generic_icons:= THashedStringList.Create;
+            generic_icons.NameValueSeparator:= ':';
+            generic_icons.LoadFromFile(mime_generic_icons);
+          end;
+
+        // Create mapping: file extension -> list of MIME icon names.
+        for I:= 0 to globs.Count - 1 do
+          if (globs.Strings[I]    <> EmptyStr) and   // bypass empty lines
+             (globs.Strings[I][1] <> '#') then // and comments
+          begin
+            sMimeType := globs.Names[I];
+            sMimeIconName:= StringReplace(sMimeType, '/', '-', []);
+            sExtension:= globs.ValueFromIndex[I];
+
+            // Support only extensions, not full file name masks.
+            if (sExtension <> EmptyStr) and (sExtension <> '.*') then
+            begin
+              node := THTDataNode(FExtToMimeIconName.Find(sExtension));
+              if not Assigned(node) then
+                begin
+                  iconsList := TStringList.Create;
+                  FExtToMimeIconName.Add(sExtension, iconsList);
+                end
+              else
+                iconsList := TStringList(node.Data);
+
+              if iconsList.IndexOf(sMimeIconName) < 0 then
+                iconsList.Add(sMimeIconName);
+
+              // Shared-mime-info spec says:
+              // "If [generic-icon] is not specified then the mimetype is used to generate the
+              // generic icon by using the top-level media type (e.g. "video" in "video/ogg")
+              // and appending "-x-generic" (i.e. "video-x-generic" in the previous example)."
+              if Assigned(generic_icons) then
+                begin
+                  J := generic_icons.IndexOfName(sMimeType);
+                  if J <> -1 then
+                    sMimeIconName := generic_icons.ValueFromIndex[J] // found generic icon
+                  else
+                    sMimeIconName := Copy2Symb(sMimeIconName, '-') + '-x-generic';
+                end
+              else
+                sMimeIconName := Copy2Symb(sMimeIconName, '-') + '-x-generic';
+
+              if iconsList.IndexOf(sMimeIconName) < 0 then
+                iconsList.Add(sMimeIconName);
+            end;
+          end;
+      end;
+    end;
+
+  finally
+    if Assigned(globs) then
+      FreeAndNil(globs);
+    if Assigned(generic_icons) then
+      FreeAndNil(generic_icons);
+    FLock.Release;
+  end;
+
+end;   
+
+function IsDirectory(AFilename: String): Boolean;
+var
+  Info: BaseUnix.Stat;
+begin
+  Result := False;
+  if fpStat(AFilename, Info) >= 0 then
+    Result := fpS_ISDIR(Info.st_mode);
+end;
+
+function CheckIconName(const AIconName: String): Boolean;
+begin
+  Result := ((AIconName <> EmptyStr) and (gtk_icon_theme_has_icon(gtk_icon_theme_get_default, PChar(AIconName)) or
+             FileExists(AIconName)));
+end;
+
+function PixBufToBitmap(Pixbuf: PGdkPixbuf): TBitmap;
+var
+  width, height, rowstride, n_channels, i, j: Integer;
+  pixels: ^guchar;
+  pSrc: PByte;
+  pDst: PLongWord;
+  BmpData: TLazIntfImage;
+  hasAlphaChannel: Boolean;
+  QueryFlags: TRawImageQueryFlags = [riqfRGB];
+  Description: TRawImageDescription;    
+  ARawImage: TRawImage;
+begin
+  Result := nil;
+
+  n_channels:= gdk_pixbuf_get_n_channels(Pixbuf);
+
+  if ((n_channels <> 3) and (n_channels <> 4)) or  // RGB or RGBA
+     (gdk_pixbuf_get_colorspace(pixbuf) <> GDK_COLORSPACE_RGB) or
+     (gdk_pixbuf_get_bits_per_sample(pixbuf) <> 8) then Exit;
+
+  width:= gdk_pixbuf_get_width(Pixbuf);
+  height:= gdk_pixbuf_get_height(Pixbuf);
+  rowstride:= gdk_pixbuf_get_rowstride(Pixbuf);
+  pixels:= gdk_pixbuf_get_pixels(Pixbuf);
+  hasAlphaChannel:= gdk_pixbuf_get_has_alpha(Pixbuf);
+
+  if hasAlphaChannel then
+    Include(QueryFlags, riqfAlpha);
+
+  BmpData := TLazIntfImage.Create(width, height, QueryFlags);
+  try
+    BmpData.CreateData;
+    Description := BmpData.DataDescription;
+
+    pDst := PLongWord(BmpData.PixelData);
+    for j:= 0 to Height - 1 do
+    begin
+      pSrc := PByte(pixels) + j * rowstride;
+      for i:= 0 to Width - 1 do
+      begin
+        pDst^ := pSrc[0] shl Description.RedShift +
+                 pSrc[1] shl Description.GreenShift +
+                 pSrc[2] shl Description.BlueShift;
+
+        if hasAlphaChannel then
+          pDst^ := pDst^ + pSrc[3] shl Description.AlphaShift;
+
+        Inc(pSrc, n_channels);
+        Inc(pDst);
+      end;
+    end;
+
+    Result := TBitmap.Create;
+
+    BmpData.GetRawImage(ARawImage, True);
+    // Simply change raw image owner without data copy
+    Result.LoadFromRawImage(ARawImage, True);
+
+    if not hasAlphaChannel then
+      Result.Transparent := True;
+
+  finally
+    BmpData.Free;
+  end;
+end;
+
+function ExtractIcon(const sIconName: String; ALargeImage: Boolean): TBitmap;
+var            
+  pbPicture: PGdkPixbuf = nil;
+  Size: Integer;
+begin
+  Result := nil;
+
+  if ALargeImage then
+    Size := ICON_SIZE_LARGE
+  else
+    Size := ICON_SIZE_SMALL;
+
+  try
+    if CheckIconName(sIconName) then
+    begin
+      if FileExists(sIconName) then
+        pbPicture := gdk_pixbuf_new_from_file_at_size(PChar(sIconName), Size, Size, nil)
+      else
+        pbPicture := gtk_icon_theme_load_icon(gtk_icon_theme_get_for_screen(gdk_screen_get_default), Pgchar(sIconName), Size, GTK_ICON_LOOKUP_USE_BUILTIN, nil);
+    end;
+
+    if Assigned(pbPicture) then
+      Result := PixBufToBitmap(pbPicture)
+    else
+      Result := TBitmap.Create;
+  finally
+    g_object_unref(pbPicture);
+  end;
+end;
+
+function GetIconByDesktopFile(AFileName: String): String;
+var
+  iniDesktop: TIniFile = nil;
+begin
+  Result := EmptyStr;
+
+  try
+    iniDesktop := TIniFile.Create(AFileName);
+    try
+      Result := iniDesktop.ReadString('Desktop Entry', 'Icon', EmptyStr);
+    finally
+      FreeAndNil(iniDesktop);
+    end;
+  except
+    Exit;
+  end;
+end;
+
+function GetIconName(const AFileName: String): String;
+var
+  I: Integer;
+  node: THTDataNode;
+  iconList: TStringList;
+  Extension: String;
+begin
+  LoadMimeIconNames;
+
+  Result := EmptyStr;
+
+  //It is a link? Ok, get target file icon
+  if FpReadLink(AFilename) <> EmptyStr then
+    Extension := '*' + ExtractFileExt(FpReadLink(AFileName))
+  else
+    Extension := '*' + ExtractFileExt(AFileName);
+
+  Extension := LowerCase(Extension);
+
+  //TODO: Special folders icon https://gitlab.gnome.org/GNOME/glib/-/commit/129eb074823101102611690f053ffa246bb7784d#3549e1301fc4c17bf0dd809eca0a36fb87aac264_1582_1582
+
+  if IsDirectory(AFileName) then
+  begin
+    if FileExists(AFileName + PathDelim + '.directory') then
+      Result := GetIconByDesktopFile(AFileName + PathDelim + '.directory')
+    else
+      Result := 'folder';
+  end
+  else if (Extension = '*.desktop') then
+  begin
+    Result := GetIconByDesktopFile(AFileName);
+  end
+  else if FileIsExecutable(AFileName) then
+  begin
+    Result := 'application-x-executable';
+  end
+  else if (Extension = '*.ico') then
+  begin
+    Result := AFileName;
+  end
+  else if (Extension <> '*') then
+  begin
+    node := THTDataNode(FExtToMimeIconName.Find(Extension));
+    if Assigned(node) then
+      begin
+        iconList := TStringList(node.Data);
+
+        //First valid icon wins
+        for I := 0 to iconList.Count - 1 do
+          begin
+            Result := iconList.Strings[I];
+            if gtk_icon_theme_has_icon(gtk_icon_theme_get_default, PChar(Result)) then
+              break;
+          end;
+      end;
+  end;
+
+  //Not found icon? No problem. Use generic icon
+  if (not CheckIconName(Result)) or (Result = EmptyStr) then
+  begin
+    if FileIsText(AFileName) then
+      Result := 'text-x-generic'
+    else
+      Result := 'unknown';
+  end;
+end;
+
+procedure CreateLVImageList;
+begin
+  if Assigned(FImageList) then
+    Exit;
+
+  FImageList := TImageList.Create(nil);
+
+  FImageList.RegisterResolutions([ICON_SIZE_SMALL, ICON_SIZE_LARGE]);
+end;
+
+{ TGTK3WSCustomShellTreeView }
+
+class function TGTK3WSCustomShellTreeView.DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+  ANode: TTreeNode; ARect: TRect): Types.TSize;
+var
+  filename: String;
+  bmp: TBitmap;
+  iconName: String;
+begin
+  fileName := ATreeView.GetPathFromNode(ANode);
+  iconName := GetIconName(fileName);
+  bmp := ExtractIcon(iconName, False);
+  try
+    ATreeView.Canvas.Draw(ARect.Left, (ARect.Top + ARect.Bottom - bmp.Height) div 2, bmp);
+    Result := Types.Size(bmp.Width, bmp.Height);
+  finally
+    bmp.Free;
+  end;
+end;
+
+class function TGTK3WSCustomShellTreeView.GetBuiltinIconSize: Types.TSize;
+begin
+  Result := Types.Size(ICON_SIZE_SMALL, ICON_SIZE_SMALL);
+end;
+
+
+{ TGTK3WSCustomShellListView }
+
+class function TGTK3WSCustomShellListView.GetBuiltInImageIndex(
+  AListView: TCustomShellListView; const AFileName: String;
+  ALargeImage: Boolean): Integer;
+var
+  bmpSmall, bmpLarge: TBitmap;
+  iconName: String;
+  FCacheImageIndex: Integer;
+begin
+  Result := -1;
+
+  CreateLVImageList;
+
+  if ALargeImage then
+  begin
+    AListView.SmallImages := nil;
+    AListView.SmallImagesWidth := 0;
+    AListView.LargeImages := FImageList;
+    AListView.LargeImagesWidth := ICON_SIZE_LARGE;
+  end
+  else begin
+    AListView.SmallImages := FImageList;
+    AListView.SmallImagesWidth := ICON_SIZE_SMALL;
+    AListView.LargeImages := nil;
+    AListView.LargeImagesWidth := 0;
+  end;
+
+  if FCacheIcon = nil then
+    FCacheIcon := TStringHashList.Create(True);
+
+  iconName := GetIconName(AFileName);
+
+  FCacheImageIndex := FCacheIcon.Find(iconName);
+  if FCacheImageIndex < 0 then
+  begin
+    bmpSmall := ExtractIcon(iconName, False);
+    bmpLarge := ExtractIcon(iconName, True);
+    try
+      Result := FImageList.AddMultipleResolutions([bmpSmall, bmpLarge]);
+
+      FCacheIcon.Add(iconName, Pointer(Result));
+    finally
+      bmpSmall.Free;
+      bmpLarge.Free;
+    end;
+  end
+  else begin
+    Result := PtrInt(FCacheIcon.List[FCacheImageIndex]^.Data);
+  end;
+end;
+
+procedure ClearExtToMimeList;
+var
+  nodeList: TFPObjectList;
+  I, J : Integer;
+begin
+  for I := 0 to FExtToMimeIconName.HashTable.Count - 1 do
+  begin
+    begin
+      nodeList := TFPObjectList(FExtToMimeIconName.HashTable.Items[I]);
+      if Assigned(nodeList) then
+        for J := 0 to nodeList.Count - 1 do
+          TStringList(THtDataNode(nodeList.Items[J]).Data).Free;
+    end;
+  end;
+end;
+
+finalization
+  if Assigned(FExtToMimeIconName) then
+  begin
+    ClearExtToMimeList;
+    FExtToMimeIconName.Free;
+  end;
+
+  if Assigned(FLock) then
+    FLock.Free;
+
+  if Assigned(FImageList) then
+    FImageList.Free;
+
+  if Assigned(FCacheIcon) then
+    FCacheIcon.Free;
+
+end.
\ No newline at end of file
diff --git a/lcl/interfaces/qt5/qtwsfactory.pas b/lcl/interfaces/qt5/qtwsfactory.pas
index a780aeddc5..f7f0eeef9f 100644
--- a/lcl/interfaces/qt5/qtwsfactory.pas
+++ b/lcl/interfaces/qt5/qtwsfactory.pas
@@ -4,7 +4,7 @@ unit QtWSFactory;
 
 interface
 uses
-  Classes, Controls, ComCtrls, Calendar, StdCtrls, Spin, Grids,
+  Classes, Controls, ComCtrls, Calendar, StdCtrls, Spin, Grids, ShellCtrls,
   Dialogs, ExtCtrls, Buttons, CheckLst, Forms, Menus, RubberBand, PairSplitter,
   WSLCLClasses;
 
@@ -115,7 +115,8 @@ uses
  QtWSSpin,
  QtWSStdCtrls,
  QtWSGrids,
- QtWSDesigner;
+ QtWSDesigner,
+ QtWSShellCtrls;
 
 // imglist
 function RegisterCustomImageListResolution: Boolean; alias : 'WSRegisterCustomImageListResolution';
@@ -562,12 +563,14 @@ end;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomShellTreeView, TQTWSCustomShellTreeView);
+  Result := True;
 end;
 
 function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomShellListView, TQTWSCustomShellListView);
+  Result := True;
 end;
 
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
diff --git a/lcl/interfaces/qt5/qtwsshellctrls.pp b/lcl/interfaces/qt5/qtwsshellctrls.pp
new file mode 100644
index 0000000000..4151808b0f
--- /dev/null
+++ b/lcl/interfaces/qt5/qtwsshellctrls.pp
@@ -0,0 +1,424 @@
+{
+ *****************************************************************************
+ *                              WSShellCtrls.pp                              * 
+ *                              -------------                                * 
+ *                                                                           *
+ *                                                                           *
+ *****************************************************************************
+
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+unit qtwsshellctrls;
+
+{$mode objfpc}{$H+}
+{$I qtdefines.inc}
+
+interface
+
+uses
+  SysUtils, Classes, ComCtrls, ShellCtrls, Types,
+////////////////////////////////////////////////////
+// To get as little as posible circles,
+// uncomment only when needed for registration
+////////////////////////////////////////////////////
+//  Graphics, ImgList, Controls, ShellCtrls,
+////////////////////////////////////////////////////
+  WSShellCtrls;
+
+type
+
+  { TQTWSCustomShellTreeView }
+
+  TQTWSCustomShellTreeView = class(TWSCustomShellTreeView)
+  published
+    class function DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+      ANode: TTreeNode; ARect: TRect): Types.TSize; override;
+    class function GetBuiltinIconSize: Types.TSize; override;
+  end;
+
+  { TQTWSCustomShellListView }
+  TQTWSCustomShellListView = class(TWSCustomShellListView)
+  published
+    class function GetBuiltInImageIndex(AListView: TCustomShellListView;
+      const AFileName: String; ALargeImage: Boolean): Integer; override;
+  end;
+
+implementation
+
+uses
+  graphics, qt5, qtobjects, Contnrs, LCLType, SyncObjs, BaseUnix, StrUtils,
+  LazFileUtils, Controls, StringHashList, IniFiles;
+
+var
+  FExtToMimeIconName: TFPDataHashTable = nil;
+  FLock: TCriticalSection = nil;
+  FImageList: TImageList = nil;
+  FCacheIcon: TStringHashList = nil;
+
+const
+  ICON_SIZE_SMALL = 16;
+  ICON_SIZE_LARGE = 32;
+
+procedure LoadMimeIconNames;
+const
+  mime_globs = '/usr/share/mime/globs';
+  mime_generic_icons = '/usr/share/mime/generic-icons';
+var
+  I, J: Integer;
+  globs: TStringList = nil;
+  generic_icons: THashedStringList = nil;
+  sMimeType,
+  sMimeIconName,
+  sExtension: String;
+  node: THTDataNode = nil;
+  iconsList: TStringList;
+  EntriesCount: Cardinal;
+begin
+  if not Assigned(FLock) then
+    FLock := TCriticalSection.Create;
+
+  if not Assigned(FExtToMimeIconName) then
+    FExtToMimeIconName := TFPDataHashTable.Create;
+
+  FLock.Acquire;
+  try
+    if FExtToMimeIconName.Count = 0 then
+    begin
+      if FpAccess(mime_globs, R_OK) = 0 then
+      begin
+        // Load mapping: MIME type -> file extension.
+        globs:= TStringList.Create;
+        globs.NameValueSeparator:= ':';
+        globs.LoadFromFile(mime_globs);
+
+        // Try to load mapping: MIME type -> generic MIME icon name.
+        if FileExists(mime_generic_icons) then
+          begin
+            generic_icons:= THashedStringList.Create;
+            generic_icons.NameValueSeparator:= ':';
+            generic_icons.LoadFromFile(mime_generic_icons);
+          end;
+
+        EntriesCount := 0;
+        // Create mapping: file extension -> list of MIME icon names.
+        for I:= 0 to globs.Count - 1 do
+          if (globs.Strings[I]    <> EmptyStr) and   // bypass empty lines
+             (globs.Strings[I][1] <> '#') then // and comments
+          begin
+            sMimeType := globs.Names[I];
+            sMimeIconName:= StringReplace(sMimeType, '/', '-', []);
+            sExtension:= globs.ValueFromIndex[I];
+
+            // Support only extensions, not full file name masks.
+            if (sExtension <> EmptyStr) and (sExtension <> '.*') then
+            begin
+              node := THTDataNode(FExtToMimeIconName.Find(sExtension));
+              if not Assigned(node) then
+                begin
+                  iconsList := TStringList.Create;
+                  FExtToMimeIconName.Add(sExtension, iconsList);
+                  Inc(EntriesCount);
+                end
+              else
+                iconsList := TStringList(node.Data);
+
+              if iconsList.IndexOf(sMimeIconName) < 0 then
+                iconsList.Add(sMimeIconName);
+
+              // Shared-mime-info spec says:
+              // "If [generic-icon] is not specified then the mimetype is used to generate the
+              // generic icon by using the top-level media type (e.g. "video" in "video/ogg")
+              // and appending "-x-generic" (i.e. "video-x-generic" in the previous example)."
+              if Assigned(generic_icons) then
+                begin
+                  J := generic_icons.IndexOfName(sMimeType);
+                  if J <> -1 then
+                    sMimeIconName := generic_icons.ValueFromIndex[J] // found generic icon
+                  else
+                    sMimeIconName := Copy2Symb(sMimeIconName, '-') + '-x-generic';
+                end
+              else
+                sMimeIconName := Copy2Symb(sMimeIconName, '-') + '-x-generic';
+
+              if iconsList.IndexOf(sMimeIconName) < 0 then
+                iconsList.Add(sMimeIconName);
+            end;
+          end;
+      end;
+    end;
+
+  finally
+    if Assigned(globs) then
+      FreeAndNil(globs);
+    if Assigned(generic_icons) then
+      FreeAndNil(generic_icons);
+    FLock.Release;
+  end;
+
+end;   
+
+function IsDirectory(AFilename: String): Boolean;
+var
+  Info: BaseUnix.Stat;
+begin
+  Result := False;
+  if fpStat(AFilename, Info) >= 0 then
+    Result := fpS_ISDIR(Info.st_mode);
+end;
+
+function CheckIconName(const AIconName: Widestring): Boolean;
+begin
+  //QIcon_fromTheme can load icon name and absolute filepath, too
+  Result := ((AIconName <> EmptyStr) and (QIcon_hasThemeIcon(@AIconName) or FileExists(AIconName)));
+end;
+
+function QIconToHBitmap(AIcon: QIconH; ASize: Types.TSize): HBITMAP;
+var
+  AImage: QImageH;
+  APixmap: QPixmapH;
+begin
+  APixmap := QPixmap_create();
+  QIcon_pixmap(AIcon, APixmap, Types.PSize(@ASize));
+
+  AImage := QImage_create();
+  QPixmap_toImage(APixmap, AImage);
+  QPixmap_destroy(APixmap);
+
+  Result := HBitmap(TQtImage.Create(AImage));
+end;
+
+function ExtractIcon(const sIconName: WideString; ALargeImage: Boolean): TBitmap;
+var
+  QIcon: QIconH;
+  Size: Types.TSize;
+begin
+  Result := TBitmap.Create; 
+
+  if ALargeImage then
+    Size := Types.Size(ICON_SIZE_LARGE, ICON_SIZE_LARGE)
+  else
+    Size := Types.Size(ICON_SIZE_SMALL, ICON_SIZE_SMALL);
+
+  QIcon := QIcon_Create();
+  try
+    if CheckIconName(sIconName) then
+    begin
+      QIcon_fromTheme(QIcon, @sIconName);
+      Result.Handle := QIconToHBitmap(QIcon, Size);
+    end;
+  finally
+    QIcon_destroy(QIcon);
+  end;
+end;
+
+function GetIconByDesktopFile(AFileName: String): String;
+var
+  iniDesktop: TIniFile = nil;
+begin
+  Result := EmptyStr;
+
+  try
+    iniDesktop := TIniFile.Create(AFileName);
+    try
+      Result := iniDesktop.ReadString('Desktop Entry', 'Icon', EmptyStr);
+    finally
+      FreeAndNil(iniDesktop);
+    end;
+  except
+    Exit;
+  end;
+end;
+
+function GetIconName(const AFileName: WideString): WideString;
+var
+  I: Integer;
+  node: THTDataNode;
+  iconList: TStringList;
+  Extension: String;
+begin
+  LoadMimeIconNames;
+
+  Result := EmptyStr;
+
+  //It is a link? Ok, get target file icon
+  if FpReadLink(AFilename) <> EmptyStr then
+    Extension := '*' + ExtractFileExt(FpReadLink(AFileName))
+  else
+    Extension := '*' + ExtractFileExt(AFileName);
+
+  Extension := LowerCase(Extension);
+
+  //TODO: Special folders icon https://gitlab.gnome.org/GNOME/glib/-/commit/129eb074823101102611690f053ffa246bb7784d#3549e1301fc4c17bf0dd809eca0a36fb87aac264_1582_1582
+
+  if IsDirectory(AFileName) then
+  begin
+    if FileExists(AFileName + PathDelim + '.directory') then
+      Result := GetIconByDesktopFile(AFileName + PathDelim + '.directory')
+    else
+      Result := 'folder';
+  end
+  else if (Extension = '*.desktop') then
+  begin
+    Result := GetIconByDesktopFile(AFileName);
+  end
+  else if FileIsExecutable(AFileName) then
+  begin
+    Result := 'application-x-executable';
+  end
+  else if (Extension = '*.ico') then
+  begin
+    Result := AFileName;
+  end
+  else if (Extension <> '*') then
+  begin
+    node := THTDataNode(FExtToMimeIconName.Find(Extension));
+    if Assigned(node) then
+      begin
+        iconList := TStringList(node.Data);
+
+        //First valid icon wins
+        for I := 0 to iconList.Count - 1 do
+          begin
+            Result := iconList.Strings[I];
+            if QIcon_hasThemeIcon(@Result) then
+              break;
+          end;
+      end;
+  end;
+
+  //Not found icon? No problem. Use generic icon
+  if (not CheckIconName(Result)) or (Result = EmptyStr) then
+  begin
+    if FileIsText(AFileName) then
+      Result := 'text-x-generic'
+    else
+      Result := 'unknown';
+  end;
+end;
+
+procedure CreateLVImageList;
+begin
+  if Assigned(FImageList) then
+    Exit;
+
+  FImageList := TImageList.Create(nil);
+
+  FImageList.RegisterResolutions([ICON_SIZE_SMALL, ICON_SIZE_LARGE]);
+end;
+
+{ TQTWSCustomShellTreeView }
+
+class function TQTWSCustomShellTreeView.DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+  ANode: TTreeNode; ARect: TRect): Types.TSize;
+var
+  filename: WideString;
+  bmp: TBitmap;
+  iconName: String;
+begin
+  fileName := ATreeView.GetPathFromNode(ANode);
+  iconName := GetIconName(fileName);
+  bmp := ExtractIcon(iconName, False);
+  try
+    ATreeView.Canvas.Draw(ARect.Left, (ARect.Top + ARect.Bottom - bmp.Height) div 2, bmp);
+    Result := Types.Size(bmp.Width, bmp.Height);
+  finally
+    bmp.Free;
+  end;
+end;
+
+class function TQTWSCustomShellTreeView.GetBuiltinIconSize: Types.TSize;
+begin
+  Result := Types.Size(ICON_SIZE_SMALL, ICON_SIZE_SMALL);
+end;
+
+
+{ TQTWSCustomShellListView }
+
+class function TQTWSCustomShellListView.GetBuiltInImageIndex(
+  AListView: TCustomShellListView; const AFileName: String;
+  ALargeImage: Boolean): Integer;
+var
+  bmpSmall, bmpLarge: TBitmap;
+  iconName: String;
+  FCacheImageIndex: Integer;
+begin
+  Result := -1;
+
+  CreateLVImageList;
+
+  if ALargeImage then
+  begin
+    AListView.SmallImages := nil;
+    AListView.SmallImagesWidth := 0;
+    AListView.LargeImages := FImageList;
+    AListView.LargeImagesWidth := ICON_SIZE_LARGE;
+  end
+  else begin
+    AListView.SmallImages := FImageList;
+    AListView.SmallImagesWidth := ICON_SIZE_SMALL;
+    AListView.LargeImages := nil;
+    AListView.LargeImagesWidth := 0;
+  end;
+
+  if FCacheIcon = nil then
+    FCacheIcon := TStringHashList.Create(True);
+
+  iconName := GetIconName(AFileName);
+
+  FCacheImageIndex := FCacheIcon.Find(iconName);
+  if FCacheImageIndex < 0 then
+  begin
+    bmpSmall := ExtractIcon(iconName, False);
+    bmpLarge := ExtractIcon(iconName, True);
+    try
+      Result := FImageList.AddMultipleResolutions([bmpSmall, bmpLarge]);
+
+      FCacheIcon.Add(iconName, Pointer(Result));
+    finally
+      bmpSmall.Free;
+      bmpLarge.Free;
+    end;
+  end
+  else begin
+    Result := PtrInt(FCacheIcon.List[FCacheImageIndex]^.Data);
+  end;
+end;
+
+procedure ClearExtToMimeList;
+var
+  nodeList: TFPObjectList;
+  I, J : Integer;
+begin
+  for I := 0 to FExtToMimeIconName.HashTable.Count - 1 do
+  begin
+    begin
+      nodeList := TFPObjectList(FExtToMimeIconName.HashTable.Items[I]);
+      if Assigned(nodeList) then
+        for J := 0 to nodeList.Count - 1 do
+          TStringList(THtDataNode(nodeList.Items[J]).Data).Free;
+    end;
+  end;
+end;
+
+finalization
+  if Assigned(FExtToMimeIconName) then
+  begin
+    ClearExtToMimeList;
+    FExtToMimeIconName.Free;
+  end;
+
+  if Assigned(FLock) then
+    FLock.Free;
+
+  if Assigned(FImageList) then
+    FImageList.Free;
+
+  if Assigned(FCacheIcon) then
+    FCacheIcon.Free;
+
+end.
\ No newline at end of file
diff --git a/lcl/shellctrls.pas b/lcl/shellctrls.pas
index fbba4aea3b..505bb5a91a 100644
--- a/lcl/shellctrls.pas
+++ b/lcl/shellctrls.pas
@@ -245,6 +245,10 @@ type
     property OnAddItem: TAddItemEvent read FOnAddItem write FOnAddItem;
     { Protected properties which users may want to access, see bug 15374 }
     property Items;
+    property SmallImages;  
+    property SmallImagesWidth;
+    property LargeImages;   
+    property LargeImagesWidth;
   end;
 
   { TShellListView }
@@ -1539,9 +1543,9 @@ begin
         // Image index
         if FUseBuiltInIcons then
         begin
-          if (ViewStyle = vsIcon) and (LargeImages = nil) then
+          if (ViewStyle = vsIcon) then
             NewItem.ImageIndex := GetBuiltInImageIndex(CurFilePath, true)
-          else if (ViewStyle <> vsIcon) and (SmallImages = nil) then
+          else if (ViewStyle <> vsIcon) then
             NewItem.ImageIndex := GetBuiltinImageIndex(CurFilePath, false);
         end;
         if Assigned(FOnFileAdded) then FOnFileAdded(Self,NewItem);
-- 
2.18.0.windows.1

wp

2021-04-24 00:44

developer   ~0130557

Looks good (except for gtk3, but you wrote that), when I use the controls from a gtk2 IDE.

When I build a qt5 IDE, however, I get a "Linking error in lazarus.exe: Error: /home/werner/Laz-trunk/components/opengl//qlclopenglwidget.pas:83: undefined reference to `QLCLOpenGLWidget_override_paintGL'", but I think this is due to the setup of my VM running this linux. Need to check...

Can the qt5 code also be used for qt(4)? This would complete the Linux side of this report.

Not sure yet whether I keep the change in ShellCtrls ("if (ViewStyle = vsIcon) and (LargeImages = nil) then...") because the idea was to be able to override the built-in images by an external image list separately - turning off UseBuiltinIcons affects both small and large images.

Is there a special reason why you declared SmallImages, SmallImagesWidth, LargeImages and LargeImagesWidth public in TCustomShellListView? In TShellListView they are published, and if somebody creates a descendant control it's enough to have them protected.

Salvadorbs

2021-04-24 09:27

reporter   ~0130559

> Can the qt5 code also be used for qt(4)? This would complete the Linux side of this report.

I just tried. Unfortunately the libqt4pas library does not have the two core methods of icon extraction: QIcon_hasThemeIcon (checks for the existence of the icon in the theme folders) and QIcon_fromTheme (loads the icon into a QIcon object). These methods seem to exist in QT4 (https://doc.qt.io/archives/qt-4.8/qicon.html#fromTheme), so we should update (!?) Libqt4-pas. Is it worth it?

> Not sure yet whether I keep the change in ShellCtrls ("if (ViewStyle = vsIcon) and (LargeImages = nil) then...") because the idea was to be able to override the built-in images by an external image list
separately - turning off UseBuiltinIcons affects both small and large images.
Yeah, I admit this is a dirty workaround. I needed to set the imagelist inside T * Custom ShellListView.GetBuiltInImageIndex.

In Windows, I saw that you used the ListView_SetImageList () method, but for the other widgetsets I don't know any similar methods. But I'm not that much of a gtk * or qt expert (just for the last few months I've been working with Lazarus on Linux). If there's another better way to do it (and I hope so :) ), tell me.

> Is there a special reason why you declared SmallImages, SmallImagesWidth, LargeImages and LargeImagesWidth public in TCustomShellListView? In TShellListView they are published, and if somebody creates a descendant control it's enough to have them protected.

Without the declarations, I couldn't set ImageList (small or large) and allow size changes. However as above, if there is a better way to do it, no problem.

wp

2021-04-24 22:35

developer   ~0130565

Applied your patch - thanks for this contribution.

I prefer not to touch libqt4-pas, this is a job for someone else with better Linux knowledge than me.

Zeljan Rikalo

2021-04-25 10:47

developer   ~0130573

libqt4pas cannot be changed in this case since it is Qt 4.5 compatible. Mentioned functions are added in Qt 4.6.

wp

2021-05-02 12:00

developer   ~0130717

Had to revert r65060 because it breaks qt5, gtk2 and gtk3 on Windows (issue 0038831).

Issue History

Date Modified Username Field Change
2010-12-17 23:30 lainz New Issue
2010-12-17 23:30 lainz Widgetset => Win32/Win64
2010-12-18 10:18 Vincent Snijders LazTarget => -
2010-12-18 10:18 Vincent Snijders Assigned To => Felipe Monteiro de Carvalho
2010-12-18 10:18 Vincent Snijders Status new => assigned
2011-06-28 15:56 lainz Tag Attached: ListView
2013-07-27 00:32 Bart Broersma Note Added: 0069126
2015-08-13 13:35 lainz Note Added: 0085331
2015-08-15 09:01 Felipe Monteiro de Carvalho Note Added: 0085363
2015-08-16 00:26 Janusz Tomczak Note Added: 0085384
2017-11-23 10:01 PeterX Note Added: 0104220
2017-11-23 15:29 Bart Broersma Note Added: 0104231
2021-02-24 18:52 Juha Manninen Assigned To Felipe Monteiro de Carvalho => wp
2021-02-24 18:53 Juha Manninen Note Added: 0129149
2021-02-24 19:44 wp Note Added: 0129150
2021-02-24 20:32 Anton Kavalenka Note Added: 0129151
2021-02-24 20:32 Anton Kavalenka File Added: desk.pas
2021-02-24 20:32 Anton Kavalenka Note Edited: 0129151 View Revisions
2021-02-25 11:39 jcmartini Note Added: 0129156
2021-03-05 19:25 wp Note Added: 0129406
2021-03-06 12:33 wp Note Edited: 0129406 View Revisions
2021-03-07 16:07 wp Note Added: 0129486
2021-04-23 16:08 Salvadorbs Note Added: 0130540
2021-04-23 16:08 Salvadorbs File Added: 0001-LCL-ShellTreeView-Shell-icons-QT5-GTK2-GTK3.patch
2021-04-24 00:44 wp Note Added: 0130557
2021-04-24 00:44 wp Status assigned => feedback
2021-04-24 09:27 Salvadorbs Note Added: 0130559
2021-04-24 22:35 wp Note Added: 0130565
2021-04-24 23:48 wp Status feedback => assigned
2021-04-25 10:47 Zeljan Rikalo Note Added: 0130573
2021-05-02 10:58 wp Relationship added related to 0038831
2021-05-02 11:56 wp Status assigned => resolved
2021-05-02 11:56 wp Resolution open => fixed
2021-05-02 11:56 wp Fixed in Revision => 65079
2021-05-02 11:56 wp Widgetset Win32/Win64 => Win32/Win64
2021-05-02 11:57 wp Fixed in Revision 65079 =>
2021-05-02 11:57 wp Widgetset Win32/Win64 => Win32/Win64
2021-05-02 11:58 wp Status resolved => confirmed
2021-05-02 11:58 wp Resolution fixed => open
2021-05-02 12:00 wp Note Added: 0130717
2021-05-02 12:00 wp Status confirmed => acknowledged
2021-05-02 13:13 wp Status acknowledged => new
2021-05-02 13:14 wp Status new => assigned