From ecde167da74c86bc047aaf84c5e548cf65a5da98 Mon Sep 17 00:00:00 2001 From: Tomas Bzatek Date: Sat, 7 Jun 2008 20:34:49 +0200 Subject: Initial commit --- UFileAssoc.pas | 358 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 358 insertions(+) create mode 100644 UFileAssoc.pas (limited to 'UFileAssoc.pas') diff --git a/UFileAssoc.pas b/UFileAssoc.pas new file mode 100644 index 0000000..2764df8 --- /dev/null +++ b/UFileAssoc.pas @@ -0,0 +1,358 @@ +(* + Tux Commander - UFileAssoc - File Association system objects and functions + Copyright (C) 2007 Tomas Bzatek + Check for updates on tuxcmd.sourceforge.net + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) +unit UFileAssoc; + +interface + +uses Classes, SysUtils, GTKPixbuf, GTKClasses, GTKUtils, UEngines; + +type TAssocAction = class + ActionName, ActionCommand: string; + AutodetectGUI, RunInTerminal: boolean; + constructor Create; + end; + + TFileAssoc = class + Extensions, FileTypeName, FileTypeIcon, ColorString: string; + DefaultAction: integer; + ActionList: TList; + Pixmap, LnkPixmap: TGDKPixbuf; + constructor Create; + destructor Destroy; override; + end; + +const ConstFTAMetaDirectory = ''; + ConstFTAMetaFile = ''; + +{$I 'pixmaps/emblem_symbolic_link_png.inc'} +{$I 'pixmaps/gnome_dev_cdrom_16_png.inc'} +{$I 'pixmaps/gnome_dev_floppy_16_png.inc'} +{$I 'pixmaps/gnome_dev_harddisk_16_png.inc'} +{$I 'pixmaps/gnome_dev_removable_usb_16_png.inc'} +{$I 'pixmaps/gnome_mime_application_zip_16_png.inc'} +{$I 'pixmaps/gnome_mime_x_directory_smb_share_16_png.inc'} +{$I 'pixmaps/stock_folder_16_png.inc'} +{$I 'pixmaps/stock_lock_16_png.inc'} +{$I 'pixmaps/stock_lock_48_png.inc'} +{$I 'pixmaps/stock_new_16_png.inc'} +{$I 'pixmaps/stock_up_one_dir_16_png.inc'} + + + + + +var FolderIcon, FileIcon, UpDirIcon, SymLinkEmblem, FolderIconLnk, FileIconLnk, + FolderIconCached, FileIconCached, FolderIconLnkCached, FileIconLnkCached: TGDKPixbuf; + MounterHDD, MounterRemovable, MounterFloppy, MounterCD, MounterNetwork: TGDKPixbuf; + StockLock16, StockLock48: TGDKPixbuf; + ArchiveIcon, ArchiveIconLnk: TGDKPixbuf; + + +procedure LoadIcons; +procedure AddFileTypeIcon(Item: PDataItem); +procedure RecreateIcons(List: TList; const FreePixmaps: boolean = True); +procedure RemoveIconRefs(List: TList; FreeIt: boolean); +procedure AddDefaultItems(List: TList); + +implementation + +uses GTKForms, UConfig, UCore, UCoreUtils, UVFSCore; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +constructor TFileAssoc.Create; +begin + ActionList := TList.Create; + DefaultAction := 0; + FileTypeIcon := ''; + Extensions := ''; + FileTypeName := ''; + ColorString := ''; + Pixmap := TGDKPixbuf.Create(nil); +end; + +destructor TFileAssoc.Destroy; +var i: integer; +begin + try + if Assigned(ActionList) and (ActionList.Count > 0) then + for i := ActionList.Count - 1 downto 0 do + TAssocAction(ActionList[i]).Free; + ActionList.Clear; + ActionList.Free; +// Pixmap.Free; + except + end; +end; + +(********************************************************************************************************************************) +constructor TAssocAction.Create; +begin + RunInTerminal := False; + AutodetectGUI := True; +end; + +(********************************************************************************************************************************) +procedure LoadIcons; +begin + FolderIcon := TGDKPixbuf.Create(Application); + FolderIcon.LoadFromInline(@stock_folder_16_png[1]); + FolderIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal); + FileIcon := TGDKPixbuf.Create(Application); + FileIcon.LoadFromInline(@stock_new_16_png[1]); + FileIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal); + UpDirIcon := TGDKPixbuf.Create(Application); + UpDirIcon.LoadFromInline(@stock_up_one_dir_16_png[1]); + UpDirIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal); + SymLinkEmblem := TGDKPixbuf.Create(Application); + SymLinkEmblem.LoadFromInline(@emblem_symbolic_link_png[1]); + FolderIconLnk := TGDKPixbuf.Create(Application); + FolderIconLnk.FPixbuf := FolderIcon.Copy; + FolderIconLnk.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, FolderIconLnk.Width - SymLinkEmblem.Width, FolderIconLnk.Height - SymLinkEmblem.Height); + FileIconLnk := TGDKPixbuf.Create(Application); + FileIconLnk.FPixbuf := FileIcon.Copy; + FileIconLnk.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, FileIconLnk.Width - SymLinkEmblem.Width, FileIconLnk.Height - SymLinkEmblem.Height); + FolderIconCached := FolderIcon; + FileIconCached := FileIcon; + FolderIconLnkCached := FolderIconLnk; + FileIconLnkCached := FileIconLnk; + MounterHDD := TGDKPixbuf.Create(Application); + MounterHDD.LoadFromInline(@gnome_dev_harddisk_16_png[1]); + MounterRemovable := TGDKPixbuf.Create(Application); + MounterRemovable.LoadFromInline(@gnome_dev_removable_usb_16_png[1]); + MounterFloppy := TGDKPixbuf.Create(Application); + MounterFloppy.LoadFromInline(@gnome_dev_floppy_16_png[1]); + MounterCD := TGDKPixbuf.Create(Application); + MounterCD.LoadFromInline(@gnome_dev_cdrom_16_png[1]); + MounterNetwork := TGDKPixbuf.Create(Application); + MounterNetwork.LoadFromInline(@gnome_mime_x_directory_smb_share_16_png[1]); + StockLock16 := TGDKPixbuf.Create(Application); + StockLock16.LoadFromInline(@stock_lock_16_png[1]); + StockLock48 := TGDKPixbuf.Create(Application); + StockLock48.LoadFromInline(@stock_lock_48_png[1]); + ArchiveIcon := TGDKPixbuf.Create(Application); + ArchiveIcon.LoadFromInline(@gnome_mime_application_zip_16_png[1]); + ArchiveIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal); + ArchiveIconLnk := TGDKPixbuf.Create(Application); + ArchiveIconLnk.FPixbuf := ArchiveIcon.Copy; + ArchiveIconLnk.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, FolderIconLnk.Width - SymLinkEmblem.Width, FolderIconLnk.Height - SymLinkEmblem.Height); +end; + +(********************************************************************************************************************************) +procedure AddFileTypeIcon(Item: PDataItem); +var Ext: string; + b: boolean; + i, j, Last: integer; + AColor: TGDKColor; + Plugin: TVFSPlugin; +begin + with Item^ do begin + ItemColor := nil; + if IsLnk and (not ConfLinkItemDefaultColors) then ItemColor := LinkItemGDKColor else + if IsDotFile and (not ConfDotFileItemDefaultColors) then ItemColor := DotFileItemGDKColor; + if IsDir then begin + if IsLnk then Icon := FolderIconLnkCached.FPixbuf + else Icon := FolderIconCached.FPixbuf; + end else + begin + if not IsLnk then Icon := FileIconCached.FPixbuf + else Icon := FileIconLnkCached.FPixbuf; + if (Pos('.', AName) > 1) and (LastDelimiter('.', AName) < Length(AName)) then begin + Ext := ANSIUpperCase(Trim(Copy(AName, LastDelimiter('.', AName) + 1, Length(AName) - LastDelimiter('.', AName)))); + + // Try to find a plugin which can handle this archive type + b := False; + Plugin := nil; + if PluginList.Count > 0 then + for i := 0 to PluginList.Count - 1 do begin + Plugin := TVFSPlugin(PluginList[i]); + if Length(Plugin.Extensions) > 0 then + for j := 0 to Length(Plugin.Extensions) - 1 do begin + if AnsiCompareText(Plugin.Extensions[j], Ext) = 0 then begin + b := True; + if IsLnk then Icon := ArchiveIconLnk.FPixbuf + else Icon := ArchiveIcon.FPixbuf; + Break; + end; + end; + if b then Break; + end; + + // Try to find an association + if (not b) and (AssocList.Count > 0) then + for i := 0 to AssocList.Count - 1 do + with TFileAssoc(AssocList[i]) do + if Length(Trim(Extensions)) > 0 then begin + b := False; + if Pos(';', Extensions) = 0 then b := ANSIUpperCase(Trim(Extensions)) = Ext else begin + Last := 0; + for j := 1 to Length(Extensions) do + if Extensions[j] = ';' then begin + if ANSIUpperCase(Trim(Copy(Extensions, Last + 1, j - Last - 1))) = Ext then begin + b := True; + Break; + end; + Last := j; + end; + if not b then b := ANSIUpperCase(Trim(Copy(Extensions, LastDelimiter(';', Extensions) + 1, Length(Extensions) - LastDelimiter(';', Extensions)))) = Ext; + end; + if b then begin + if Assigned(Pixmap) then + if IsLnk and Assigned(LnkPixmap) and Assigned(LnkPixmap.FPixbuf) + then Icon := LnkPixmap.FPixbuf + else Icon := Pixmap.FPixbuf; + if ItemColor = nil then + if (ColorString = '') or (not StringToGDKColor(ColorString, AColor)) + then ItemColor := NormalItemGDKColor + else ItemColor := GDKColorToPGdkColor(AColor); + end; + end; + + end; + end; + end; +end; + +(********************************************************************************************************************************) +procedure RecreateIcons(List: TList; const FreePixmaps: boolean = True); +var i: integer; + b: boolean; +begin + if Assigned(List) and (List.Count > 0) then + for i := 0 to List.Count - 1 do + if Assigned(List[i]) and (TObject(List[i]) is TFileAssoc) then + with TFileAssoc(List[i]) do begin + // Destroy old objects + if (Pixmap <> FileIcon) and (Pixmap <> FileIconLnk) and (Pixmap <> UpDirIcon) and (Pixmap <> FolderIcon) and + (Pixmap <> FileIconCached) and (Pixmap <> FileIconLnkCached) and (Pixmap <> FolderIconCached) and (Pixmap <> FolderIconLnkCached) and + (Pixmap <> FolderIconLnk) and Assigned(Pixmap) and Assigned(Pixmap.FPixbuf) then + begin + if FreePixmaps then Pixmap.Free; + Pixmap := nil; + end; + if (LnkPixmap <> FileIcon) and (LnkPixmap <> FileIconLnk) and (LnkPixmap <> UpDirIcon) and (LnkPixmap <> FolderIcon) and + (Pixmap <> FileIconCached) and (Pixmap <> FileIconLnkCached) and (Pixmap <> FolderIconCached) and (Pixmap <> FolderIconLnkCached) and + (LnkPixmap <> FolderIconLnk) and Assigned(LnkPixmap) and Assigned(LnkPixmap.FPixbuf) then + begin + if FreePixmaps then LnkPixmap.Free; + LnkPixmap := nil; + end; + // Load / Assign icon + b := FileExists(FileTypeIcon); + if b then begin + if not Assigned(Pixmap) then Pixmap := TGDKPixbuf.Create(nil); + b := Pixmap.LoadFromFile(FileTypeIcon); + if b then Pixmap.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal); + end; + if not b then + if FileTypeName = ConstFTAMetaDirectory then Pixmap := FolderIcon else + if FileTypeName = ConstFTAMetaFile then Pixmap := FileIcon + else Pixmap := FileIconCached; + // Create Link overelay + if Assigned(Pixmap) and Assigned(Pixmap.FPixbuf) and Assigned(SymLinkEmblem) then begin + LnkPixmap := TGDKPixbuf.Create(nil); + LnkPixmap.FPixbuf := Pixmap.Copy; + LnkPixmap.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, LnkPixmap.Width - SymLinkEmblem.Width, LnkPixmap.Height - SymLinkEmblem.Height); + end else LnkPixmap := Pixmap; + + if FileTypeName = ConstFTAMetaDirectory then begin + FolderIconCached := Pixmap; + FolderIconLnkCached := LnkPixmap; + end; + if FileTypeName = ConstFTAMetaFile then begin + FileIconCached := Pixmap; + FileIconLnkCached := LnkPixmap; + end; + end; +end; + +(********************************************************************************************************************************) +procedure RemoveIconRefs(List: TList; FreeIt: boolean); +var i: integer; +begin + if Assigned(List) and (List.Count > 0) then + for i := 0 to List.Count - 1 do + if Assigned(List[i]) and (TObject(List[i]) is TFileAssoc) then + with TFileAssoc(List[i]) do begin + if FreeIt and Assigned(Pixmap) then Pixmap.Free; + Pixmap := nil; + if FreeIt and Assigned(LnkPixmap) then LnkPixmap.Free; + LnkPixmap := nil; + end; +end; + +(********************************************************************************************************************************) +procedure AddDefaultItems(List: TList); +var Item: TFileAssoc; + i: integer; + Found: boolean; +begin + // Add default directory item + try + Found := False; + if List.Count > 0 then + for i := 0 to List.Count - 1 do + if TFileAssoc(List[i]).FileTypeName = ConstFTAMetaDirectory then begin + Found := True; + Break; + end; + if not Found then begin + Item := TFileAssoc.Create; + Item.FileTypeName := ConstFTAMetaDirectory; + Item.Extensions := ''; + Item.FileTypeIcon := ''; + Item.ColorString := ''; + Item.DefaultAction := 0; + Item.ActionList := TList.Create; + Item.Pixmap := nil; + Item.LnkPixmap := nil; + List.Insert(0, Item); + end; + except end; + + // Add default file item + try + Found := False; + if List.Count > 0 then + for i := 0 to List.Count - 1 do + if TFileAssoc(List[i]).FileTypeName = ConstFTAMetaFile then begin + Found := True; + Break; + end; + if not Found then begin + Item := TFileAssoc.Create; + Item.FileTypeName := ConstFTAMetaFile; + Item.Extensions := ''; + Item.FileTypeIcon := ''; + Item.ColorString := ''; + Item.DefaultAction := 0; + Item.ActionList := TList.Create; + Item.Pixmap := nil; + Item.LnkPixmap := nil; + List.Insert(0, Item); + end; + except end; +end; + +(********************************************************************************************************************************) + +end. -- cgit v1.2.3