| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863 |
- unit CustomDirView;
- interface
- {$R DirImg.res}
- {$WARN UNIT_PLATFORM OFF}
- uses
- Windows, Messages, Classes, Graphics, Controls,
- Forms, ComCtrls, ShellAPI, ComObj, ShlObj, Dialogs,
- ActiveX, CommCtrl, Extctrls, ImgList, Menus,
- PIDL, BaseUtils, DragDrop, DragDropFilesEx, IEDriveInfo,
- IEListView, PathLabel, AssociatedStatusBar, CustomPathComboBox, SysUtils;
- const
- clDefaultItemColor = -(COLOR_ENDCOLORS + 1);
- WM_USER_RENAME = WM_USER + 57;
- oiNoOverlay = $00;
- oiDirUp = $01;
- oiLink = $02;
- oiBrokenLink = $04;
- oiShared = $08;
- DefaultHistoryMenuWidth = 300;
- DefaultHistoryMenuLen = 9;
- DefaultHistoryCount = 200;
- const
- DDMaxSlowCount = 3;
- DDVScrollDelay = 2000000;
- DDHScrollDelay = 2000000;
- DDDragStartDelay = 500000;
- DirAttrMask = SysUtils.faDirectory or SysUtils.faSysFile or SysUtils.faHidden;
- type
- {Drag&Drop events:}
- TDDError = (DDCreateShortCutError, DDPathNotFoundError);
- TDDOnDragEnter = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint; var Accept: Boolean) of object;
- TDDOnDragLeave = procedure(Sender: TObject) of object;
- TDDOnDragOver = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
- TDDOnDrop = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
- TDDOnQueryContinueDrag = procedure(Sender: TObject; FEscapePressed: BOOL; grfKeyState: Longint; var Result: HResult) of object;
- TDDOnGiveFeedback = procedure(Sender: TObject; dwEffect: Longint; var Result: HResult) of object;
- TDDOnDragDetect = procedure(Sender: TObject; grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus) of object;
- TDDOnCreateDragFileList = procedure(Sender: TObject; FileList: TFileList; var Created: Boolean) of object;
- TDDOnCreateDataObject = procedure(Sender: TObject; var DataObject: TDataObject) of object;
- TDDOnTargetHasDropHandler = procedure(Sender: TObject; Item: TListItem; var Effect: Integer; var DropHandler: Boolean) of object;
- TOnProcessDropped = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
- TDDErrorEvent = procedure(Sender: TObject; ErrorNo: TDDError) of object;
- TDDExecutedEvent = procedure(Sender: TObject; dwEffect: Longint) of object;
- TDDFileOperationEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string;
- var DoOperation: Boolean) of object;
- TDDFileOperationExecutedEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string) of object;
- TDirViewExecFileEvent = procedure(Sender: TObject; Item: TListItem; var AllowExec: Boolean) of object;
- TRenameEvent = procedure(Sender: TObject; Item: TListItem; NewName: string) of object;
- type
- TCustomDirView = class;
- TSelAttr = (selDontCare, selYes, selNo);
- TFileFilter = record
- Masks: string;
- IncludeAttr: Word; { see TSearchRec.Attr }
- ExcludeAttr: Word;
- Directories: Boolean;
- FileSizeFrom: Int64;
- FileSizeTo: Int64;
- ModificationFrom: TDateTime;
- ModificationTo: TDateTime;
- end;
- THistoryDirection = (hdBack, hdForward);
- THistoryChangeEvent = procedure(Sender: TCustomDirView) of object;
- TDVGetFilterEvent = procedure(Sender: TCustomDirView; Select: Boolean;
- var Filter: TFileFilter) of object;
- TCompareCriteria = (ccTime, ccSize);
- TCompareCriterias = set of TCompareCriteria;
- TCustomizableDragDropFilesEx = class(TDragDropFilesEx)
- public
- function Execute(DataObject: TDataObject): TDragResult;
- end;
- TCustomDirView = class(TIEListView)
- private
- FAddParentDir: Boolean;
- FDimmHiddenFiles: Boolean;
- FShowDirectories: Boolean;
- FDirsOnTop: Boolean;
- FShowSubDirSize: Boolean;
- FSortByExtension: Boolean;
- FWantUseDragImages: Boolean;
- FCanUseDragImages: Boolean;
- FDragDropFilesEx: TCustomizableDragDropFilesEx;
- FInvalidNameChars: string;
- FSingleClickToExec: Boolean;
- FUseSystemContextMenu: Boolean;
- FOnGetSelectFilter: TDVGetFilterEvent;
- FOnStartLoading: TNotifyEvent;
- FOnLoaded: TNotifyEvent;
- FOnDirUpdated: TNotifyEvent;
- FReloadTime: TSystemTime;
- FDragDrive: TDrive;
- FExeDrag: Boolean;
- FDDLinkOnExeDrag: Boolean;
- FOnDDDragEnter: TDDOnDragEnter;
- FOnDDDragLeave: TDDOnDragLeave;
- FOnDDDragOver: TDDOnDragOver;
- FOnDDDrop: TDDOnDrop;
- FOnDDQueryContinueDrag: TDDOnQueryContinueDrag;
- FOnDDGiveFeedback: TDDOnGiveFeedback;
- FOnDDDragDetect: TDDOnDragDetect;
- FOnDDCreateDragFileList: TDDOnCreateDragFileList;
- FOnDDProcessDropped: TOnProcessDropped;
- FOnDDError: TDDErrorEvent;
- FOnDDExecuted: TDDExecutedEvent;
- FOnDDFileOperation: TDDFileOperationEvent;
- FOnDDFileOperationExecuted: TDDFileOperationExecutedEvent;
- FOnDDEnd: TNotifyEvent;
- FOnDDCreateDataObject: TDDOnCreateDataObject;
- FOnDDTargetHasDropHandler: TDDOnTargetHasDropHandler;
- FOnExecFile: TDirViewExecFileEvent;
- FForceRename: Boolean;
- FLastDDResult: TDragResult;
- FLastRenameName: string;
- FLastVScrollTime: TFileTime;
- FVScrollCount: Integer;
- FContextMenu: Boolean;
- FDragEnabled: Boolean;
- FDragPos: TPoint;
- FStartPos: TPoint;
- FDDOwnerIsSource: Boolean;
- FAbortLoading: Boolean;
- FAnimation: TAnimate;
- FBackCount: Integer;
- FBackMenu: TPopupMenu;
- FDontRecordPath: Boolean;
- FDragOnDriveIsMove: Boolean;
- FNotifyEnabled: Boolean;
- FDragStartTime: TFileTime;
- FForwardMenu: TPopupMenu;
- FHistoryPaths: TStrings;
- FImageList16: TImageList;
- FImageList32: TImageList;
- FLoadAnimation: Boolean;
- FMaxHistoryCount: Integer;
- FMaxHistoryMenuLen: Integer;
- FMaxHistoryMenuWidth: Integer;
- FNeverPainted: Boolean;
- FPathComboBox: TCustomPathComboBox;
- FPathLabel: TCustomPathLabel;
- FStatusBar: TAssociatedStatusBar;
- FOnBeginRename: TRenameEvent;
- FOnEndRename: TRenameEvent;
- FOnHistoryChange: THistoryChangeEvent;
- FShowHiddenFiles: Boolean;
- FSavedSelection: Boolean;
- FSavedSelectionFile: string;
- FSavedSelectionLastFile: string;
- FPendingFocusSomething: Boolean;
- procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
- procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
- procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
- procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
- procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
- procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
- procedure DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem;
- State: TCustomDrawState; var DefaultDraw: Boolean);
- procedure DumbCustomDrawSubItem(Sender: TCustomListView;
- Item: TListItem; SubItem: Integer; State: TCustomDrawState;
- var DefaultDraw: Boolean);
- function GetBackMenu: TPopupMenu;
- function GetFilesMarkedSize: Int64;
- function GetForwardCount: Integer;
- function GetForwardMenu: TPopupMenu;
- function GetHistoryPath(Index: Integer): string;
- function GetTargetPopupMenu: Boolean;
- function GetUseDragImages: Boolean;
- procedure SetMaxHistoryCount(Value: Integer);
- procedure SetMaxHistoryMenuLen(Value: Integer);
- procedure SetMaxHistoryMenuWidth(Value: Integer);
- procedure SetPathComboBox(Value: TCustomPathComboBox);
- procedure SetPathLabel(Value: TCustomPathLabel);
- procedure SetStatusBar(Value: TAssociatedStatusBar);
- procedure SetTargetPopupMenu(Value: Boolean);
- procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
- procedure WMUserRename(var Message: TMessage); message WM_User_Rename;
- protected
- FCaseSensitive: Boolean;
- FDirty: Boolean;
- FFilesSize: Int64;
- FFilesSelSize: Int64;
- FHasParentDir: Boolean;
- FIsRecycleBin: Boolean;
- FLastPath: string;
- FLoadEnabled: Boolean;
- FLoading: Boolean;
- FSelectFile: string;
- FWatchForChanges: Boolean;
- procedure AddToDragFileList(FileList: TFileList; Item: TListItem); virtual;
- function CanEdit(Item: TListItem): Boolean; override;
- function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; override;
- procedure ClearItems; override;
- function GetDirOK: Boolean; virtual; abstract;
- procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus); virtual;
- procedure DDDragEnter(DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: longint; var Accept: Boolean);
- procedure DDDragLeave;
- procedure DDDragOver(grfKeyState: Longint; Point: TPoint; var dwEffect: Longint);
- procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); virtual; abstract;
- procedure DDDrop(DataObj: IDataObject; grfKeyState: LongInt; Point: TPoint; var dwEffect: Longint);
- procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint; Point: TPoint; dwEffect: Longint); virtual;
- procedure DDGiveFeedback(dwEffect: Longint; var Result: HResult); virtual;
- procedure DDMenuDone(Sender: TObject; AMenu: HMenu); virtual;
- procedure DDProcessDropped(Sender: TObject; grfKeyState: Longint;
- Point: TPoint; dwEffect: Longint);
- procedure DDQueryContinueDrag(FEscapePressed: LongBool;
- grfKeyState: Longint; var Result: HResult); virtual;
- procedure DDSpecifyDropTarget(Sender: TObject; DragDropHandler: Boolean;
- Point: TPoint; var pidlFQ : PItemIDList; var Filename: string); virtual;
- procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItemA); virtual;
- function GetDragSourceEffects: TDropEffectSet; virtual;
- function GetPathName: string; virtual; abstract;
- function GetFilesCount: Integer; virtual;
- procedure ColClick(Column: TListColumn); override;
- procedure CreateWnd; override;
- function CustomCreateFileList(Focused, OnlyFocused: Boolean;
- FullPath: Boolean; FileList: TStrings = nil): TStrings;
- function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
- Stage: TCustomDrawStage): Boolean; override;
- function CustomDrawSubItem(Item: TListItem; SubItem: Integer;
- State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; override;
- procedure CustomSortItems(SortProc: Pointer);
- procedure Delete(Item: TListItem); override;
- procedure DisplayContextMenu(Where: TPoint); virtual; abstract;
- procedure DoAnimation(Start: Boolean);
- procedure DoHistoryChange; dynamic;
- function DragCompleteFileList: Boolean; virtual;
- procedure Edit(const HItem: TLVItem); override;
- procedure EndSelectionUpdate; override;
- procedure Execute(Item: TListItem); virtual;
- procedure ExecuteFile(Item: TListItem); virtual; abstract;
- procedure FocusSomething; override;
- function GetIsRoot: Boolean; virtual; abstract;
- procedure IconsSetImageList; virtual;
- function ItemCanDrag(Item: TListItem): Boolean; virtual;
- function ItemColor(Item: TListItem): TColor; virtual;
- function ItemDragFileName(Item: TListItem): string; virtual;
- function ItemFileSize(Item: TListItem): Int64; virtual; abstract;
- function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; virtual; abstract;
- function ItemFileTime(Item: TListItem): TDateTime; virtual; abstract;
- // ItemIsDirectory and ItemFullFileName is in public block
- function ItemIsRecycleBin(Item: TListItem): Boolean; virtual;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- procedure LoadFiles; virtual; abstract;
- procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer); virtual; abstract;
- procedure ProcessChangedFiles(DirView: TCustomDirView;
- FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
- Criterias: TCompareCriterias);
- procedure ReloadForce(CacheIcons : Boolean);
- procedure RetryRename(NewName: string);
- procedure SelectFiles(Filter: TFileFilter; Select: Boolean);
- procedure SetAddParentDir(Value: Boolean); virtual;
- procedure SetDimmHiddenFiles(Value: Boolean); virtual;
- procedure SetShowDirectories(Value: Boolean); virtual;
- procedure SetDirsOnTop(Value: Boolean);
- procedure SetItemImageIndex(Item: TListItem; Index: Integer); virtual; abstract;
- procedure SetLoadEnabled(Enabled : Boolean); virtual;
- procedure SetMultiSelect(Value: Boolean); override; //CLEAN virtual
- function GetPath: string; virtual; abstract;
- function GetValid: Boolean; override;
- procedure HistoryItemClick(Sender: TObject);
- procedure InternalEdit(const HItem: TLVItem); virtual; abstract;
- function ItemIsFile(Item: TListItem): Boolean; virtual; abstract;
- function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; virtual; abstract;
- function ItemOverlayIndexes(Item: TListItem): Word; virtual;
- procedure LimitHistorySize;
- function MinimizePath(Path: string; Len: Integer): string; virtual; abstract;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure PathChanged;
- procedure SetPath(Value: string); virtual; abstract;
- procedure SetSortByExtension(Value: Boolean);
- procedure SetShowHiddenFiles(Value: Boolean); virtual;
- procedure SetShowSubDirSize(Value: Boolean); virtual;
- procedure SetViewStyle(Value: TViewStyle); override;
- procedure SetWatchForChanges(Value: Boolean); virtual;
- function TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean; virtual;
- procedure UpdateHistoryMenu(Direction: THistoryDirection);
- procedure UpdatePathComboBox; dynamic;
- procedure UpdatePathLabel; dynamic;
- procedure UpdateStatusBar; dynamic;
- procedure WndProc(var Message: TMessage); override;
- property ImageList16: TImageList read FImageList16;
- property ImageList32: TImageList read FImageList32;
- public
- function AnyFileSelected(OnlyFocused: Boolean): Boolean;
- constructor Create(AOwner: TComponent); override;
- procedure CreateDirectory(DirName: string); virtual; abstract;
- destructor Destroy; override;
- procedure Load; virtual;
- procedure Reload(CacheIcons: Boolean); virtual;
- function CreateFocusedFileList(FullPath: Boolean; FileList: TStrings = nil): TStrings;
- function CreateFileList(Focused: Boolean; FullPath: Boolean; FileList: TStrings = nil): TStrings;
- function DoSelectByMask(Select: Boolean): Boolean; override;
- procedure ExecuteHomeDirectory; virtual; abstract;
- procedure ExecuteParentDirectory; virtual; abstract;
- procedure ExecuteRootDirectory; virtual; abstract;
- procedure ExecuteCurrentFile();
- function FindFileItem(FileName: string): TListItem;
- procedure HistoryGo(Index: Integer);
- function ItemIsDirectory(Item: TListItem): Boolean; virtual; abstract;
- function ItemIsParentDirectory(Item: TListItem): Boolean; virtual; abstract;
- function ItemFullFileName(Item: TListItem): string; virtual; abstract;
- function ItemFileName(Item: TListItem): string; virtual; abstract;
- procedure ReloadDirectory; virtual; abstract;
- procedure DisplayPropertiesMenu; virtual; abstract;
- function CreateChangedFileList(DirView: TCustomDirView; FullPath: Boolean;
- ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
- procedure CompareFiles(DirView: TCustomDirView; ExistingOnly: Boolean;
- Criterias: TCompareCriterias); virtual;
- procedure SaveSelection;
- procedure RestoreSelection;
- procedure DiscardSavedSelection;
- property AddParentDir: Boolean read FAddParentDir write SetAddParentDir default False;
- property DimmHiddenFiles: Boolean read FDimmHiddenFiles write SetDimmHiddenFiles default True;
- property ShowDirectories: Boolean read FShowDirectories write SetShowDirectories default True;
- property DirsOnTop: Boolean read FDirsOnTop write SetDirsOnTop default True;
- property DragDropFilesEx: TCustomizableDragDropFilesEx read FDragDropFilesEx;
- property ShowSubDirSize: Boolean read FShowSubDirSize write SetShowSubDirSize default False;
- property SortByExtension: Boolean read FSortByExtension write SetSortByExtension default False;
- property WantUseDragImages: Boolean read FWantUseDragImages write FWantUseDragImages default True;
- property UseDragImages: Boolean read GetUseDragImages stored False;
- property FullDrag default True;
- property TargetPopupMenu: Boolean read GetTargetPopupMenu write SetTargetPopupMenu default True;
- property DDOwnerIsSource: Boolean read FDDOwnerIsSource;
- property FilesSize: Int64 read FFilesSize;
- property FilesSelSize: Int64 read FFilesSelSize;
- property FilesCount: Integer read GetFilesCount;
- property FilesMarkedSize: Int64 read GetFilesMarkedSize;
- property HasParentDir: Boolean read FHasParentDir;
- //CLEANproperty MultiSelect write SetMultiSelect;
- property Path: string read GetPath write SetPath;
- property PathName: string read GetPathName;
- property ReloadTime: TSystemTime read FReloadTime;
- property SingleClickToExec: Boolean read FSingleClickToExec write FSingleClickToExec default False;
- property UseSystemContextMenu: Boolean read FUseSystemContextMenu
- write FUseSystemContextMenu default True;
- property Loading: Boolean read FLoading;
- property AbortLoading: Boolean read FAbortLoading write FAbortLoading stored False;
- property BackCount: Integer read FBackCount;
- property BackMenu: TPopupMenu read GetBackMenu;
- {Enable or disable populating the item list:}
- property LoadAnimation: Boolean read FLoadAnimation write FLoadAnimation default True;
- property LoadEnabled: Boolean read FLoadEnabled write SetLoadEnabled default True;
- {Displayed data is not valid => reload required}
- property Dirty: Boolean read FDirty;
- property DirOK: Boolean read GetDirOK;
- property LastPath: string read FLastPath;
- property IsRecycleBin: Boolean read FIsRecycleBin;
- property DDLinkOnExeDrag: Boolean read FDDLinkOnExeDrag
- write FDDLinkOnExeDrag default False;
- property DragDrive: TDrive read FDragDrive;
- property DragOnDriveIsMove: Boolean read FDragOnDriveIsMove write FDragOnDriveIsMove;
- property DragSourceEffects: TDropEffectSet read GetDragSourceEffects{ write FDragSourceEffects};
- property ExeDrag: Boolean read FExeDrag;
- property ForwardCount: Integer read GetForwardCount;
- property ForwardMenu: TPopupMenu read GetForwardMenu;
- property HistoryPath[Index: Integer]: string read GetHistoryPath;
- property IsRoot: Boolean read GetIsRoot;
- property LastDDResult: TDragResult read FLastDDResult;
- property SmallImages;
- property LargeImages;
- property MaxHistoryCount: Integer read FMaxHistoryCount write SetMaxHistoryCount default DefaultHistoryCount;
- property MaxHistoryMenuLen: Integer read FMaxHistoryMenuLen write SetMaxHistoryMenuLen default DefaultHistoryMenuLen;
- property MaxHistoryMenuWidth: Integer read FMaxHistoryMenuWidth write SetMaxHistoryMenuWidth default DefaultHistoryMenuWidth;
- property OnContextPopup;
- property OnBeginRename: TRenameEvent read FOnBeginRename write FOnBeginRename;
- property OnEndRename: TRenameEvent read FOnEndRename write FOnEndRename;
- property OnGetSelectFilter: TDVGetFilterEvent read FOnGetSelectFilter write FOnGetSelectFilter;
- property OnStartLoading: TNotifyEvent read FOnStartLoading write FOnStartLoading;
- property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
- {This event is fired, when any update has made to the listview}
- property OnDirUpdated: TNotifyEvent read FOnDirUpdated write FOnDirUpdated;
- {The mouse has entered the component window as a target of a drag&drop operation:}
- property OnDDDragEnter: TDDOnDragEnter read FOnDDDragEnter write FOnDDDragEnter;
- {The mouse has leaved the component window as a target of a drag&drop operation:}
- property OnDDDragLeave: TDDOnDragLeave read FOnDDDragLeave write FOnDDDragLeave;
- {The mouse is dragging in the component window as a target of a drag&drop operation:}
- property OnDDDragOver: TDDOnDragOver read FOnDDDragOver write FOnDDDragOver;
- {The Drag&drop operation is about to be executed:}
- property OnDDDrop: TDDOnDrop read FOnDDDrop write FOnDDDrop;
- property OnDDQueryContinueDrag: TDDOnQueryContinueDrag
- read FOnDDQueryContinueDrag write FOnDDQueryContinueDrag;
- property OnDDGiveFeedback: TDDOnGiveFeedback
- read FOnDDGiveFeedback write FOnDDGiveFeedback;
- {A drag&drop operation is about to be initiated whith
- the components window as the source:}
- property OnDDDragDetect: TDDOnDragDetect
- read FOnDDDragDetect write FOnDDDragDetect;
- property OnDDCreateDragFileList: TDDOnCreateDragFileList
- read FOnDDCreateDragFileList write FOnDDCreateDragFileList;
- property OnDDEnd: TNotifyEvent
- read FOnDDEnd write FOnDDEnd;
- property OnDDCreateDataObject: TDDOnCreateDataObject
- read FOnDDCreateDataObject write FOnDDCreateDataObject;
- property OnDDTargetHasDropHandler: TDDOnTargetHasDropHandler
- read FOnDDTargetHasDropHandler write FOnDDTargetHasDropHandler;
- {The component window is the target of a drag&drop operation:}
- property OnDDProcessDropped: TOnProcessDropped
- read FOnDDProcessDropped write FOnDDProcessDropped;
- {An error has occured during a drag&drop operation:}
- property OnDDError: TDDErrorEvent read FOnDDError write FOnDDError;
- {The drag&drop operation has been executed:}
- property OnDDExecuted: TDDExecutedEvent
- read FOnDDExecuted write FOnDDExecuted;
- {Event is fired just before executing the fileoperation. This event is also fired when
- files are pasted from the clipboard:}
- property OnDDFileOperation: TDDFileOperationEvent
- read FOnDDFileOperation write FOnDDFileOperation;
- {Event is fired after executing the fileoperation. This event is also fired when
- files are pasted from the clipboard:}
- property OnDDFileOperationExecuted: TDDFileOperationExecutedEvent
- read FOnDDFileOperationExecuted write FOnDDFileOperationExecuted;
- {Set AllowExec to false, if actual file should not be executed:}
- property OnExecFile: TDirViewExecFileEvent
- read FOnExecFile write FOnExecFile;
- property OnHistoryChange: THistoryChangeEvent read FOnHistoryChange write FOnHistoryChange;
- property PathComboBox: TCustomPathComboBox read FPathComboBox write SetPathComboBox;
- property PathLabel: TCustomPathLabel read FPathLabel write SetPathLabel;
- property ShowHiddenFiles: Boolean read FShowHiddenFiles write SetShowHiddenFiles default True;
- property StatusBar: TAssociatedStatusBar read FStatusBar write SetStatusBar;
- {Watch current directory for filename changes (create, rename, delete files)}
- property WatchForChanges: Boolean read FWatchForChanges write SetWatchForChanges default False;
- end;
- resourcestring
- SErrorOpenFile = 'Can''t open file: ';
- SErrorRenameFile = 'Can''t rename file or directory: ';
- SErrorRenameFileExists = 'File already exists: ';
- SErrorInvalidName= 'Filename contains invalid characters:';
- STextFileExt = 'File %s';
- STextFiles = '%u Files';
- STextDirectories = '%u Directories';
- SParentDir = 'Parent directory';
- SIconUpdateThreadTerminationError = 'Can''t terminate icon update thread.';
- SDragDropError = 'DragDrop Error: %d';
- SDirNotExists = 'Directory ''%s'' doesn''t exist.';
- {Additional non-component specific functions:}
- {Create and resolve a shell link (file shortcut):}
- function CreateFileShortCut(SourceFile, Target, DisplayName: string;
- UpdateIfExists: Boolean = False): Boolean;
- function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
- {Gets the shell's display icon for registered file extensions:}
- function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
- {Gets the shell's inforecord for registered fileextensions:}
- function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
- {Returns the displayname as used by the shell:}
- function GetShellDisplayName(const ShellFolder: IShellFolder; IDList: PItemIDList;
- Flags: DWORD; var Name: string): Boolean;
- function IsExecutable(FileName: string): Boolean;
- function GetNextMask(var Mask: string): string;
- function FileNameMatchesMasks(FileName: string; Masks: string): Boolean;
- procedure DefaultFileFilter(var Filter: TFileFilter);
- var
- StdDirIcon: Integer;
- StdDirSelIcon: Integer;
- DropSourceControl: TObject;
- UnknownFileIcon: Integer;
- HasExtendedCOMCTL32: Boolean;
- StdDirTypeName: string;
- DefaultExeIcon: Integer;
- UserDocumentDirectory: string;
- implementation
- uses
- {DriveView, }Math, Masks;
- const
- Space = ' ';
- ResDirUp = 'DIRUP%2.2d';
- ResLink = 'LINK%2.2d';
- ResBrokenLink = 'BROKEN%2.2d';
- var
- WinDir: string;
- TempDir: string;
- COMCTL32Version: DWORD;
- function IsExecutable(FileName: string): Boolean;
- var
- FileExt: string;
- begin
- FileExt := UpperCase(ExtractFileExt(FileName));
- Result := (FileExt = '.EXE') or (FileExt = '.COM');
- end;
- function GetNextMask(var Mask: string): string;
- var
- NextPos: Integer;
- begin
- NextPos := Pos(';', Mask);
- if NextPos = 0 then
- begin
- Result := Mask;
- SetLength(Mask, 0);
- end
- else
- begin
- Result := Copy(Mask, 1, NextPos - 1);
- Delete(Mask, 1, NextPos);
- end;
- end;
- function FileNameMatchesMasks(FileName: string; Masks: string): Boolean;
- begin
- Result := False;
- // there needs to be atleast one dot,
- // otherwise '*.*' mask would not select this file
- if Pos('.', FileName) = 0 then FileName := FileName + '.';
- while (not Result) and (Length(Masks) > 0) do
- Result := MatchesMask(FileName, GetNextMask(Masks));
- end;
- procedure DefaultFileFilter(var Filter: TFileFilter);
- begin
- with Filter do
- begin
- SetLength(Masks, 0);
- IncludeAttr := 0;
- ExcludeAttr := 0;
- Directories := False;
- FileSizeFrom := 0;
- FileSizeTo := 0;
- ModificationFrom := 0;
- ModificationTo := 0;
- end;
- end;
- { Shortcut-handling }
- function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
- var
- IUnk: IUnknown;
- HRes: HRESULT; // OLE-Operation Result
- SL: IShellLink; // Interface for ShellLink
- PF: IPersistFile; // Interface for PersistentFile
- SRec: TWIN32FINDDATA; // SearchRec of targetfile
- TargetDir: array[1..Max_Path] of Char; // Working directory of targetfile
- PSource: WideString; // Widestring(Source)
- Flags: DWORD;
- begin
- Result := '';
- IUnk := CreateComObject(CLSID_ShellLink);
- SL := IUnk as IShellLink;
- PF := IUnk as IPersistFile;
- PSource := SourceFile;
- HRes := PF.Load(PWideChar(PSource), STGM_READ);
- if Succeeded(Hres) then
- begin
- if not ShowDialog then Flags := SLR_NOUPDATE or (1500 shl 8) or SLR_NO_UI
- else Flags := SLR_NOUPDATE;
- HRes := SL.Resolve(Application.Handle, Flags);
- if Succeeded(HRes) then
- begin
- HRes := SL.GetPath(@TargetDir, MAX_PATH, SRec, {SLGP_UNCPRIORITY}{SLGP_SHORTPATH} 0);
- if Succeeded(HRes) then
- Result := string(PChar(@TargetDir));
- end;
- end;
- end; {ResolveShortCut}
- function CreateFileShortCut(SourceFile, Target, DisplayName: string;
- UpdateIfExists: Boolean): Boolean;
- var
- IUnk: IUnknown;
- Hres: HRESULT;
- ShellLink: IShellLink; // Interface to ShellLink
- IPFile: IPersistFile; // Interface to PersistentFile
- WideStr: WideString;
- TargetFile: string;
- begin
- Result := False;
- if Target = '' then TargetFile := SourceFile + '.lnk'
- else TargetFile := Target;
- WideStr := TargetFile;
- IUnk := CreateComObject(CLSID_ShellLink);
- ShellLink := IUnk as IShellLink;
- IPFile := IUnk as IPersistFile;
- if FileExists(TargetFile) and UpdateIfExists then
- begin
- HRes := IPFile.Load(PWChar(WideStr), 0);
- if not Succeeded(HRes) then Exit;
- end;
- with ShellLink do
- begin
- HRes := SetPath(PChar(SourceFile));
- if Succeeded(HRes) then
- HRes := SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
- if Succeeded(HRes) and (DisplayName <> '') then
- HRes := SetDescription(PChar(DisplayName));
- end;
- if Succeeded(Hres) then
- begin
- HRes := IPFile.Save(PWChar(WideStr),False);
- if Succeeded(HRes) then Result := True;
- end;
- end; {CreateShortCut}
- function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
- var
- FileInfo: TSHFileInfo;
- begin
- try
- SHGetFileInfo(PChar(AFile), Attrs, FileInfo, SizeOf(TSHFileInfo),
- Flags or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
- Result := FileInfo.iIcon;
- except
- Result := -1;
- end;
- end; {GetIconIndex}
- function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
- begin
- try
- SHGetFileInfo(PChar(AFile), Attrs, Result, SizeOf(TSHFileInfo), Flags);
- except
- FillChar(Result, SizeOf(Result), 0);
- end;
- end; {GetshFileInfo}
- function GetShellDisplayName(const ShellFolder: IShellFolder; IDList: PItemIDList;
- Flags: DWORD; var Name: string): Boolean;
- var
- Str: TStrRet;
- begin
- Result := True;
- Name := '';
- if ShellFolder.GetDisplayNameOf(IDList, Flags, Str) = NOERROR then
- begin
- case Str.uType of
- STRRET_WSTR: Name := WideCharToString(Str.pOleStr);
- STRRET_OFFSET: Name := PChar(UINT(IDList) + Str.uOffset);
- STRRET_CSTR: Name := Str.cStr;
- else Result := False;
- end;
- end
- else Result := False;
- end; {GetShellDisplayName}
- function COMCTL32OK: Boolean;
- {Returs, wether COMCTL32 supports the extended display properties:
- COMCTL32.DLL version 4.70 or higher ist required. Version 4.70 is
- included in Internet Explorer 4 with Active Desktop.
- Updates of COMCTL32.DLL are available at:
- http://msdn.microsoft.com/developer/downloads/files/40Comupd.htm }
- var
- VerInfoSize: DWORD;
- Dummy: DWORD;
- VerInfo: Pointer;
- FileInfo: PVSFixedFileInfo;
- FileInfoSize: UINT;
- begin
- Result := False;
- VerInfoSize := GetFileVersionInfoSize('COMCTL32.DLL', Dummy);
- if VerInfoSize > 0 then
- begin
- GetMem(VerInfo, VerInfoSize);
- try
- if GetFileVersionInfo(PChar('COMCTL32.DLL'), 0, VerInfoSize, VerInfo) then
- begin
- if VerQueryValue(VerInfo, '\', Pointer(FileInfo), FileInfoSize) then
- begin
- ComCTL32Version := FileInfo.dwFileVersionMS;
- Result := (ComCTL32Version >= $40046); { COMCTL32 Version >= 4.70 required }
- end
- else ComCTL32Version := 0;
- end;
- finally
- FreeMem(VerInfo, VerInfoSize);
- end;
- end;
- end; {COMCTL32OK}
- { TLoadAnimationStartThread }
- {constructor TLoadAnimationStartThread.Create(AInterval: Integer; AAnimation: TAnimate);
- begin
- inherited Create(True);
- FInterval := AInterval;
- FAnimation := AAnimation;
- Resume;
- end;
- procedure TLoadAnimationStartThread.Execute;
- var
- XInterval: Integer;
- begin
- XInterval := FInterval;
- while (not Terminated) and (XInterval > 0) do
- begin
- Sleep(10);
- Dec(XInterval, 10);
- end;
- if (not Terminated) and Assigned(FAnimation) then
- Synchronize(StartAnimation);
- end;
- procedure TLoadAnimationStartThread.StartAnimation;
- begin
- FAnimation.Visible := True;
- FAnimation.Active := True;
- end; }
- { TCustomizableDragDropFilesEx }
- function TCustomizableDragDropFilesEx.Execute(DataObject: TDataObject): TDragResult;
- begin
- if not Assigned(DataObject) then
- begin
- DataObject := CreateDataObject;
- end;
- Result := ExecuteOperation(DataObject);
- end;
- { TCustomDirView }
- constructor TCustomDirView.Create(AOwner: TComponent);
- var
- WinVer: TOSVersionInfo;
- begin
- inherited;
- WinVer.dwOSVersionInfoSize := SizeOf(WinVer);
- GetVersionEx(WinVer);
- FWatchForChanges := False;
- FNeverPainted := True;
- FFilesSize := 0;
- FFilesSelSize := 0;
- FDimmHiddenFiles := True;
- FShowHiddenFiles := True;
- FShowDirectories := True;
- FDirsOnTop := True;
- FShowSubDirSize := False;
- FWantUseDragImages := True;
- FCanUseDragImages := (Win32PlatForm = VER_PLATFORM_WIN32_NT) or (WinVer.dwMinorVersion > 0);
- FAddParentDir := False;
- FullDrag := True;
- FSingleClickToExec := False;
- FInvalidNameChars := '\/:*?"<>|';
- FHasParentDir := False;
- FDragOnDriveIsMove := False;
- FCaseSensitive := False;
- FLoadAnimation := True;
- FAnimation := nil;
- FIsRecycleBin := False;
- FLoading := False;
- FLoadEnabled := True;
- FAbortLoading := False;
- FDirty := False;
- FLastPath := '';
- FNotifyEnabled := True;
- FForceRename := False;
- FLastRenameName := '';
- FSavedSelection := False;
- FPendingFocusSomething := False;
- FContextMenu := False;
- FUseSystemContextMenu := True;
- FStartPos.X := -1;
- FStartPos.Y := -1;
- FDragPos := FStartPos;
- FDragEnabled := False;
- FDDOwnerIsSource := False;
- FDDLinkOnExeDrag := False;
- FDragDrive := #0;
- FExeDrag := False;
- FOnHistoryChange := nil;
- FHistoryPaths := TStringList.Create;
- FBackCount := 0;
- FDontRecordPath := False;
- FBackMenu := nil;
- FForwardMenu := nil;
- FMaxHistoryMenuLen := DefaultHistoryMenuLen;
- FMaxHistoryMenuWidth := DefaultHistoryMenuWidth;
- FMaxHistoryCount := DefaultHistoryCount;
- OnCustomDrawItem := DumbCustomDrawItem;
- OnCustomDrawSubItem := DumbCustomDrawSubItem;
- FDragDropFilesEx := TCustomizableDragDropFilesEx.Create(Self);
- with FDragDropFilesEx do
- begin
- {$IFDEF OLD_DND}
- AutoDetectDnD := False;
- DragDetectDelta := 4;
- {$ELSE}
- DragDetect.Automatic := False;
- DragDetect.DeltaX := 4;
- DragDetect.DeltaY := 4;
- {$ENDIF}
- AcceptOwnDnD := True;
- BringToFront := True;
- CompleteFileList := True;
- NeedValid := [nvFileName];
- RenderDataOn := rdoEnterAndDropSync;
- TargetPopUpMenu := True;
- SourceEffects := DragSourceEffects;
- TargetEffects := [deCopy, deMove];
- OnDragEnter := DDDragEnter;
- OnDragLeave := DDDragLeave;
- OnDragOver := DDDragOver;
- OnDrop := DDDrop;
- OnQueryContinueDrag := DDQueryContinueDrag;
- OnSpecifyDropTarget := DDSpecifyDropTarget;
- OnMenuDestroy := DDMenuDone;
- OnDropHandlerSucceeded := DDDropHandlerSucceeded;
- OnGiveFeedback := DDGiveFeedback;
- OnProcessDropped := DDProcessDropped;
- OnDragDetect := DDDragDetect;
- end;
- end;
- procedure TCustomDirView.ClearItems;
- begin
- if Assigned(DropTarget) then DropTarget := nil;
- try
- inherited;
- finally
- FFilesSelSize := 0;
- FFilesSize := 0;
- UpdateStatusBar;
- end;
- end;
- procedure TCustomDirView.CNNotify(var Message: TWMNotify);
- procedure DrawOverlayImage(Image: Integer);
- var
- ImageList: TCustomImageList;
- Point: TPoint;
- Index: Integer;
- begin
- Point := Items[PNMCustomDraw(Message.NMHdr)^.dwItemSpec].
- DisplayRect(drIcon).TopLeft;
- if ViewStyle = vsIcon then
- begin
- ImageList := ImageList32;
- Inc(Point.X, 8);
- Inc(Point.Y, 2);
- end
- else ImageList := ImageList16;
- Index := 0;
- while Image > 1 do
- begin
- Inc(Index);
- Image := Image shr 1;
- end;
- if 8 + ImageList.Width <= Columns[0].Width then
- ImageList_Draw(ImageList.Handle, Index, Self.Canvas.Handle,
- Point.X, Point.Y, ILD_TRANSPARENT);
- end;
- var
- FileSize: Int64;
- Item: TListItem;
- InfoMask: LongWord;
- OverlayIndex: Word;
- OverlayIndexes: Word;
- UpdateStatusBarPending: Boolean;
- begin
- UpdateStatusBarPending := False;
- case Message.NMHdr^.code of
- LVN_ITEMCHANGED:
- with PNMListView(Message.NMHdr)^ do
- if (uChanged = LVIF_STATE) and Valid and (not FClearingItems) then
- begin
- if ((uOldState and (LVIS_SELECTED or LVIS_FOCUSED)) <>
- (uNewState and (LVIS_SELECTED or LVIS_FOCUSED))) then
- UpdateStatusBarPending := True;
- if ((uOldState and LVIS_SELECTED) <> (uNewState and LVIS_SELECTED)) then
- begin
- FileSize := ItemFileSize(Items[iItem]);
- if (uOldState and LVIS_SELECTED) <> 0 then Dec(FFilesSelSize, FileSize)
- else Inc(FFilesSelSize, FileSize);
- end;
- end;
- LVN_ENDLABELEDIT:
- LoadEnabled := True;
- LVN_BEGINDRAG:
- if FDragEnabled and (not Loading) then
- DDDragDetect(MK_LBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
- LVN_BEGINRDRAG:
- if FDragEnabled and (not Loading) then
- DDDragDetect(MK_RBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
- end;
- inherited;
- if (Message.NMHdr.code = LVN_GETDISPINFO) and
- FNotifyEnabled and Valid and (not Loading) then
- with PLVDispInfo(Pointer(Message.NMHdr))^.Item do
- try
- InfoMask := PLVDispInfo(Pointer(Message.NMHdr))^.item.Mask;
- if (InfoMask and LVIF_PARAM) <> 0 then Item := TListItem(lParam)
- else
- if iItem < Items.Count then Item := Items[iItem]
- else Item := nil;
- if Assigned(Item) and Assigned(Item.Data) then
- GetDisplayInfo(Item, PLVDispInfo(Pointer(Message.NMHdr))^.item);
- except
- end;
- if (Message.NMHdr.code = NM_CUSTOMDRAW) and
- HasExtendedCOMCTL32 and Valid and (not Loading) then
- with PNMCustomDraw(Message.NMHdr)^ do
- try
- Message.Result := Message.Result or CDRF_NOTIFYPOSTPAINT;
- if (dwDrawStage = CDDS_ITEMPOSTPAINT) and
- ((dwDrawStage and CDDS_SUBITEM) = 0) and
- Assigned(Columns[0]) and (Columns[0].Width > 0) then
- begin
- Assert(Assigned(Items[dwItemSpec]));
- OverlayIndexes := ItemOverlayIndexes(Items[dwItemSpec]);
- OverlayIndex := 1;
- while OverlayIndexes > 0 do
- begin
- if (OverlayIndex and OverlayIndexes) <> 0 then
- begin
- DrawOverlayImage(OverlayIndex);
- Dec(OverlayIndexes, OverlayIndex);
- end;
- OverlayIndex := OverlayIndex shl 1;
- end;
- end;
- except
- end;
- if UpdateStatusBarPending then UpdateStatusBar;
- end;
- procedure TCustomDirView.SetAddParentDir(Value: Boolean);
- begin
- if FAddParentDir <> Value then
- begin
- FAddParentDir := Value;
- if DirOK then Reload(True);
- end;
- end;
- procedure TCustomDirView.SetDimmHiddenFiles(Value: Boolean);
- begin
- if Value <> FDimmHiddenFiles then
- begin
- FDimmHiddenFiles := Value;
- Self.Repaint;
- end;
- end; {SetDimmHiddenFiles}
- procedure TCustomDirView.SetPathComboBox(Value: TCustomPathComboBox);
- begin
- if FPathComboBox <> Value then
- begin
- if Assigned(FPathComboBox) and (FPathComboBox.DirView = Self) then
- FPathComboBox.DirView := nil;
- FPathComboBox := Value;
- if Assigned(Value) then
- begin
- Value.FreeNotification(Self);
- if not Assigned(Value.DirView) then
- Value.DirView := Self;
- UpdatePathComboBox;
- end;
- end;
- end; { SetPathComboBox }
- procedure TCustomDirView.SetPathLabel(Value: TCustomPathLabel);
- begin
- if FPathLabel <> Value then
- begin
- if Assigned(FPathLabel) and (FPathLabel.FocusControl = Self) then
- FPathLabel.FocusControl := nil;
- FPathLabel := Value;
- if Assigned(Value) then
- begin
- Value.FreeNotification(Self);
- if not Assigned(Value.FocusControl) then
- Value.FocusControl := Self;
- UpdatePathLabel;
- end;
- end;
- end; { SetPathLabel }
- procedure TCustomDirView.SetShowDirectories(Value: Boolean);
- begin
- if Value <> FShowDirectories then
- begin
- FShowDirectories := Value;
- if DirOK then Reload(True);
- Self.Repaint;
- end;
- end; {SetShowDirectories}
- procedure TCustomDirView.SetDirsOnTop(Value: Boolean);
- begin
- if Value <> FDirsOnTop then
- begin
- FDirsOnTop := Value;
- if ShowDirectories then
- SortItems;
- end;
- end; {SetDirsOnTop}
- procedure TCustomDirView.SetShowHiddenFiles(Value: Boolean);
- begin
- if ShowHiddenFiles <> Value then
- begin
- FShowHiddenFiles := Value;
- if DirOK then Reload(False);
- end;
- end;
- procedure TCustomDirView.SetShowSubDirSize(Value: Boolean);
- begin
- if Value <> FShowSubDirSize then
- FShowSubDirSize := Value;
- end; {SetShowSubDirSize}
- procedure TCustomDirView.SetSortByExtension(Value: Boolean);
- Begin
- if Value <> FSortByExtension then
- begin
- FSortByExtension := Value;
- SortItems;
- end;
- end; {SetSortByExtension}
- function TCustomDirView.GetDragSourceEffects: TDropEffectSet;
- begin
- Result := [deCopy, deMove, deLink];
- end;
- function TCustomDirView.GetUseDragImages: Boolean;
- begin
- Result := FWantUseDragImages and FCanUseDragImages;
- end;
- procedure TCustomDirView.SetStatusBar(Value: TAssociatedStatusBar);
- begin
- if FStatusBar <> Value then
- begin
- if Assigned(FStatusBar) and
- (FStatusBar.FocusControl = Self) then
- FStatusBar.FocusControl := nil;
- FStatusBar := Value;
- if Assigned(FStatusBar) and
- (FStatusBar.FocusControl = nil) then
- FStatusBar.FocusControl := Self;
- UpdateStatusBar;
- end;
- end; { SetStatusBar }
- procedure TCustomDirView.SetTargetPopupMenu(Value: Boolean);
- begin
- if Assigned(FDragDropFilesEx) then FDragDropFilesEx.TargetPopupMenu := Value;
- end;
- procedure TCustomDirView.CreateWnd;
- procedure GetOverlayBitmap(ImageList: TImageList; BitmapName: string);
- var
- Bitmap: TBitmap;
- begin
- Bitmap := TBitmap.Create;
- try
- Bitmap.LoadFromResourceName(hInstance, BitmapName);
- ImageList.AddMasked(Bitmap, Bitmap.Canvas.Pixels[0, 0]);
- finally
- Bitmap.Free;
- end;
- end; {GetOverlayBitmap}
- function OverlayImageList(Size: Integer): TImageList;
- begin
- Result := TImageList.CreateSize(Size, Size);
- Result.DrawingStyle := dsTransparent;
- Result.BkColor := clNone;
- GetOverlayBitmap(Result, Format(ResDirUp, [Size]));
- GetOverlayBitmap(Result, Format(ResLink, [Size]));
- GetOverlayBitmap(Result, Format(ResBrokenLink, [Size]));
- end;
- begin
- inherited;
- if Assigned(PopupMenu) then
- PopupMenu.Autopopup := False;
- FDragDropFilesEx.DragDropControl := Self;
- FImageList16 := OverlayImageList(16);
- FImageList32 := OverlayImageList(32);
- IconsSetImageList;
- end;
- function TCustomDirView.CustomDrawItem(Item: TListItem; State: TCustomDrawState;
- Stage: TCustomDrawStage): Boolean;
- var
- FItemColor: TColor;
- begin
- if (Item <> nil) and (Stage = cdPrePaint) then
- begin
- FItemColor := ItemColor(Item);
- if (FItemColor <> clDefaultItemColor) and
- (Canvas.Font.Color <> FItemColor) then
- Canvas.Font.Color := FItemColor;
- end;
- Result := inherited CustomDrawItem(Item, State, Stage);
- end;
- function TCustomDirView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
- State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
- var
- FColor: TColor;
- begin
- if (Stage = cdPrePaint) and (SubItem > 0) and
- (ItemColor(Item) <> clDefaultItemColor) then
- begin
- FColor := GetSysColor(COLOR_WINDOWTEXT);
- if Canvas.Font.Color <> FColor then
- Canvas.Font.Color := FColor;
- end;
- Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
- end;
- procedure TCustomDirView.Delete(Item: TListItem);
- begin
- Assert(Assigned(Item));
- // This causes access violation when size is stored in structure
- // pointed by TListItem->Data and this structure is not valid any more
- if Valid then Dec(FFilesSize, ItemFileSize(Item));
- inherited Delete(Item);
- end;
- destructor TCustomDirView.Destroy;
- begin
- Assert(not FSavedSelection);
- FreeAndNil(FHistoryPaths);
- FreeAndNil(FBackMenu);
- FreeAndNil(FForwardMenu);
- FreeAndNil(FDragDropFilesEx);
- FreeAndNil(FImageList16);
- FreeAndNil(FImageList32);
- if Assigned(SmallImages) then
- begin
- SmallImages.Free;
- SmallImages := nil;
- end;
- if Assigned(LargeImages) then
- begin
- LargeImages.Free;
- LargeImages := nil;
- end;
- FreeAndNil(FAnimation);
- inherited;
- end;
- procedure TCustomDirView.SelectFiles(Filter: TFileFilter; Select: Boolean);
- var
- Item: TListItem;
- Index: Integer;
- OldCursor: TCursor;
- begin
- Assert(Valid);
- OldCursor := Screen.Cursor;
- Items.BeginUpdate;
- BeginSelectionUpdate;
- try
- Screen.Cursor := crHourGlass;
- for Index := 0 to Items.Count-1 do
- begin
- Item := Items[Index];
- Assert(Assigned(Item));
- if (Item.Selected <> Select) and
- ItemMatchesFilter(Item, Filter) then
- Item.Selected := Select;
- end;
- finally
- Screen.Cursor := OldCursor;
- Items.EndUpdate;
- EndSelectionUpdate;
- end;
- end;
- function TCustomDirView.DoSelectByMask(Select: Boolean): Boolean;
- var
- Filter: TFileFilter;
- begin
- Result := inherited DoSelectByMask(Select);
- if Assigned(FOnGetSelectFilter) then
- begin
- DefaultFileFilter(Filter);
- FOnGetSelectFilter(Self, Select, Filter);
- SelectFiles(Filter, Select);
- Result := True;
- end;
- end;
- function TCustomDirView.DragCompleteFileList: Boolean;
- begin
- Result := (MarkedCount <= 100) and (not IsRecycleBin);
- end;
- procedure TCustomDirView.DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
- begin
- end;
- procedure TCustomDirView.DumbCustomDrawSubItem(Sender: TCustomListView;
- Item: TListItem; SubItem: Integer; State: TCustomDrawState;
- var DefaultDraw: Boolean);
- begin
- end;
- function TCustomDirView.GetTargetPopupMenu: Boolean;
- begin
- if Assigned(FDragDropFilesEx) then Result := FDragDropFilesEx.TargetPopupMenu
- else Result := True;
- end;
- procedure TCustomDirView.SetMultiSelect(Value: Boolean);
- begin
- if Value <> MultiSelect then
- begin
- inherited SetMultiSelect(Value);
- if not (csLoading in ComponentState) and Assigned(ColProperties) then
- begin
- ColProperties.RecreateColumns;
- SetColumnImages;
- if DirOK then Reload(True);
- end;
- end;
- end;
- function TCustomDirView.GetValid: Boolean;
- begin
- Result := (not (csDestroying in ComponentState)) and
- (not Loading) and (not FClearingItems);
- end;
- function TCustomDirView.ItemCanDrag(Item: TListItem): Boolean;
- begin
- Result := (not ItemIsParentDirectory(Item));
- end;
- function TCustomDirView.ItemColor(Item: TListItem): TColor;
- begin
- Result := clDefaultItemColor;
- end;
- function TCustomDirView.GetFilesMarkedSize: Int64;
- begin
- if SelCount > 0 then Result := FilesSelSize
- else
- if Assigned(ItemFocused) then Result := ItemFileSize(ItemFocused)
- else Result := 0;
- end;
- procedure TCustomDirView.IconsSetImageList;
- function ShellImageList(Flags: UINT): TImageList;
- var
- FileInfo: TShFileInfo;
- begin
- Result := TImageList.Create(Self);
- Result.Handle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo),
- SHGFI_SYSICONINDEX or Flags);
- Result.ShareImages := True;
- end;
- begin
- if not Assigned(SmallImages) then
- SmallImages := ShellImageList(SHGFI_SMALLICON);
- if not Assigned(LargeImages) then
- LargeImages := ShellImageList(SHGFI_LARGEICON);
- end; {IconsSetImageList}
- function TCustomDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
- begin
- Result := False;
- end;
- function TCustomDirView.ItemOverlayIndexes(Item: TListItem): Word;
- begin
- Result := oiNoOverlay;
- end;
- procedure TCustomDirView.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Valid and (not IsEditing) then
- begin
- if (Key = VK_RETURN) or
- ((Key = VK_NEXT) and (ssCtrl in Shift)) then
- begin
- if Assigned(ItemFocused) and (not Loading) then
- begin
- Key := 0;
- if (Key = VK_RETURN) and (Shift = [ssAlt]) then DisplayPropertiesMenu
- else
- if (Key <> VK_RETURN) or (Shift = []) then Execute(ItemFocused);
- end;
- end
- else
- if ((Key = VK_BACK) or ((Key = VK_PRIOR) and (ssCtrl in Shift))) and
- (not Loading) and (not IsRoot) then
- begin
- Key := 0;
- ExecuteParentDirectory;
- end
- else
- if (Key = 220 { backslash }) and (ssCtrl in Shift) and (not Loading) and
- (not IsRoot) then
- begin
- Key := 0;
- ExecuteRootDirectory;
- end
- else
- begin
- inherited;
- end;
- end
- else
- begin
- inherited;
- end;
- end;
- procedure TCustomDirView.KeyPress(var Key: Char);
- begin
- if IsEditing and (Pos(Key, FInvalidNameChars) <> 0) Then
- Begin
- Beep;
- Key := #0;
- End;
- inherited;
- end;
- procedure TCustomDirView.KeyUp(var Key: Word; Shift: TShiftState);
- var
- P: TPoint;
- R: TRect;
- begin
- if Key = VK_APPS then
- begin
- if not Loading then
- begin
- if MarkedCount > 0 then
- begin
- if Assigned(ItemFocused) then
- Begin
- R := ItemFocused.DisplayRect(drIcon);
- P.X := (R.Left + R.Right) div 2;
- P.Y := (R.Top + R.Bottom) div 2;
- end
- else
- begin
- P.X := 0;
- P.Y := 0;
- end;
- P := ClientToScreen(P);
- DisplayContextMenu(P);
- end
- else
- if Assigned(PopupMenu) then
- begin
- P.X := 0;
- P.Y := 0;
- P := ClientToScreen(P);
- PopupMenu.Popup(P.X, P.Y);
- end;
- end;
- end
- else
- inherited KeyUp(Key, Shift);
- end;
- procedure TCustomDirView.SetWatchForChanges(Value: Boolean);
- begin
- if FWatchForChanges <> Value then
- FWatchForChanges := Value;
- end;
- function TCustomDirView.TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean;
- begin
- Assert(Assigned(DragDropFilesEx) and Assigned(Item));
- Result :=
- DragDropFilesEx.TargetHasDropHandler(nil, ItemFullFileName(Item), Effect);
- if Assigned(OnDDTargetHasDropHandler) then
- begin
- OnDDTargetHasDropHandler(Self, Item, Effect, Result);
- end;
- end;
- procedure TCustomDirView.UpdatePathComboBox;
- begin
- if Assigned(PathComboBox) then
- PathComboBox.Path := Path;
- end; { UpdatePathComboBox }
- procedure TCustomDirView.UpdatePathLabel;
- begin
- if Assigned(PathLabel) then
- begin
- if csDesigning in ComponentState then
- PathLabel.Caption := PathLabel.Name
- else
- PathLabel.Caption := PathName;
- PathLabel.UpdateStatus;
- end;
- end; { UpdatePathLabel }
- procedure TCustomDirView.UpdateStatusBar;
- var
- StatusFileInfo: TStatusFileInfo;
- begin
- if (FUpdatingSelection = 0) and Assigned(StatusBar) then
- begin
- with StatusFileInfo do
- begin
- SelectedSize := FilesSelSize;
- FilesSize := Self.FilesSize;
- SelectedCount := SelCount;
- FilesCount := Self.FilesCount;
- end;
- StatusBar.FileInfo := StatusFileInfo;
- end;
- end; { UpdateStatusBar }
- procedure TCustomDirView.WMContextMenu(var Message: TWMContextMenu);
- var
- Point: TPoint;
- begin
- FDragEnabled := False;
- if Assigned(PopupMenu) then
- PopupMenu.AutoPopup := False;
- //inherited;
- if FContextMenu and (not Loading) then
- begin
- Point.X := Message.XPos;
- Point.Y := Message.YPos;
- Point := ScreenToClient(Point);
- if Assigned(OnMouseDown) then
- OnMouseDown(Self, mbRight, [], Point.X, Point.Y);
- if FUseSystemContextMenu and Assigned(ItemFocused) and
- (GetItemAt(Point.X, Point.Y) = ItemFocused) then
- begin
- Point.X := Message.XPos;
- Point.Y := Message.YPos;
- DisplayContextMenu(Point);
- end
- else
- if Assigned(PopupMenu) and (not PopupMenu.AutoPopup) then
- PopupMenu.Popup(Message.XPos, Message.YPos);
- end;
- FContextMenu := False;
- //inherited;
- end;
- procedure TCustomDirView.WMLButtonDown(var Message: TWMLButtonDown);
- Begin
- GetCursorPos(FStartPos);
- FDragEnabled := (not Loading);
- inherited;
- end;
- procedure TCustomDirView.WMPaint(var Message: TWMPaint);
- begin
- inherited;
- if FNeverPainted then
- begin
- FNeverPainted := False;
- Invalidate;
- end;
- end;
- procedure TCustomDirView.WMRButtonDown(var Message: TWMRButtonDown);
- begin
- GetCursorPos(FStartPos);
- if FDragDropFilesEx.DragDetectStatus <> ddsDrag then
- FDragEnabled := (not Loading);
- FContextMenu := True;
- inherited;
- end;
- procedure TCustomDirView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
- begin
- inherited;
- if (not SingleClickToExec) and Assigned(ItemFocused) and (not Loading) and
- (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) then
- begin
- if GetKeyState(VK_MENU) < 0 then DisplayPropertiesMenu
- else Execute(ItemFocused);
- end;
- end;
- procedure TCustomDirView.WMLButtonUp(var Message: TWMLButtonUp);
- begin
- if SingleClickToExec and FDragEnabled and Assigned(ItemFocused) and (not Loading) and
- (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) and
- (GetKeyState(VK_SHIFT) >= 0) and (GetKeyState(VK_CONTROL) >= 0) then
- begin
- if GetKeyState(VK_MENU) < 0 then DisplayPropertiesMenu
- else Execute(ItemFocused);
- end;
- FDragEnabled := False;
- inherited;
- end;
- procedure TCustomDirView.Reload(CacheIcons: Boolean);
- var
- OldSelection: TStrings;
- OldItemFocused: string;
- Index: Integer;
- FoundIndex: Integer;
- IconCache: TStringList;
- Item: TListItem;
- FileName: string;
- function FindInOldSelection(FileName: string): Boolean;
- var
- Index: Integer;
- begin
- Result := True;
- for Index := 0 to OldSelection.Count - 1 do
- if AnsiCompareStr(OldSelection[Index], FileName) = 0 then Exit;
- Result := False;
- end;
- begin
- if Path <> '' then
- begin
- OldSelection := nil;
- IconCache := nil;
- Items.BeginUpdate;
- try
- OldSelection := TStringList.Create;
- if CacheIcons then
- IconCache := TStringList.Create;
- for Index := 0 to Items.Count-1 do
- begin
- Item := Items[Index];
- FileName := Item.Caption;
- if Item.Selected then
- OldSelection.Add(FileName);
- if CacheIcons and (ItemImageIndex(Item, True) >= 0) then
- IconCache.AddObject(FileName, TObject(ItemImageIndex(Item, True)));
- end;
- if FSelectFile <> '' then
- begin
- OldItemFocused := FSelectFile;
- FSelectFile := '';
- end
- else
- if Assigned(ItemFocused) then OldItemFocused := ItemFocused.Caption
- else OldItemFocused := '';
- Load;
- TStringList(OldSelection).Sort;
- if CacheIcons then IconCache.Sort;
- for Index := 0 to Items.Count - 1 do
- begin
- Item := Items[Index];
- FileName := ItemFileName(Item);
- if FileName = OldItemFocused then
- ItemFocused := Item;
- if ((not FCaseSensitive) and TStringList(OldSelection).Find(FileName, FoundIndex)) or
- (FCaseSensitive and FindInOldSelection(FileName)) then
- Item.Selected := True;
- if CacheIcons and (ItemImageIndex(Item, True) < 0) then
- begin
- FoundIndex := IconCache.IndexOf(FileName);
- if FoundIndex >= 0 then
- SetItemImageIndex(Item, Integer(IconCache.Objects[FoundIndex]));
- end;
- end;
- FocusSomething;
- finally
- Items.EndUpdate;
- OldSelection.Free;
- if CacheIcons then IconCache.Free;
- end;
- end;
- end;
- procedure TCustomDirView.Load;
- var
- SaveCursor: TCursor;
- LastDirName: string;
- begin
- if not FLoadEnabled or Loading then
- begin
- FDirty := True;
- FAbortLoading := True;
- end
- else
- begin
- FLoading := True;
- try
- FHasParentDir := False;
- if Assigned(FOnStartLoading) then FOnStartLoading(Self);
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- try
- FNotifyEnabled := False;
- ClearItems;
- GetSystemTime(FReloadTime);
- FFilesSize := 0;
- FFilesSelSize := 0;
- SortType := stNone;
- Items.BeginUpdate;
- try
- try
- DoAnimation(True);
- LoadFiles;
- finally
- DoAnimation(False);
- end;
- finally
- Items.EndUpdate;
- end;
- finally
- Screen.Cursor := SaveCursor;
- end;
- finally
- FLoading := False;
- try
- if FAbortLoading then
- begin
- FAbortLoading := False;
- Reload(False);
- end
- else
- begin
- if DirOK then SortItems;
- FAbortLoading := False;
- FDirty := False;
- if (Length(LastPath) > Length(PathName)) and
- (Copy(LastPath, 1, Length(PathName)) = PathName) and
- (Items.Count > 0) then
- begin
- LastDirName := Copy(LastPath, LastDelimiter('\:/', LastPath) + 1, MaxInt);
- ItemFocused := FindFileItem(LastDirName);
- end;
- end;
- finally
- // nested try .. finally block is included
- // because we really want these to be executed
- FNotifyEnabled := True;
- if DirOK and not FAbortLoading and Assigned(FOnDirUpdated) then
- FOnDirUpdated(Self);
- FocusSomething;
- if Assigned(FOnLoaded) then FOnLoaded(Self);
- UpdatePathLabel;
- UpdateStatusBar;
- end;
- end;
- end;
- end;
- procedure TCustomDirView.SetLoadEnabled(Enabled: Boolean);
- begin
- if Enabled <> LoadEnabled then
- begin
- FLoadEnabled := Enabled;
- if Enabled and Dirty then Reload(True);
- end;
- end;
- function TCustomDirView.ItemDragFileName(Item: TListItem): string;
- begin
- Result := ItemFullFileName(Item);
- end;
- function TCustomDirView.GetFilesCount: Integer;
- begin
- Result := Items.Count;
- if (Result > 0) and HasParentDir then Dec(Result);
- end;
- procedure TCustomDirView.SetViewStyle(Value: TViewStyle);
- begin
- if (Value <> ViewStyle) and (not FLoading) then
- begin
- FNotifyEnabled := False;
- inherited;
- FNotifyEnabled := True;
- end;
- end;
- procedure TCustomDirView.ColClick(Column: TListColumn);
- var
- ScrollToFocused: Boolean;
- begin
- ScrollToFocused := Assigned(ItemFocused);
- inherited;
- if ScrollToFocused and Assigned(ItemFocused) then
- ItemFocused.MakeVisible(False);
- end;
- procedure TCustomDirView.CustomSortItems(SortProc: Pointer);
- var
- SavedCursor: TCursor;
- SavedNotifyEnabled: Boolean;
- begin
- if HandleAllocated then
- begin
- SavedNotifyEnabled := FNotifyEnabled;
- SavedCursor := Screen.Cursor;
- Items.BeginUpdate;
- try
- Screen.Cursor := crHourglass;
- FNotifyEnabled := False;
- CustomSort(TLVCompare(SortProc), Integer(Pointer(Self)));
- finally
- Screen.Cursor := SavedCursor;
- FNotifyEnabled := SavedNotifyEnabled;
- Items.EndUpdate;
- end;
- end;
- end;
- procedure TCustomDirView.ReloadForce(CacheIcons: Boolean);
- begin
- FLoadEnabled := True;
- FDirty := False;
- Reload(CacheIcons);
- end;
- procedure TCustomDirView.DDDragEnter(DataObj: IDataObject; grfKeyState: Longint;
- Point: TPoint; var dwEffect: longint; var Accept: Boolean);
- var
- Index: Integer;
- begin
- Accept := Accept and DirOK and (not Loading);
- if Accept and (DragDropFilesEx.FileList.Count > 0) and
- (Length(TFDDListItem(DragDropFilesEx.FileList[0]^).Name) > 2) and
- ((TFDDListItem(DragDropFilesEx.FileList[0]^).Name[2] = ':') or
- (TFDDListItem(DragDropFilesEx.FileList[0]^).Name[2] = '\')) and
- (not IsRecycleBin or not DragDropFilesEx.FileNamesAreMapped) then
- begin
- FDragDrive := Upcase(TFDDListItem(DragDropFilesEx.FileList[0]^).Name[1]);
- FExeDrag := FDDLinkOnExeDrag and
- (deLink in DragDropFilesEx.TargetEffects) and
- ((DragDropFilesEx.AvailableDropEffects and DropEffect_Link) <> 0);
- if FExeDrag then
- for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
- if not IsExecutable(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
- begin
- FExeDrag := False;
- Break;
- end;
- end
- else
- begin
- FDragDrive := #0;
- Accept := False;
- end;
- GetSystemTimeAsFileTime(FLastVScrollTime);
- FVScrollCount := 0;
- if Assigned(FOnDDDragEnter) then
- FOnDDDragEnter(Self, DataObj, grfKeyState, Point, dwEffect, Accept);
- end;
- procedure TCustomDirView.DDDragLeave;
- begin
- if Assigned(DropTarget) and GlobalDragImageList.Dragging then
- begin
- GlobalDragImageList.HideDragImage;
- DropTarget := nil;
- Update; {ie30}
- end
- else DropTarget := nil;
- if Assigned(FOnDDDragLeave) then
- FOnDDDragLeave(Self);
- end;
- procedure TCustomDirView.DDDragOver(grfKeyState: Integer; Point: TPoint;
- var dwEffect: Integer);
- var
- DropItem: TListItem;
- KnowTime: TFileTime;
- NbPixels: Integer;
- CanDrop: Boolean;
- HasDropHandler: Boolean;
- WParam: LongInt;
- begin
- FDDOwnerIsSource := DragDropFilesEx.OwnerIsSource;
- {Set droptarget if target is directory:}
- if not Loading then DropItem := GetItemAt(Point.X, Point.Y)
- else DropItem := nil;
- HasDropHandler := (Assigned(DropItem) and (not IsRecycleBin) and
- TargetHasDropHandler(DropItem, dwEffect));
- CanDrop := Assigned(DropItem) and (not IsRecycleBin) and
- (ItemIsDirectory(DropItem) or HasDropHandler);
- if (CanDrop and (DropTarget <> DropItem)) or
- (not CanDrop and Assigned(DropTarget)) then
- begin
- if GlobalDragImageList.Dragging then
- begin
- GlobalDragImageList.HideDragImage;
- DropTarget := nil;
- Update;
- if CanDrop then
- begin
- DropTarget := DropItem;
- Update;
- end;
- GlobalDragImageList.ShowDragImage;
- end
- else
- begin
- DropTarget := nil;
- if CanDrop then DropTarget := DropItem;
- end;
- end;
- GetSystemTimeAsFileTime(KnowTime);
- NbPixels := Abs((Font.Height));
- {Vertical scrolling, if viewstyle = vsReport:}
- if (ViewStyle = vsReport) and (not Loading) and Assigned(TopItem) and
- (((Int64(KnowTime) - Int64(FLastVScrollTime)) > DDVScrollDelay) or
- ((FVScrollCount > DDMaxSlowCount) and
- ((Int64(KnowTime) - Int64(FLastVScrollTime)) > (DDVScrollDelay div 4)))) then
- begin
- if ((DropItem = TopItem) or (Point.Y - 3 * nbPixels <= 0)) and
- (TopItem.Index > 0) then WParam := SB_LINEUP
- else
- if (Point.Y + 3 * nbPixels > Height) then WParam := SB_LINEDOWN
- else WParam := -1;
- if WParam >= 0 then
- begin
- if GlobalDragImageList.Dragging then
- GlobalDragImageList.HideDragImage;
- Perform(WM_VSCROLL, WParam, 0);
- if FVScrollCount > DDMaxSlowCount then
- Perform(WM_VSCROLL, WParam, 0);
- if FVScrollCount > DDMaxSlowCount * 3 then
- Perform(WM_VSCROLL, WParam, 0);
- Update;
- if GlobalDragImageList.Dragging then
- GlobalDragImageList.ShowDragImage;
- GetSystemTimeAsFileTime(FLastVScrollTime);
- Inc(FVScrollCount);
- end
- else FVScrollCount := 0;
- end; {VScrollDelay}
- {Set dropeffect:}
- if (not HasDropHandler) and (not Loading) then
- begin
- DDChooseEffect(grfKeyState, dwEffect);
- if Assigned(FOnDDDragOver) then
- FOnDDDragOver(Self, grfKeyState, Point, dwEffect);
- if DragDropFilesEx.OwnerIsSource and (dwEffect = DropEffect_Move) and
- (not Assigned(DropTarget)) then dwEffect := DropEffect_None
- else
- if Assigned(DropTarget) and ItemIsRecycleBin(DropTarget) Then
- dwEffect := DropEffect_Move;
- end;
- end;
- function TCustomDirView.CustomCreateFileList(Focused, OnlyFocused: Boolean;
- FullPath: Boolean; FileList: TStrings): TStrings;
- procedure AddItem(Item: TListItem);
- begin
- Assert(Assigned(Item));
- if FullPath then Result.AddObject(ItemFullFileName(Item), Item.Data)
- else Result.AddObject(ItemFileName(Item), Item.Data);
- end;
- var
- Item: TListItem;
- begin
- if Assigned(FileList) then Result := FileList
- else Result := TStringList.Create;
- try
- if Assigned(ItemFocused) and
- ((Focused and (not ItemFocused.Selected)) or (SelCount = 0) or OnlyFocused) then
- begin
- AddItem(ItemFocused)
- end
- else
- begin
- Item := GetNextItem(nil, sdAll, [isSelected]);
- while Assigned(Item) do
- begin
- AddItem(Item);
- Item := GetNextItem(Item, sdAll, [isSelected]);
- end;
- end;
- except
- if not Assigned(FileList) then FreeAndNil(Result);
- raise;
- end;
- end;
- function TCustomDirView.CreateFocusedFileList(FullPath: Boolean; FileList: TStrings): TStrings;
- begin
- Result := CustomCreateFileList(False, True, FullPath, FileList);
- end;
- function TCustomDirView.CreateFileList(Focused: Boolean; FullPath: Boolean;
- FileList: TStrings): TStrings;
- begin
- Result := CustomCreateFileList(Focused, False, FullPath, FileList);
- end;
- procedure TCustomDirView.DDDrop(DataObj: IDataObject; grfKeyState: Integer;
- Point: TPoint; var dwEffect: Integer);
- begin
- if GlobalDragImageList.Dragging then
- GlobalDragImageList.HideDragImage;
- if dwEffect = DropEffect_None then
- DropTarget := nil;
- if Assigned(OnDDDrop) then
- OnDDDrop(Self, DataObj, grfKeyState, Point, dwEffect);
- end;
- procedure TCustomDirView.DDQueryContinueDrag(FEscapePressed: LongBool;
- grfKeyState: Integer; var Result: HResult);
- var
- MousePos: TPoint;
- KnowTime: TFileTime;
- begin
- if Result = DRAGDROP_S_DROP then
- begin
- GetSystemTimeAsFileTime(KnowTime);
- if ((Int64(KnowTime) - INT64(FDragStartTime)) <= DDDragStartDelay) then
- Result := DRAGDROP_S_CANCEL;
- end;
- if Assigned(OnDDQueryContinueDrag) then
- OnDDQueryContinueDrag(Self, FEscapePressed, grfKeyState, Result);
- if FEscapePressed then
- begin
- if GlobalDragImageList.Dragging then
- GlobalDragImageList.HideDragImage;
- end
- else
- begin
- if GlobalDragImageList.Dragging Then
- begin
- MousePos := ParentForm.ScreenToClient(Mouse.CursorPos);
- {Move the drag image to the new position and show it:}
- if (MousePos.X <> FDragPos.X) or (MousePos.Y <> FDragPos.Y) then
- begin
- FDragPos := MousePos;
- if PtInRect(ParentForm.BoundsRect, Mouse.CursorPos) then
- begin
- GlobalDragImageList.DragMove(MousePos.X, MousePos.Y);
- GlobalDragImageList.ShowDragImage;
- end
- else GlobalDragImageList.HideDragImage;
- end;
- end;
- end;
- end;
- procedure TCustomDirView.DDSpecifyDropTarget(Sender: TObject;
- DragDropHandler: Boolean; Point: TPoint; var pidlFQ: PItemIDList;
- var Filename: string);
- var
- Item: TListItem;
- begin
- pidlFQ := nil;
- if DirOK and (not Loading) then
- begin
- if DragDropHandler then
- begin
- if Assigned(DropTarget) and ItemIsDirectory(DropTarget) then
- FileName := ItemFullFileName(DropTarget)
- else
- FileName := PathName;
- end
- else
- begin
- Item := GetItemAt(Point.X, Point.Y);
- if Assigned(Item) and (not ItemIsDirectory(Item)) and
- (not IsRecycleBin) then
- FileName := ItemFullFileName(Item)
- else
- FileName := '';
- end;
- end
- else FileName := '';
- end;
- procedure TCustomDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
- begin
- end;
- procedure TCustomDirView.DDDropHandlerSucceeded(Sender: TObject;
- grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
- begin
- DropTarget := nil;
- end;
- procedure TCustomDirView.DDGiveFeedback(dwEffect: Integer;
- var Result: HResult);
- begin
- if Assigned(FOnDDGiveFeedback) then
- FOnDDGiveFeedback(Self, dwEffect, Result);
- end;
- procedure TCustomDirView.DDProcessDropped(Sender: TObject;
- grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
- begin
- if DirOK and (not Loading) then
- try
- try
- if Assigned(FOnDDProcessDropped) then
- FOnDDProcessDropped(Self, grfKeyState, Point, dwEffect);
- if dwEffect <> DropEffect_None then
- begin
- PerformItemDragDropOperation(DropTarget, dwEffect);
- if Assigned(FOnDDExecuted) then
- FOnDDExecuted(Self, dwEffect);
- end;
- finally
- DragDropFilesEx.FileList.Clear;
- DropTarget := nil;
- end;
- except
- Application.HandleException(Self);
- end;
- end;
- function TCustomDirView.AnyFileSelected(OnlyFocused: Boolean): Boolean;
- var
- Item: TListItem;
- begin
- if OnlyFocused or (SelCount = 0) then
- Result := Assigned(ItemFocused) and ItemIsFile(ItemFocused)
- else
- begin
- Result := True;
- Item := GetNextItem(nil, sdAll, [isSelected]);
- while Assigned(Item) do
- begin
- if ItemIsFile(Item) then Exit;
- Item := GetNextItem(Item, sdAll, [isSelected]);
- end;
- Result := False;
- end;
- end;
- function TCustomDirView.CanEdit(Item: TListItem): Boolean;
- begin
- Result :=
- (inherited CanEdit(Item) or FForceRename) and (not Loading) and
- Assigned(Item) and (not ReadOnly) and (not IsRecycleBin) and
- (not ItemIsParentDirectory(Item));
- if Result then FLoadEnabled := False;
- FForceRename := False;
- end;
- function TCustomDirView.CanChangeSelection(Item: TListItem;
- Select: Boolean): Boolean;
- begin
- Result :=
- (not Loading) and
- not (Assigned(Item) and Assigned(Item.Data) and
- ItemIsParentDirectory(Item));
- end;
- procedure TCustomDirView.Edit(const HItem: TLVItem);
- var
- Item: TListItem;
- Info: string;
- Index: Integer;
- begin
- if Length(HItem.pszText) = 0 then LoadEnabled := True
- else
- begin
- Item := GetItemFromHItem(HItem);
- {Does the changed filename contains invalid characters?}
- if StrContains(FInvalidNameChars, HItem.pszText) then
- begin
- Info := FInvalidNameChars;
- for Index := Length(Info) downto 1 do
- System.Insert(Space, Info, Index);
- MessageBeep(MB_ICONHAND);
- if MessageDlg(SErrorInvalidName + Space + Info, mtError,
- [mbOK, mbAbort], 0) = mrOK then RetryRename(HItem.pszText);
- LoadEnabled := True;
- end
- else
- begin
- if Assigned(FOnBeginRename) then
- FOnBeginRename(Self, Item, string(HItem.pszText));
- InternalEdit(HItem);
- if Assigned(FOnEndRename) then
- FOnEndRename(Self, Item, string(HItem.pszText));
- end;
- end;
- end; {Edit}
- procedure TCustomDirView.EndSelectionUpdate;
- begin
- inherited;
- if FUpdatingSelection = 0 then
- UpdateStatusBar;
- end; { EndUpdatingSelection }
- procedure TCustomDirView.ExecuteCurrentFile();
- begin
- Assert(Assigned(ItemFocused));
- Execute(ItemFocused);
- end;
- procedure TCustomDirView.Execute(Item: TListItem);
- var
- AllowExec: Boolean;
- begin
- Assert(Assigned(Item));
- if Assigned(Item) and Assigned(Item.Data) and (not Loading) then
- begin
- if IsRecycleBin then DisplayPropertiesMenu
- else
- begin
- AllowExec := True;
- if Assigned(FOnExecFile) then FOnExecFile(Self, Item, AllowExec);
- if AllowExec then
- begin
- if ItemIsParentDirectory(Item) then ExecuteParentDirectory
- else ExecuteFile(Item);
- end;
- end;
- end;
- end;
- procedure TCustomDirView.GetDisplayInfo(ListItem: TListItem;
- var DispInfo: TLVItemA);
- begin
- // Nothing
- end;
- procedure TCustomDirView.WMUserRename(var Message: TMessage);
- begin
- if Assigned(ItemFocused) then
- begin
- FForceRename := True;
- ListView_EditLabel(Handle, ItemFocused.Index);
- SetWindowText(ListView_GetEditControl(Self.Handle),
- PChar(FLastRenameName));
- end;
- end;
- procedure TCustomDirView.RetryRename(NewName: string);
- begin
- FLastRenameName := NewName;
- PostMessage(Self.Handle, WM_USER_RENAME, Longint(PChar(NewName)), 0);
- end;
- procedure TCustomDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
- begin
- FileList.AddItem(nil, ItemDragFileName(Item));
- end;
- procedure TCustomDirView.DDDragDetect(grfKeyState: Integer; DetectStart,
- Point: TPoint; DragStatus: TDragDetectStatus);
- var
- FilesCount: Integer;
- DirsCount: Integer;
- Item: TListItem;
- FirstItem : TListItem;
- Bitmap: TBitmap;
- ImageListHandle: HImageList;
- Spot: TPoint;
- ItemPos: TPoint;
- DragText: string;
- ClientPoint: TPoint;
- OldCursor: TCursor;
- FileListCreated: Boolean;
- AvoidDragImage: Boolean;
- DataObject: TDataObject;
- begin
- if Assigned(FOnDDDragDetect) then
- FOnDDDragDetect(Self, grfKeyState, DetectStart, Point, DragStatus);
- if (DragStatus = ddsDrag) and (not Loading) and (MarkedCount > 0) then
- begin
- DragDropFilesEx.CompleteFileList := DragCompleteFileList;
- DragDropFilesEx.FileList.Clear;
- FirstItem := nil;
- FilesCount := 0;
- DirsCount := 0;
- FileListCreated := False;
- if Assigned(OnDDCreateDragFileList) then
- begin
- OnDDCreateDragFileList(Self, DragDropFilesEx.FileList, FileListCreated);
- if FileListCreated then
- begin
- AvoidDragImage := True;
- end;
- end;
- if not FileListCreated then
- begin
- if Assigned(ItemFocused) and (not ItemFocused.Selected) and
- ItemCanDrag(ItemFocused) then
- begin
- FirstItem := ItemFocused;
- AddToDragFileList(DragDropFilesEx.FileList, ItemFocused);
- if ItemIsDirectory(ItemFocused) then Inc(DirsCount)
- else Inc(FilesCount);
- end
- else
- if SelCount > 0 then
- begin
- Item := GetNextItem(nil, sdAll, [isSelected]);
- while Assigned(Item) do
- begin
- if ItemCanDrag(Item) then
- begin
- if not Assigned(FirstItem) then FirstItem := Item;
- AddToDragFileList(DragDropFilesEx.FileList, Item);
- if ItemIsDirectory(Item) then Inc(DirsCount)
- else Inc(FilesCount);
- end;
- Item := GetNextItem(Item, sdAll, [isSelected]);
- end;
- end;
- end;
- if DragDropFilesEx.FileList.Count > 0 then
- begin
- OldCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- try
- FDragEnabled := False;
- {Create the dragimage:}
- GlobalDragImageList := DragImageList;
- if UseDragImages and (not AvoidDragImage) then
- begin
- ImageListHandle := ListView_CreateDragImage(Handle, FirstItem.Index, Spot);
- ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
- if ImageListHandle <> Invalid_Handle_Value then
- begin
- GlobalDragImageList.Handle := ImageListHandle;
- if FilesCount + DirsCount = 1 then
- begin
- ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
- GlobalDragImageList.SetDragImage(0,
- DetectStart.X - ItemPos.X, DetectStart.Y - ItemPos.Y);
- end
- else
- begin
- GlobalDragImageList.Clear;
- GlobalDragImageList.Width := 32;
- GlobalDragImageList.Height := 32;
- if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES', 0,
- [lrTransparent], $FFFFFF) Then
- begin
- Bitmap := TBitmap.Create;
- try
- try
- GlobalDragImageList.GetBitmap(0, Bitmap);
- Bitmap.Canvas.Font.Assign(Self.Font);
- DragText := '';
- if FilesCount > 0 then
- DragText := Format(STextFiles, [FilesCount]);
- if DirsCount > 0 then
- begin
- if FilesCount > 0 then
- DragText := DragText + ', ';
- DragText := DragText + Format(STextDirectories, [DirsCount]);
- end;
- Bitmap.Width := 33 + Bitmap.Canvas.TextWidth(DragText);
- Bitmap.TransparentMode := tmAuto;
- Bitmap.Canvas.TextOut(33,
- Max(24 - Abs(Canvas.Font.Height), 0), DragText);
- GlobalDragImageList.Clear;
- GlobalDragImageList.Width := Bitmap.Width;
- GlobalDragImageList.AddMasked(Bitmap,
- Bitmap.Canvas.Pixels[0, 0]);
- GlobalDragImageList.SetDragImage(0, 25, 20);
- except
- if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES',
- 0, [lrTransparent], $FFFFFF) then
- GlobalDragImageList.SetDragImage(0, 25, 20);
- end;
- finally
- Bitmap.Free;
- end;
- end;
- end;
- ClientPoint := ParentForm.ScreenToClient(Point);
- GlobalDragImageList.BeginDrag(ParentForm.Handle,
- ClientPoint.X, ClientPoint.Y);
- GlobalDragImageList.HideDragImage;
- ShowCursor(True);
- end;
- end;
- finally
- Screen.Cursor := OldCursor;
- end;
- FContextMenu := False;
- if IsRecycleBin then DragDropFilesEx.SourceEffects := [deMove]
- else DragDropFilesEx.SourceEffects := DragSourceEffects;
- DropSourceControl := Self;
- try
- GetSystemTimeAsFileTime(FDragStartTime);
- DataObject := nil;
- if Assigned(OnDDCreateDataObject) then
- begin
- OnDDCreateDataObject(Self, DataObject);
- end;
- {Execute the drag&drop-Operation:}
- FLastDDResult := DragDropFilesEx.Execute(DataObject);
- {the drag&drop operation is finished, so clean up the used drag image:}
- GlobalDragImageList.EndDrag;
- GlobalDragImageList.Clear;
- Application.ProcessMessages;
- finally
- DropSourceControl := nil;
- DragDropFilesEx.FileList.Clear;
- FContextMenu := False;
- DropTarget := nil;
- if Assigned(OnDDEnd) then
- begin
- OnDDEnd(Self);
- end;
- end;
- end;
- end;
- end;
- procedure TCustomDirView.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited;
- if Operation = opRemove then
- begin
- if AComponent = PathLabel then FPathLabel := nil;
- if AComponent = StatusBar then FStatusBar := nil;
- if AComponent = PathComboBox then FPathComboBox := nil;
- end;
- end; { Notification }
- procedure TCustomDirView.WndProc(var Message: TMessage);
- begin
- case Message.Msg of
- WM_SETFOCUS, WM_KILLFOCUS:
- UpdatePathLabel;
- end;
- inherited;
- end; { WndProc }
- function TCustomDirView.FindFileItem(FileName: string): TListItem;
- type
- TFileNameCompare = function(const S1, S2: string): Integer;
- var
- Index: Integer;
- CompareFunc: TFileNameCompare;
- begin
- if FCaseSensitive then CompareFunc := CompareStr
- else CompareFunc := CompareText;
- begin
- for Index := 0 to Items.Count - 1 do
- if CompareFunc(FileName, ItemFileName(Items[Index])) = 0 then
- begin
- Result := Items[Index];
- Exit;
- end;
- Result := nil;
- end;
- end;
- procedure TCustomDirView.DoAnimation(Start: Boolean);
- begin
- if Start and LoadAnimation then
- begin
- if not Assigned(FAnimation) then
- begin
- FAnimation := TAnimate.Create(Self);
- try
- FAnimation.Top := (Height - FAnimation.Height) div 2;
- FAnimation.Left := (Width - FAnimation.Width) div 2;
- FAnimation.Parent := Self;
- FAnimation.CommonAVI := aviFindFolder;
- FAnimation.Transparent := True;
- FAnimation.Active := True;
- except
- FreeAndNil(FAnimation);
- end;
- end;
- end
- else
- if not Start then
- FreeAndNil(FAnimation);
- end; { DoAnimation }
- function TCustomDirView.GetForwardCount: Integer;
- begin
- Result := FHistoryPaths.Count - BackCount;
- end; { GetForwardCount }
- function TCustomDirView.GetBackMenu: TPopupMenu;
- begin
- if not Assigned(FBackMenu) then
- begin
- FBackMenu := TPopupMenu.Create(Self);
- UpdateHistoryMenu(hdBack);
- end;
- Result := FBackMenu;
- end; { GetBackMenu }
- function TCustomDirView.GetForwardMenu: TPopupMenu;
- begin
- if not Assigned(FForwardMenu) then
- begin
- FForwardMenu := TPopupMenu.Create(Self);
- UpdateHistoryMenu(hdForward);
- end;
- Result := FForwardMenu;
- end; { GetForwardMenu }
- procedure TCustomDirView.HistoryItemClick(Sender: TObject);
- begin
- HistoryGo((Sender as TMenuItem).Tag);
- end; { HistoryItemClick }
- procedure TCustomDirView.LimitHistorySize;
- begin
- while FHistoryPaths.Count > MaxHistoryCount do
- begin
- if BackCount > 0 then
- begin
- FHistoryPaths.Delete(0);
- Dec(FBackCount);
- end
- else
- FHistoryPaths.Delete(FHistoryPaths.Count-1);
- end;
- end; { LimitHistorySize }
- procedure TCustomDirView.UpdateHistoryMenu(Direction: THistoryDirection);
- var
- Menu: TPopupMenu;
- ICount: Integer;
- Index: Integer;
- Factor: Integer;
- Item: TMenuItem;
- begin
- if Direction = hdBack then
- begin
- Menu := BackMenu;
- ICount := BackCount;
- Factor := -1;
- end
- else
- begin
- Menu := ForwardMenu;
- ICount := ForwardCount;
- Factor := 1;
- end;
- if ICount > MaxHistoryMenuLen then ICount := MaxHistoryMenuLen;
- if Assigned(Menu) then
- with Menu.Items do
- begin
- Clear;
- for Index := 1 to ICount do
- begin
- Item := TMenuItem.Create(Menu);
- with Item do
- begin
- Caption := MinimizePath(HistoryPath[Index * Factor],
- MaxHistoryMenuWidth);
- Hint := HistoryPath[Index * Factor];
- Tag := Index * Factor;
- OnClick := HistoryItemClick;
- end;
- Add(Item);
- end;
- end;
- end; { UpdateHistoryMenu }
- function TCustomDirView.GetHistoryPath(Index: Integer): string;
- begin
- Assert(Assigned(FHistoryPaths));
- if Index = 0 then Result := PathName
- else
- if Index < 0 then Result := FHistoryPaths[Index + BackCount]
- else
- if Index > 0 then Result := FHistoryPaths[Index + BackCount - 1];
- end; { GetHistoryPath }
- procedure TCustomDirView.SetMaxHistoryCount(Value: Integer);
- begin
- if FMaxHistoryCount <> Value then
- begin
- FMaxHistoryCount := Value;
- DoHistoryChange;
- end;
- end; { SetMaxHistoryCount }
- procedure TCustomDirView.SetMaxHistoryMenuLen(Value: Integer);
- begin
- if FMaxHistoryMenuLen <> Value then
- begin
- FMaxHistoryMenuLen := Value;
- DoHistoryChange;
- end;
- end; { SetMaxHistoryMenuLen }
- procedure TCustomDirView.SetMaxHistoryMenuWidth(Value: Integer);
- begin
- if FMaxHistoryMenuWidth <> Value then
- begin
- FMaxHistoryMenuWidth := Value;
- DoHistoryChange;
- end;
- end; { SetMaxHistoryMenuWidth }
- procedure TCustomDirView.DoHistoryChange;
- begin
- LimitHistorySize;
- UpdateHistoryMenu(hdBack);
- UpdateHistoryMenu(hdForward);
- if Assigned(OnHistoryChange) then
- OnHistoryChange(Self);
- end; { DoHistoryChange }
- procedure TCustomDirView.HistoryGo(Index: Integer);
- begin
- if Index <> 0 then
- begin
- FDontRecordPath := True;
- try
- Path := HistoryPath[Index];
- finally
- FDontRecordPath := False;
- end;
- FHistoryPaths.Insert(FBackCount, LastPath);
- FHistoryPaths.Delete(Index + BackCount);
- Inc(FBackCount, Index);
- DoHistoryChange;
- end;
- end; { HistoryGo }
- procedure TCustomDirView.PathChanged;
- var
- Index: Integer;
- begin
- UpdatePathComboBox;
- if (not FDontRecordPath) and (LastPath <> '') and (LastPath <> PathName) then
- begin
- Assert(Assigned(FHistoryPaths));
- for Index := FHistoryPaths.Count - 1 downto BackCount do
- FHistoryPaths.Delete(Index);
- FHistoryPaths.Add(LastPath);
- Inc(FBackCount);
- DoHistoryChange;
- end;
- end; { PathChanged }
- procedure TCustomDirView.ProcessChangedFiles(DirView: TCustomDirView;
- FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
- Criterias: TCompareCriterias);
- var
- Item, MirrorItem: TListItem;
- FileTime, MirrorFileTime: TDateTime;
- OldCursor: TCursor;
- Index: Integer;
- Changed: Boolean;
- SameTime: Boolean;
- begin
- Assert(Valid);
- OldCursor := Screen.Cursor;
- if not Assigned(FileList) then
- begin
- Items.BeginUpdate;
- BeginSelectionUpdate;
- end;
- try
- Screen.Cursor := crHourGlass;
- for Index := 0 to Items.Count-1 do
- begin
- Item := Items[Index];
- Changed := False;
- if not ItemIsDirectory(Item) then
- begin
- MirrorItem := DirView.FindFileItem(ItemFileName(Item));
- if MirrorItem = nil then
- begin
- Changed := not ExistingOnly;
- end
- else
- begin
- if ccTime in Criterias then
- begin
- FileTime := ItemFileTime(Item);
- MirrorFileTime := DirView.ItemFileTime(MirrorItem);
- UnifyDateTimePrecision(FileTime, MirrorFileTime);
- Changed :=
- (FileTime > MirrorFileTime) { or
- ((FileTime = MirrorFileTime) and
- (ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem))) };
- SameTime := (FileTime = MirrorFileTime);
- end
- else
- begin
- SameTime := True;
- end;
- if (not Changed) and SameTime and (ccSize in Criterias) then
- begin
- Changed := ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem);
- end
- end;
- end;
- if Assigned(FileList) then
- begin
- if Changed then
- begin
- if FullPath then
- begin
- FileList.AddObject(ItemFullFileName(Item), Item.Data)
- end
- else
- begin
- FileList.AddObject(ItemFileName(Item), Item.Data);
- end;
- end;
- end
- else
- begin
- Item.Selected := Changed;
- end;
- end;
- finally
- Screen.Cursor := OldCursor;
- if not Assigned(FileList) then
- begin
- Items.EndUpdate;
- EndSelectionUpdate;
- end;
- end;
- end;
- function TCustomDirView.CreateChangedFileList(DirView: TCustomDirView;
- FullPath: Boolean; ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
- begin
- Result := TStringList.Create;
- try
- ProcessChangedFiles(DirView, Result, FullPath, ExistingOnly, Criterias);
- except
- FreeAndNil(Result);
- raise;
- end;
- end;
- procedure TCustomDirView.CompareFiles(DirView: TCustomDirView;
- ExistingOnly: Boolean; Criterias: TCompareCriterias);
- begin
- ProcessChangedFiles(DirView, nil, True, ExistingOnly, Criterias);
- end;
- procedure TCustomDirView.FocusSomething;
- begin
- if FSavedSelection then FPendingFocusSomething := True
- else inherited;
- end;
- procedure TCustomDirView.SaveSelection;
- var
- Closest: TListItem;
- begin
- Assert(not FSavedSelection);
- FSavedSelectionFile := '';
- FSavedSelectionLastFile := '';
- if Assigned(ItemFocused) then
- begin
- FSavedSelectionLastFile := ItemFocused.Caption;
- end;
- Closest := ClosestUnselected(ItemFocused);
- if Assigned(Closest) then
- begin
- FSavedSelectionFile := Closest.Caption;
- end;
- FSavedSelection := True;
- end;
- procedure TCustomDirView.RestoreSelection;
- var
- ItemToSelect: TListItem;
- begin
- Assert(FSavedSelection);
- FSavedSelection := False;
- if (FSavedSelectionLastFile <> '') and
- ((not Assigned(ItemFocused)) or
- (ItemFocused.Caption <> FSavedSelectionLastFile)) then
- begin
- ItemToSelect := FindFileItem(FSavedSelectionFile);
- if Assigned(ItemToSelect) then
- begin
- ItemFocused := ItemToSelect;
- end;
- end;
- if not Assigned(ItemFocused) then FocusSomething
- else ItemFocused.MakeVisible(False);
- end;
- procedure TCustomDirView.DiscardSavedSelection;
- begin
- Assert(FSavedSelection);
- FSavedSelection := False;
- if FPendingFocusSomething then
- begin
- FPendingFocusSomething := False;
- FocusSomething;
- end;
- end;
- var
- DocPIDL: PItemIDList;
- initialization
- HasExtendedCOMCTL32 := COMCTL32OK;
- DropSourceControl := nil;
- SetLength(WinDir, MAX_PATH);
- SetLength(WinDir, GetWindowsDirectory(PChar(WinDir), MAX_PATH));
- SetLength(TempDir, MAX_PATH);
- SetLength(TempDir, GetTempPath(MAX_PATH, PChar(TempDir)));
- SetLength(UserDocumentDirectory, MAX_PATH);
- SHGetSpecialFolderLocation(Application.Handle, CSIDL_PERSONAL, DocPIDL);
- SHGetPathFromIDList(DocPIDL, PChar(UserDocumentDirectory));
- SetLength(UserDocumentDirectory, StrLen(PChar(UserDocumentDirectory)));
- UnknownFileIcon := GetshFileInfo('$#)(.#$)', FILE_ATTRIBUTE_NORMAL,
- SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
- DefaultExeIcon := GetshFileInfo('.COM',
- FILE_ATTRIBUTE_NORMAL, SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
- with GetshFileInfo(WinDir, FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY,
- SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES) do
- begin
- StdDirTypeName := szTypeName;
- StdDirIcon := iIcon;
- end;
- StdDirSelIcon := GetIconIndex(WinDir,
- FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY, SHGFI_OPENICON);
- WinDir := IncludeTrailingPathDelimiter(WinDir);
- TempDir := IncludeTrailingPathDelimiter(TempDir);
- finalization
- SetLength(StdDirTypeName, 0);
- SetLength(WinDir, 0);
- SetLength(TempDir, 0);
- end.
|