diff --git a/.gitattributes b/.gitattributes index 194fb5e80a..21b4661f44 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10162,7 +10162,6 @@ lcl/interfaces/gtk2/gtk2wsimglist.pp svneol=native#text/pascal lcl/interfaces/gtk2/gtk2wsmenus.pp svneol=native#text/pascal lcl/interfaces/gtk2/gtk2wspairsplitter.pp svneol=native#text/pascal lcl/interfaces/gtk2/gtk2wsprivate.pp svneol=native#text/pascal -lcl/interfaces/gtk2/gtk2wsshellctrls.pp svneol=native#text/pascal lcl/interfaces/gtk2/gtk2wsspin.pp svneol=native#text/pascal lcl/interfaces/gtk2/gtk2wsstdctrls.pp svneol=native#text/pascal lcl/interfaces/gtk2/interfaces.pas svneol=native#text/pascal @@ -10216,7 +10215,6 @@ lcl/interfaces/gtk3/gtk3wsfactory.pas svneol=native#text/plain lcl/interfaces/gtk3/gtk3wsforms.pp svneol=native#text/plain lcl/interfaces/gtk3/gtk3wsimglist.pp svneol=native#text/plain lcl/interfaces/gtk3/gtk3wsmenus.pp svneol=native#text/plain -lcl/interfaces/gtk3/gtk3wsshellctrls.pp svneol=native#text/plain lcl/interfaces/gtk3/gtk3wsspin.pp svneol=native#text/plain lcl/interfaces/gtk3/gtk3wssplitter.pas svneol=native#text/pascal lcl/interfaces/gtk3/gtk3wsstdctrls.pp svneol=native#text/plain @@ -11058,7 +11056,6 @@ lcl/interfaces/qt5/qtwsgrids.pp svneol=native#text/plain lcl/interfaces/qt5/qtwsimglist.pp svneol=native#text/plain lcl/interfaces/qt5/qtwsmenus.pp svneol=native#text/plain lcl/interfaces/qt5/qtwspairsplitter.pp svneol=native#text/plain -lcl/interfaces/qt5/qtwsshellctrls.pp svneol=native#text/pascal lcl/interfaces/qt5/qtwsspin.pp svneol=native#text/plain lcl/interfaces/qt5/qtwsstdctrls.pp svneol=native#text/plain lcl/interfaces/qt5/qtx11.inc svneol=native#text/plain diff --git a/lcl/interfaces/fpmake.pp b/lcl/interfaces/fpmake.pp index 8a37aa438e..58dd35a720 100644 --- a/lcl/interfaces/fpmake.pp +++ b/lcl/interfaces/fpmake.pp @@ -177,7 +177,6 @@ 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'); @@ -204,7 +203,7 @@ begin t.Dependencies.AddUnit('win32wsimglist'); t.Dependencies.AddUnit('win32wsmenus'); t.Dependencies.AddUnit('win32wspairsplitter'); - t.Dependencies.AddUnit('win32wsshellctlrs'); + t.Dependencies.AddUnit('win32wsshellctrls'); t.Dependencies.AddUnit('win32wsspin'); t.Dependencies.AddUnit('win32wsstdctrls'); t.Dependencies.AddUnit('win32wstoolwin'); @@ -256,7 +255,6 @@ 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'); @@ -319,7 +317,6 @@ 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'); @@ -512,7 +509,6 @@ 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'); @@ -592,7 +588,6 @@ 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'); @@ -654,7 +649,6 @@ 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 e1a72d04cb..e061b8e0f6 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, ShellCtrls, + Controls, ComCtrls, Calendar, StdCtrls, Spin, Dialogs, ExtCtrls, ExtDlgs, Buttons, CheckLst, Forms, Grids, Menus, PairSplitter, WSLCLClasses; @@ -124,7 +124,6 @@ uses Gtk2WSStdCtrls, Gtk2WSPairSplitter, Gtk2WSPrivate, - Gtk2WSShellCtrls, UnityWSCtrls; // imglist @@ -625,14 +624,12 @@ end; // ShellCtrls function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView'; begin - RegisterWSComponent(TCustomShellTreeView, TGTK2WSCustomShellTreeView); - Result := True; + Result := False; end; function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView'; begin - RegisterWSComponent(TCustomShellListView, TGTK2WSCustomShellListView); - Result := True; + Result := False; end; function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs'; diff --git a/lcl/interfaces/gtk2/gtk2wsshellctrls.pp b/lcl/interfaces/gtk2/gtk2wsshellctrls.pp deleted file mode 100644 index 403397ed6e..0000000000 --- a/lcl/interfaces/gtk2/gtk2wsshellctrls.pp +++ /dev/null @@ -1,478 +0,0 @@ -{ - ***************************************************************************** - * 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 10447fb0b4..20367ac893 100644 --- a/lcl/interfaces/gtk3/gtk3wsfactory.pas +++ b/lcl/interfaces/gtk3/gtk3wsfactory.pas @@ -20,8 +20,7 @@ unit Gtk3WSFactory; interface uses Classes, Controls, ComCtrls, Calendar, StdCtrls, Dialogs, ExtCtrls, ExtDlgs, - Buttons, Spin, CheckLst, Forms, Menus, ImgList, PairSplitter, WSLCLClasses, - ShellCtrls; + Buttons, Spin, CheckLst, Forms, Menus, ImgList, PairSplitter, WSLCLClasses; // imglist @@ -140,8 +139,7 @@ uses uses Gtk3WSImgList, Gtk3WSControls, Gtk3WSForms, Gtk3WSButtons, Gtk3WSStdCtrls, Gtk3WSComCtrls, Gtk3WSExtCtrls, Gtk3WSSpin, Gtk3WSMenus, Gtk3WSCalendar, - Gtk3WSDialogs, Gtk3WSCheckLst, Gtk3WSExtDlgs, gtk3wssplitter, Gtk3WSTrayIcon, - Gtk3WSShellCtrls; + Gtk3WSDialogs, Gtk3WSCheckLst, Gtk3WSExtDlgs, gtk3wssplitter, Gtk3WSTrayIcon; // imglist function RegisterCustomImageListResolution: Boolean; alias : 'WSRegisterCustomImageListResolution'; @@ -627,14 +625,12 @@ end; // ShellCtrls function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView'; begin - RegisterWSComponent(TCustomShellTreeView, TGTK3WSCustomShellTreeView); - Result := True; + Result := False; end; function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView'; begin - RegisterWSComponent(TCustomShellListView, TGTK3WSCustomShellListView); - Result := True; + Result := False; end; function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs'; diff --git a/lcl/interfaces/gtk3/gtk3wsshellctrls.pp b/lcl/interfaces/gtk3/gtk3wsshellctrls.pp deleted file mode 100644 index 9e9a08ede9..0000000000 --- a/lcl/interfaces/gtk3/gtk3wsshellctrls.pp +++ /dev/null @@ -1,478 +0,0 @@ -{ - ***************************************************************************** - * 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 f7f0eeef9f..a780aeddc5 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, ShellCtrls, + Classes, Controls, ComCtrls, Calendar, StdCtrls, Spin, Grids, Dialogs, ExtCtrls, Buttons, CheckLst, Forms, Menus, RubberBand, PairSplitter, WSLCLClasses; @@ -115,8 +115,7 @@ uses QtWSSpin, QtWSStdCtrls, QtWSGrids, - QtWSDesigner, - QtWSShellCtrls; + QtWSDesigner; // imglist function RegisterCustomImageListResolution: Boolean; alias : 'WSRegisterCustomImageListResolution'; @@ -563,14 +562,12 @@ end; // ShellCtrls function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView'; begin - RegisterWSComponent(TCustomShellTreeView, TQTWSCustomShellTreeView); - Result := True; + Result := False; end; function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView'; begin - RegisterWSComponent(TCustomShellListView, TQTWSCustomShellListView); - Result := True; + Result := False; end; function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs'; diff --git a/lcl/interfaces/qt5/qtwsshellctrls.pp b/lcl/interfaces/qt5/qtwsshellctrls.pp deleted file mode 100644 index 4151808b0f..0000000000 --- a/lcl/interfaces/qt5/qtwsshellctrls.pp +++ /dev/null @@ -1,424 +0,0 @@ -{ - ***************************************************************************** - * 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 505bb5a91a..fbba4aea3b 100644 --- a/lcl/shellctrls.pas +++ b/lcl/shellctrls.pas @@ -245,10 +245,6 @@ 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 } @@ -1543,9 +1539,9 @@ begin // Image index if FUseBuiltInIcons then begin - if (ViewStyle = vsIcon) then + if (ViewStyle = vsIcon) and (LargeImages = nil) then NewItem.ImageIndex := GetBuiltInImageIndex(CurFilePath, true) - else if (ViewStyle <> vsIcon) then + else if (ViewStyle <> vsIcon) and (SmallImages = nil) then NewItem.ImageIndex := GetBuiltinImageIndex(CurFilePath, false); end; if Assigned(FOnFileAdded) then FOnFileAdded(Self,NewItem);