CustomDirView.pas 117 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760
  1. unit CustomDirView;
  2. interface
  3. {$R DirImg.res}
  4. {$WARN UNIT_PLATFORM OFF}
  5. {$WARN SYMBOL_PLATFORM OFF}
  6. uses
  7. Windows, Messages, Classes, Graphics, Controls,
  8. Forms, ComCtrls, ShellAPI, ComObj, ShlObj, Dialogs,
  9. ActiveX, CommCtrl, Extctrls, ImgList, Menus, FileCtrl,
  10. PIDL, BaseUtils, DragDrop, DragDropFilesEx, IEDriveInfo,
  11. IEListView, PathLabel, SysUtils, PasTools;
  12. const
  13. clDefaultItemColor = -(COLOR_ENDCOLORS + 1);
  14. WM_USER_RENAME = WM_USER + 57;
  15. WM_USER_INVALIDATEITEM = WM_USER + $2000 + 16;
  16. oiNoOverlay = $00;
  17. oiDirUp = $01;
  18. oiLink = $02;
  19. oiBrokenLink = $04;
  20. oiPartial = $08;
  21. oiEncrypted = $10;
  22. DefaultHistoryCount = 200;
  23. const
  24. DDDragStartDelay = 500000;
  25. DirAttrMask = SysUtils.faDirectory or SysUtils.faSysFile or SysUtils.faHidden;
  26. const
  27. _XBUTTON1 = $0001;
  28. _XBUTTON2 = $0002;
  29. type
  30. TStatusFileInfo = record
  31. FilesCount: Integer;
  32. SelectedCount: Integer;
  33. FilesSize: Int64;
  34. SelectedSize: Int64;
  35. HiddenCount: Integer;
  36. FilteredCount: Integer;
  37. end;
  38. type
  39. {Drag&Drop events:}
  40. TDDError = (DDCreateShortCutError, DDPathNotFoundError);
  41. TDDOnDragEnter = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint; var Accept: Boolean) of object;
  42. TDDOnDragLeave = procedure(Sender: TObject) of object;
  43. TDDOnDragOver = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  44. TDDOnDrop = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  45. TDDOnQueryContinueDrag = procedure(Sender: TObject; FEscapePressed: BOOL; grfKeyState: Longint; var Result: HResult) of object;
  46. TDDOnGiveFeedback = procedure(Sender: TObject; dwEffect: Longint; var Result: HResult) of object;
  47. TDDOnChooseEffect = procedure(Sender: TObject; grfKeyState: Longint; var dwEffect: Longint) of object;
  48. TDDOnDragDetect = procedure(Sender: TObject; grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus) of object;
  49. TDDOnCreateDragFileList = procedure(Sender: TObject; FileList: TFileList; var Created: Boolean) of object;
  50. TDDOnCreateDataObject = procedure(Sender: TObject; var DataObject: TDataObject) of object;
  51. TDDOnTargetHasDropHandler = procedure(Sender: TObject; Item: TListItem; var Effect: Integer; var DropHandler: Boolean) of object;
  52. TOnProcessDropped = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  53. TDDErrorEvent = procedure(Sender: TObject; ErrorNo: TDDError) of object;
  54. TDDExecutedEvent = procedure(Sender: TObject; dwEffect: Longint) of object;
  55. TDDFileOperationEvent =
  56. procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string; Paste: Boolean;
  57. var DoOperation: Boolean) of object;
  58. TDDFileOperationExecutedEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string) of object;
  59. TDirViewExecFileEvent = procedure(Sender: TObject; Item: TListItem; var AllowExec: Boolean) of object;
  60. TMatchMaskEvent = procedure(Sender: TObject; FileName: string; Directory: Boolean; Size: Int64; Modification: TDateTime; Masks: string; var Matches: Boolean; AllowImplicitMatches: Boolean) of object;
  61. TDirViewGetOverlayEvent = procedure(Sender: TObject; Item: TListItem; var Indexes: Word) of object;
  62. TDirViewGetItemColorEvent = procedure(Sender: TObject; FileName: string; Directory: Boolean; Size: Int64; Modification: TDateTime; var Color: TColor) of object;
  63. TDirViewUpdateStatusBarEvent = procedure(Sender: TObject; const FileInfo: TStatusFileInfo) of object;
  64. TDirViewBusy = procedure(Sender: TObject; Busy: Integer; var State: Boolean) of object;
  65. TDirViewChangeFocusEvent = procedure(Sender: TObject; Item: TListItem) of object;
  66. TBusyOperation = reference to procedure;
  67. type
  68. TCustomDirView = class;
  69. TSelAttr = (selDontCare, selYes, selNo);
  70. TFileFilter = record
  71. Masks: string;
  72. Directories: Boolean;
  73. end;
  74. TDirViewNotifyEvent = procedure(Sender: TCustomDirView) of object;
  75. TDVGetFilterEvent = procedure(Sender: TCustomDirView; Select: Boolean;
  76. var Filter: TFileFilter) of object;
  77. TDVHistoryGoEvent = procedure(Sender: TCustomDirView; Index: Integer; var Cancel: Boolean) of object;
  78. TCompareCriteria = (ccTime, ccSize);
  79. TCompareCriterias = set of TCompareCriteria;
  80. // First four must match TViewStyle
  81. TDirViewStyle = (dvsIcon, dvsSmallIcon, dvsList, dvsReport, dvsThumbnail);
  82. TWMXMouse = packed record
  83. Msg: Cardinal;
  84. Keys: Word;
  85. Button: Word;
  86. Pos: TSmallPoint;
  87. Result: Longint
  88. end;
  89. TCustomizableDragDropFilesEx = class(TDragDropFilesEx)
  90. public
  91. function Execute(DataObject: TDataObject): TDragResult;
  92. end;
  93. TCustomDirView = class(TCustomIEListView)
  94. private
  95. FAddParentDir: Boolean;
  96. FDimmHiddenFiles: Boolean;
  97. FFormatSizeBytes: TFormatBytesStyle;
  98. FWantUseDragImages: Boolean;
  99. FDragDropFilesEx: TCustomizableDragDropFilesEx;
  100. FUseSystemContextMenu: Boolean;
  101. FOnStartLoading: TNotifyEvent;
  102. FOnLoaded: TNotifyEvent;
  103. FExeDrag: Boolean;
  104. FDDLinkOnExeDrag: Boolean;
  105. FOnDDDragEnter: TDDOnDragEnter;
  106. FOnDDDragLeave: TDDOnDragLeave;
  107. FOnDDDragOver: TDDOnDragOver;
  108. FOnDDDrop: TDDOnDrop;
  109. FOnDDQueryContinueDrag: TDDOnQueryContinueDrag;
  110. FOnDDGiveFeedback: TDDOnGiveFeedback;
  111. FOnDDChooseEffect: TDDOnChooseEffect;
  112. FOnDDDragDetect: TDDOnDragDetect;
  113. FOnDDCreateDragFileList: TDDOnCreateDragFileList;
  114. FOnDDProcessDropped: TOnProcessDropped;
  115. FOnDDError: TDDErrorEvent;
  116. FOnDDExecuted: TDDExecutedEvent;
  117. FOnDDFileOperation: TDDFileOperationEvent;
  118. FOnDDFileOperationExecuted: TDDFileOperationExecutedEvent;
  119. FOnDDEnd: TNotifyEvent;
  120. FOnDDCreateDataObject: TDDOnCreateDataObject;
  121. FOnDDTargetHasDropHandler: TDDOnTargetHasDropHandler;
  122. FOnExecFile: TDirViewExecFileEvent;
  123. FForceRename: Boolean;
  124. FLastDDResult: TDragResult;
  125. FLastRenameName: string;
  126. FContextMenu: Boolean;
  127. FDragEnabled: Boolean;
  128. FDragPos: TPoint;
  129. FStartPos: TPoint;
  130. FDDOwnerIsSource: Boolean;
  131. FAbortLoading: Boolean;
  132. FBackCount: Integer;
  133. FDontRecordPath: Boolean;
  134. FDragOnDriveIsMove: Boolean;
  135. FNotifyEnabled: Boolean;
  136. FDragStartTime: TFileTime;
  137. FHistoryPaths: TStrings;
  138. FOverlaySmallImages: TImageList;
  139. FOverlayLargeImages: TImageList;
  140. FThumbnailShellImages: TImageList;
  141. FThumbnailImages: TImageList;
  142. FMaxHistoryCount: Integer;
  143. FPathLabel: TCustomPathLabel;
  144. FOnUpdateStatusBar: TDirViewUpdateStatusBarEvent;
  145. FOnHistoryChange: TDirViewNotifyEvent;
  146. FOnHistoryGo: TDVHistoryGoEvent;
  147. FOnPathChange: TDirViewNotifyEvent;
  148. FShowHiddenFiles: Boolean;
  149. FSavedSelection: Boolean;
  150. FSavedSelectionFile: string;
  151. FSavedSelectionLastFile: string;
  152. FSavedNames: TStringList;
  153. FPendingFocusSomething: Boolean;
  154. FOnMatchMask: TMatchMaskEvent;
  155. FOnGetOverlay: TDirViewGetOverlayEvent;
  156. FOnGetItemColor: TDirViewGetItemColorEvent;
  157. FMask: string;
  158. FNaturalOrderNumericalSorting: Boolean;
  159. FAlwaysSortDirectoriesByName: Boolean;
  160. FDarkMode: Boolean;
  161. FScrollOnDragOver: TListViewScrollOnDragOver;
  162. FStatusFileInfo: TStatusFileInfo;
  163. FDoubleBufferedScrollingWorkaround: Boolean;
  164. FOnBusy: TDirViewBusy;
  165. FOnChangeFocus: TDirViewChangeFocusEvent;
  166. FFallbackThumbnail: array[Boolean] of TBitmap;
  167. FFallbackThumbnailSize: TSize;
  168. procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  169. procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
  170. procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  171. procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  172. procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  173. procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  174. procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  175. procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  176. procedure WMXButtonUp(var Message: TWMXMouse); message WM_XBUTTONUP;
  177. procedure WMAppCommand(var Message: TMessage); message WM_APPCOMMAND;
  178. procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  179. procedure LVMSetExtendedListViewStyle(var Message: TMessage); message LVM_SETEXTENDEDLISTVIEWSTYLE;
  180. procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
  181. procedure CMDPIChanged(var Message: TMessage); message CM_DPICHANGED;
  182. procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  183. procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
  184. procedure WMUserInvalidateItem(var Message: TMessage); message WM_USER_INVALIDATEITEM;
  185. procedure DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem;
  186. State: TCustomDrawState; var DefaultDraw: Boolean);
  187. procedure DumbCustomDrawSubItem(Sender: TCustomListView;
  188. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  189. var DefaultDraw: Boolean);
  190. function GetFilesMarkedSize: Int64;
  191. function GetForwardCount: Integer;
  192. function GetHistoryPath(Index: Integer): string;
  193. function GetSelectedNamesSaved: Boolean;
  194. function GetDirViewStyle: TDirViewStyle;
  195. procedure SetDirViewStyle(Value: TDirViewStyle);
  196. function GetTargetPopupMenu: Boolean;
  197. function GetUseDragImages: Boolean;
  198. procedure SetMaxHistoryCount(Value: Integer);
  199. procedure SetPathLabel(Value: TCustomPathLabel);
  200. procedure SetTargetPopupMenu(Value: Boolean);
  201. procedure WMUserRename(var Message: TMessage); message WM_User_Rename;
  202. protected
  203. FCaseSensitive: Boolean;
  204. FDirty: Boolean;
  205. FFilesSize: Int64;
  206. FFilesSelSize: Int64;
  207. FHasParentDir: Boolean;
  208. FIsRecycleBin: Boolean;
  209. FLastPath: string;
  210. FHistoryPath: string;
  211. FLoadEnabled: Boolean;
  212. FLoading: Boolean;
  213. FSelectFile: string;
  214. FWatchForChanges: Boolean;
  215. FInvalidNameChars: string;
  216. FDragDrive: string;
  217. FAnnouncedState: TObject;
  218. FThumbnail: Boolean;
  219. procedure AddToDragFileList(FileList: TFileList; Item: TListItem); virtual;
  220. function CanEdit(Item: TListItem): Boolean; override;
  221. function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; override;
  222. procedure CancelEdit;
  223. procedure ClearItems; override;
  224. function GetDirOK: Boolean; virtual; abstract;
  225. procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus); virtual;
  226. procedure DDDragEnter(DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  227. procedure DDDragLeave;
  228. procedure DDDragOver(grfKeyState: Longint; Point: TPoint; var dwEffect: Longint; PreferredEffect: LongInt);
  229. procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer); virtual;
  230. procedure DDDrop(DataObj: IDataObject; grfKeyState: LongInt; Point: TPoint; var dwEffect: Longint);
  231. procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint; Point: TPoint; dwEffect: Longint); virtual;
  232. procedure DDGiveFeedback(dwEffect: Longint; var Result: HResult); virtual;
  233. procedure DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  234. AMinCustCmd:integer; grfKeyState: Longint; pt: TPoint); virtual;
  235. procedure DDMenuDone(Sender: TObject; AMenu: HMenu); virtual;
  236. procedure DDProcessDropped(Sender: TObject; grfKeyState: Longint;
  237. Point: TPoint; dwEffect: Longint);
  238. procedure DDQueryContinueDrag(FEscapePressed: LongBool;
  239. grfKeyState: Longint; var Result: HResult); virtual;
  240. procedure DDSpecifyDropTarget(Sender: TObject; DragDropHandler: Boolean;
  241. Point: TPoint; var pidlFQ : PItemIDList; var Filename: string); virtual;
  242. procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItem); virtual;
  243. function GetDragSourceEffects: TDropEffectSet; virtual;
  244. function GetPathName: string; virtual; abstract;
  245. function GetFilesCount: Integer; virtual;
  246. procedure ColClick(Column: TListColumn); override;
  247. procedure CreateWnd; override;
  248. procedure DestroyWnd; override;
  249. function OperateOnFocusedFile(Focused: Boolean; OnlyFocused: Boolean = False): Boolean;
  250. function CustomCreateFileList(Focused, OnlyFocused: Boolean;
  251. FullPath: Boolean; FileList: TStrings = nil; ItemObject: Boolean = False): TStrings;
  252. function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  253. Stage: TCustomDrawStage): Boolean; override;
  254. function CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  255. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; override;
  256. procedure CustomSortItems(SortProc: Pointer);
  257. procedure Delete(Item: TListItem); override;
  258. procedure DoHistoryChange; dynamic;
  259. function DragCompleteFileList: Boolean; virtual;
  260. procedure Edit(const HItem: TLVItem); override;
  261. procedure EndSelectionUpdate; override;
  262. function DoExecFile(Item: TListItem; ForceEnter: Boolean): Boolean; virtual;
  263. procedure Execute(Item: TListItem; ForceEnter: Boolean); virtual;
  264. procedure ExecuteFile(Item: TListItem); virtual; abstract;
  265. procedure FocusSomething; override;
  266. function GetIsRoot: Boolean; virtual; abstract;
  267. function ItemCanDrag(Item: TListItem): Boolean; virtual;
  268. function DoItemColor(Item: TListItem): TColor;
  269. function ItemColor(Item: TListItem): TColor; virtual;
  270. function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; virtual; abstract;
  271. function ItemThumbnail(Item: TListItem; Size: TSize): TBitmap; virtual;
  272. procedure FreeThumbnails;
  273. function FallbackThumbnail(Dir: Boolean; Size: TSize): TBitmap;
  274. procedure DrawThumbnail(Item: TListItem; DC: HDC);
  275. // ItemIsDirectory and ItemFullFileName is in public block
  276. function ItemIsRecycleBin(Item: TListItem): Boolean; virtual;
  277. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  278. procedure KeyPress(var Key: Char); override;
  279. procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  280. procedure LoadFiles; virtual; abstract;
  281. procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer; Paste: Boolean); virtual; abstract;
  282. procedure ProcessChangedFiles(DirView: TCustomDirView;
  283. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  284. Criterias: TCompareCriterias);
  285. procedure ReloadForce(CacheIcons : Boolean);
  286. procedure RetryRename(NewName: string);
  287. procedure SetAddParentDir(Value: Boolean); virtual;
  288. procedure SetDimmHiddenFiles(Value: Boolean); virtual;
  289. procedure SetItemImageIndex(Item: TListItem; Index: Integer); virtual; abstract;
  290. procedure SetLoadEnabled(Enabled : Boolean); virtual;
  291. procedure SetMultiSelect(Value: Boolean); override;
  292. function GetPath: string; virtual; abstract;
  293. function GetValid: Boolean; override;
  294. procedure InternalEdit(const HItem: TLVItem); virtual; abstract;
  295. function ItemIsFile(Item: TListItem): Boolean; virtual; abstract;
  296. function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; virtual; abstract;
  297. function ItemOverlayIndexes(Item: TListItem): Word; virtual;
  298. function IsItemVisible(Item: TListItem): Boolean;
  299. procedure LimitHistorySize;
  300. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  301. procedure PathChanged; virtual;
  302. procedure PathChanging(Relative: Boolean);
  303. procedure SetPath(Value: string); virtual; abstract;
  304. procedure SetShowHiddenFiles(Value: Boolean); virtual;
  305. procedure SetFormatSizeBytes(Value: TFormatBytesStyle);
  306. procedure SetViewStyle(Value: TViewStyle); override;
  307. procedure SetWatchForChanges(Value: Boolean); virtual;
  308. function TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean; virtual;
  309. procedure UpdatePathLabel; dynamic;
  310. procedure UpdatePathLabelCaption; dynamic;
  311. function FileNameMatchesMasks(FileName: string; Directory: Boolean; Size: Int64; Modification: TDateTime; Masks: string; AllowImplicitMatches: Boolean): Boolean;
  312. function EnableDragOnClick: Boolean; override;
  313. procedure SetMask(Value: string); virtual;
  314. procedure SetNaturalOrderNumericalSorting(Value: Boolean);
  315. procedure SetAlwaysSortDirectoriesByName(Value: Boolean);
  316. procedure SetDarkMode(Value: Boolean);
  317. procedure ScrollOnDragOverBeforeUpdate(ObjectToValidate: TObject);
  318. procedure ScrollOnDragOverAfterUpdate;
  319. procedure DoHistoryGo(Index: Integer);
  320. procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  321. procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  322. procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
  323. procedure EnsureSelectionRedrawn;
  324. function HiddenCount: Integer; virtual; abstract;
  325. function FilteredCount: Integer; virtual; abstract;
  326. function DoBusy(Busy: Integer): Boolean;
  327. function StartBusy: Boolean;
  328. procedure EndBusy;
  329. function IsBusy: Boolean;
  330. procedure BusyOperation(Operation: TBusyOperation);
  331. procedure DoDisplayPropertiesMenu;
  332. procedure DoExecute(Item: TListItem; ForceEnter: Boolean);
  333. procedure DoExecuteParentDirectory;
  334. procedure Load(DoFocusSomething: Boolean); virtual;
  335. function NeedImageList(Size: TImageListSize; Recreate: Boolean; var OverlayImages: TImageList): TImageList;
  336. procedure NeedImageLists(Recreate: Boolean);
  337. procedure FreeImageLists;
  338. procedure UpdateDarkMode;
  339. procedure DoUpdateStatusBar(Force: Boolean = False);
  340. procedure DoCustomDrawItem(Item: TListItem; Stage: TCustomDrawStage);
  341. procedure ItemCalculatedSizeUpdated(Item: TListItem; OldSize, NewSize: Int64);
  342. function GetThumbnail(Path: string; Size: TSize): TBitmap;
  343. procedure InvalidateItem(Item: TListItem);
  344. public
  345. constructor Create(AOwner: TComponent); override;
  346. destructor Destroy; override;
  347. procedure Reload(CacheIcons: Boolean); virtual;
  348. function CreateFocusedFileList(FullPath: Boolean; FileList: TStrings = nil): TStrings;
  349. function CreateFileList(Focused: Boolean; FullPath: Boolean; FileList: TStrings = nil;
  350. ItemObject: Boolean = False): TStrings;
  351. function AnyFileSelected(OnlyFocused: Boolean; FilesOnly: Boolean;
  352. FocusedFileOnlyWhenFocused: Boolean): Boolean;
  353. procedure SelectFiles(Filter: TFileFilter; Select: Boolean);
  354. procedure ExecuteHomeDirectory; virtual; abstract;
  355. procedure ExecuteParentDirectory; virtual; abstract;
  356. procedure ExecuteRootDirectory; virtual; abstract;
  357. procedure ExecuteCurrentFile();
  358. procedure CreateDirectory(DirName: string); virtual; abstract;
  359. function FindFileItem(FileName: string): TListItem;
  360. procedure HistoryGo(Index: Integer);
  361. function ItemIsDirectory(Item: TListItem): Boolean; virtual; abstract;
  362. function ItemIsParentDirectory(Item: TListItem): Boolean; virtual; abstract;
  363. function ItemFullFileName(Item: TListItem): string; virtual; abstract;
  364. function ItemFileName(Item: TListItem): string; virtual; abstract;
  365. function ItemFileSize(Item: TListItem): Int64; virtual; abstract;
  366. function ItemFileTime(Item: TListItem; var Precision: TDateTimePrecision): TDateTime; virtual; abstract;
  367. function ItemData(Item: TListItem): TObject; virtual;
  368. procedure SetItemCalculatedSize(Item: TListItem; Size: Int64); virtual; abstract;
  369. procedure ReloadDirectory; virtual; abstract;
  370. procedure DisplayPropertiesMenu; virtual; abstract;
  371. function CreateChangedFileList(DirView: TCustomDirView; FullPath: Boolean;
  372. ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  373. procedure CompareFiles(DirView: TCustomDirView; ExistingOnly: Boolean;
  374. Criterias: TCompareCriterias); virtual;
  375. function GetColumnText(ListItem: TListItem; Index: Integer): string;
  376. procedure SaveSelection;
  377. procedure RestoreSelection;
  378. procedure DiscardSavedSelection;
  379. procedure SaveSelectedNames;
  380. procedure RestoreSelectedNames;
  381. procedure ContinueSession(Continue: Boolean);
  382. function CanPasteFromClipBoard: Boolean; dynamic;
  383. function PasteFromClipBoard(TargetPath: string = ''): Boolean; virtual; abstract;
  384. function SaveState: TObject; virtual;
  385. procedure RestoreState(AState: TObject); virtual;
  386. procedure AnnounceState(AState: TObject); virtual;
  387. procedure RestoreFocus(FocusedItem: string);
  388. procedure DisplayContextMenu(Where: TPoint); virtual; abstract;
  389. procedure DisplayContextMenuInSitu;
  390. procedure UpdateStatusBar;
  391. property AddParentDir: Boolean read FAddParentDir write SetAddParentDir default False;
  392. property DimmHiddenFiles: Boolean read FDimmHiddenFiles write SetDimmHiddenFiles default True;
  393. property DragDropFilesEx: TCustomizableDragDropFilesEx read FDragDropFilesEx;
  394. property FormatSizeBytes: TFormatBytesStyle read FFormatSizeBytes write SetFormatSizeBytes default fbNone;
  395. property WantUseDragImages: Boolean read FWantUseDragImages write FWantUseDragImages default False;
  396. property UseDragImages: Boolean read GetUseDragImages stored False;
  397. property FullDrag default True;
  398. property TargetPopupMenu: Boolean read GetTargetPopupMenu write SetTargetPopupMenu default True;
  399. property DDOwnerIsSource: Boolean read FDDOwnerIsSource;
  400. property FilesSize: Int64 read FFilesSize;
  401. property FilesSelSize: Int64 read FFilesSelSize;
  402. property FilesCount: Integer read GetFilesCount;
  403. property FilesMarkedSize: Int64 read GetFilesMarkedSize;
  404. property HasParentDir: Boolean read FHasParentDir;
  405. property Path: string read GetPath write SetPath;
  406. property PathName: string read GetPathName;
  407. property UseSystemContextMenu: Boolean read FUseSystemContextMenu
  408. write FUseSystemContextMenu default True;
  409. property Loading: Boolean read FLoading;
  410. property AbortLoading: Boolean read FAbortLoading write FAbortLoading stored False;
  411. property BackCount: Integer read FBackCount;
  412. {Enable or disable populating the item list:}
  413. property LoadEnabled: Boolean read FLoadEnabled write SetLoadEnabled default True;
  414. {Displayed data is not valid => reload required}
  415. property Dirty: Boolean read FDirty;
  416. property DirOK: Boolean read GetDirOK;
  417. property LastPath: string read FLastPath;
  418. property IsRecycleBin: Boolean read FIsRecycleBin;
  419. property DDLinkOnExeDrag: Boolean read FDDLinkOnExeDrag
  420. write FDDLinkOnExeDrag default False;
  421. property DragOnDriveIsMove: Boolean read FDragOnDriveIsMove write FDragOnDriveIsMove;
  422. property DragSourceEffects: TDropEffectSet read GetDragSourceEffects{ write FDragSourceEffects};
  423. property ExeDrag: Boolean read FExeDrag;
  424. property ForwardCount: Integer read GetForwardCount;
  425. property HistoryPath[Index: Integer]: string read GetHistoryPath;
  426. property IsRoot: Boolean read GetIsRoot;
  427. property LastDDResult: TDragResult read FLastDDResult;
  428. property SmallImages;
  429. property LargeImages;
  430. property MaxHistoryCount: Integer read FMaxHistoryCount write SetMaxHistoryCount default DefaultHistoryCount;
  431. property SelectedNamesSaved: Boolean read GetSelectedNamesSaved;
  432. {filemask, multiple filters are possible: '*.pas;*.dfm'}
  433. property Mask: string read FMask write SetMask;
  434. property NaturalOrderNumericalSorting: Boolean read FNaturalOrderNumericalSorting write SetNaturalOrderNumericalSorting;
  435. property AlwaysSortDirectoriesByName: Boolean read FAlwaysSortDirectoriesByName write SetAlwaysSortDirectoriesByName;
  436. property DarkMode: Boolean read FDarkMode write SetDarkMode;
  437. property DirViewStyle: TDirViewStyle read GetDirViewStyle write SetDirViewStyle;
  438. property OnContextPopup;
  439. property OnStartLoading: TNotifyEvent read FOnStartLoading write FOnStartLoading;
  440. property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
  441. {The mouse has entered the component window as a target of a drag&drop operation:}
  442. property OnDDDragEnter: TDDOnDragEnter read FOnDDDragEnter write FOnDDDragEnter;
  443. {The mouse has leaved the component window as a target of a drag&drop operation:}
  444. property OnDDDragLeave: TDDOnDragLeave read FOnDDDragLeave write FOnDDDragLeave;
  445. {The mouse is dragging in the component window as a target of a drag&drop operation:}
  446. property OnDDDragOver: TDDOnDragOver read FOnDDDragOver write FOnDDDragOver;
  447. {The Drag&drop operation is about to be executed:}
  448. property OnDDDrop: TDDOnDrop read FOnDDDrop write FOnDDDrop;
  449. property OnDDQueryContinueDrag: TDDOnQueryContinueDrag
  450. read FOnDDQueryContinueDrag write FOnDDQueryContinueDrag;
  451. property OnDDGiveFeedback: TDDOnGiveFeedback
  452. read FOnDDGiveFeedback write FOnDDGiveFeedback;
  453. property OnDDChooseEffect: TDDOnChooseEffect
  454. read FOnDDChooseEffect write FOnDDChooseEffect;
  455. {A drag&drop operation is about to be initiated whith
  456. the components window as the source:}
  457. property OnDDDragDetect: TDDOnDragDetect
  458. read FOnDDDragDetect write FOnDDDragDetect;
  459. property OnDDCreateDragFileList: TDDOnCreateDragFileList
  460. read FOnDDCreateDragFileList write FOnDDCreateDragFileList;
  461. property OnDDEnd: TNotifyEvent
  462. read FOnDDEnd write FOnDDEnd;
  463. property OnDDCreateDataObject: TDDOnCreateDataObject
  464. read FOnDDCreateDataObject write FOnDDCreateDataObject;
  465. property OnDDTargetHasDropHandler: TDDOnTargetHasDropHandler
  466. read FOnDDTargetHasDropHandler write FOnDDTargetHasDropHandler;
  467. {The component window is the target of a drag&drop operation:}
  468. property OnDDProcessDropped: TOnProcessDropped
  469. read FOnDDProcessDropped write FOnDDProcessDropped;
  470. {An error has occurred during a drag&drop operation:}
  471. property OnDDError: TDDErrorEvent read FOnDDError write FOnDDError;
  472. {The drag&drop operation has been executed:}
  473. property OnDDExecuted: TDDExecutedEvent
  474. read FOnDDExecuted write FOnDDExecuted;
  475. {Event is fired just before executing the fileoperation. This event is also fired when
  476. files are pasted from the clipboard:}
  477. property OnDDFileOperation: TDDFileOperationEvent
  478. read FOnDDFileOperation write FOnDDFileOperation;
  479. {Event is fired after executing the fileoperation. This event is also fired when
  480. files are pasted from the clipboard:}
  481. property OnDDFileOperationExecuted: TDDFileOperationExecutedEvent
  482. read FOnDDFileOperationExecuted write FOnDDFileOperationExecuted;
  483. {Set AllowExec to false, if actual file should not be executed:}
  484. property OnExecFile: TDirViewExecFileEvent
  485. read FOnExecFile write FOnExecFile;
  486. property OnHistoryChange: TDirViewNotifyEvent read FOnHistoryChange write FOnHistoryChange;
  487. property OnHistoryGo: TDVHistoryGoEvent read FOnHistoryGo write FOnHistoryGo;
  488. property OnPathChange: TDirViewNotifyEvent read FOnPathChange write FOnPathChange;
  489. property OnMatchMask: TMatchMaskEvent read FOnMatchMask write FOnMatchMask;
  490. property OnGetOverlay: TDirViewGetOverlayEvent read FOnGetOverlay write FOnGetOverlay;
  491. property OnGetItemColor: TDirViewGetItemColorEvent read FOnGetItemColor write FOnGetItemColor;
  492. property PathLabel: TCustomPathLabel read FPathLabel write SetPathLabel;
  493. property ShowHiddenFiles: Boolean read FShowHiddenFiles write SetShowHiddenFiles default True;
  494. property OnUpdateStatusBar: TDirViewUpdateStatusBarEvent read FOnUpdateStatusBar write FOnUpdateStatusBar;
  495. property OnBusy: TDirViewBusy read FOnBusy write FOnBusy;
  496. property OnChangeFocus: TDirViewChangeFocusEvent read FOnChangeFocus write FOnChangeFocus;
  497. {Watch current directory for filename changes (create, rename, delete files)}
  498. property WatchForChanges: Boolean read FWatchForChanges write SetWatchForChanges default False;
  499. end;
  500. resourcestring
  501. SErrorRenameFile = 'Can''t rename file or directory: ';
  502. SErrorRenameFileExists = 'File already exists: ';
  503. SErrorInvalidName = 'Filename contains invalid characters:';
  504. STextFileExt = 'File %s';
  505. STextFiles = '%u Files';
  506. STextDirectories = '%u Directories';
  507. SParentDir = 'Parent directory';
  508. SDragDropError = 'DragDrop Error: %d';
  509. SDriveNotReady = 'Drive ''%s:'' is not ready.';
  510. SDirNotExists = 'Directory ''%s'' doesn''t exist.';
  511. {Additional non-component specific functions:}
  512. {Create and resolve a shell link (file shortcut):}
  513. function CreateFileShortCut(SourceFile, Target, DisplayName: string;
  514. UpdateIfExists: Boolean = False): Boolean;
  515. function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
  516. function IsExecutable(FileName: string): Boolean;
  517. function GetNextMask(var Mask: string): string;
  518. procedure DefaultFileFilter(var Filter: TFileFilter);
  519. function CompareLogicalTextPas(const S1, S2: string; NaturalOrderNumericalSorting: Boolean): Integer;
  520. function OverlayImageList(Size: Integer): TImageList;
  521. procedure InitFileControls;
  522. var
  523. StdDirIcon: Integer;
  524. StdDirSelIcon: Integer;
  525. DropSourceControl: TObject;
  526. UnknownFileIcon: Integer = 0;
  527. StdDirTypeName: string;
  528. DefaultExeIcon: Integer;
  529. UserDocumentDirectory: string;
  530. const
  531. coInvalidDosChars = '\/:*?"<>|';
  532. Space = ' ';
  533. implementation
  534. uses
  535. Math, DirViewColProperties, UITypes, Types, OperationWithTimeout, Winapi.UxTheme, Vcl.Themes, System.IOUtils;
  536. type
  537. PRGBQuadArray = ^TRGBQuadArray; // From graphics.pas
  538. TRGBQuadArray = array[Byte] of TRGBQuad; // From graphics.pas
  539. const
  540. ResDirUp = 'DIRUP%2.2d';
  541. ResLink = 'LINK%2.2d';
  542. ResBrokenLink = 'BROKEN%2.2d';
  543. ResPartial = 'PARTIAL%2.2d';
  544. ResEncrypted = 'ENCRYPTED%2.2d';
  545. var
  546. WinDir: string;
  547. TempDir: string;
  548. GlobalsInitialized: Boolean = False;
  549. function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
  550. var
  551. FileInfo: TSHFileInfo;
  552. begin
  553. try
  554. SHGetFileInfo(PChar(AFile), Attrs, FileInfo, SizeOf(TSHFileInfo),
  555. Flags or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  556. Result := FileInfo.iIcon;
  557. except
  558. Result := -1;
  559. end;
  560. end; {GetIconIndex}
  561. function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
  562. begin
  563. try
  564. SHGetFileInfoWithTimeout(PChar(AFile), Attrs, Result, SizeOf(TSHFileInfo), Flags, 1000);
  565. except
  566. FillChar(Result, SizeOf(Result), 0);
  567. end;
  568. end; {GetshFileInfo}
  569. procedure InitFileControls;
  570. begin
  571. if not GlobalsInitialized then
  572. begin
  573. GlobalsInitialized := True;
  574. // See the comment in the call from Execute()
  575. NeedShellImageLists;
  576. // Calling GetshFileInfo in Windows Session 0 sometime cause crash
  577. // (not immediately, but very shortly afterwards [few ms]).
  578. // So this code was moved from initialization section to avoid it
  579. // being used for non-GUI runs.
  580. UnknownFileIcon := GetshFileInfo('$#)(.#$)', FILE_ATTRIBUTE_NORMAL,
  581. SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
  582. DefaultExeIcon := GetshFileInfo('.COM',
  583. FILE_ATTRIBUTE_NORMAL, SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
  584. with GetshFileInfo(WinDir, FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY,
  585. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES) do
  586. begin
  587. StdDirTypeName := szTypeName;
  588. StdDirIcon := iIcon;
  589. end;
  590. StdDirSelIcon := GetIconIndex(WinDir,
  591. FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY, SHGFI_OPENICON);
  592. end;
  593. end;
  594. type
  595. TDirViewState = class(TObject)
  596. public
  597. constructor Create;
  598. destructor Destroy; override;
  599. private
  600. HistoryPaths: TStrings;
  601. BackCount: Integer;
  602. SortStr: string;
  603. Mask: string;
  604. FocusedItem: string;
  605. end;
  606. constructor TDirViewState.Create;
  607. begin
  608. inherited;
  609. end;
  610. destructor TDirViewState.Destroy;
  611. begin
  612. HistoryPaths.Free;
  613. inherited;
  614. end;
  615. function IsExecutable(FileName: string): Boolean;
  616. var
  617. FileExt: string;
  618. begin
  619. FileExt := UpperCase(ExtractFileExt(FileName));
  620. Result := (FileExt = '.EXE') or (FileExt = '.COM');
  621. end;
  622. function GetNextMask(var Mask: string): string;
  623. var
  624. NextPos: Integer;
  625. begin
  626. NextPos := Pos(';', Mask);
  627. if NextPos = 0 then
  628. begin
  629. Result := Mask;
  630. SetLength(Mask, 0);
  631. end
  632. else
  633. begin
  634. Result := Copy(Mask, 1, NextPos - 1);
  635. Delete(Mask, 1, NextPos);
  636. end;
  637. end;
  638. procedure DefaultFileFilter(var Filter: TFileFilter);
  639. begin
  640. with Filter do
  641. begin
  642. SetLength(Masks, 0);
  643. Directories := False;
  644. end;
  645. end;
  646. function StrCmpLogicalW(const sz1, sz2: UnicodeString): Integer; stdcall; external 'shlwapi.dll';
  647. function CompareLogicalTextPas(const S1, S2: string; NaturalOrderNumericalSorting: Boolean): Integer;
  648. begin
  649. // Keep in sync with CompareLogicalText
  650. if NaturalOrderNumericalSorting then
  651. Result := StrCmpLogicalW(PChar(S1), PChar(S2))
  652. else
  653. Result := lstrcmpi(PChar(S1), PChar(S2));
  654. // For deterministics results
  655. if Result = 0 then
  656. Result := lstrcmp(PChar(S1), PChar(S2));
  657. end;
  658. { Shortcut-handling }
  659. function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
  660. var
  661. IUnk: IUnknown;
  662. HRes: HRESULT; // OLE-Operation Result
  663. SL: IShellLink; // Interface for ShellLink
  664. PF: IPersistFile; // Interface for PersistentFile
  665. SRec: TWIN32FINDDATA; // SearchRec of targetfile
  666. TargetDir: array[1..Max_Path] of Char; // Working directory of targetfile
  667. Flags: DWORD;
  668. begin
  669. Result := '';
  670. IUnk := CreateComObject(CLSID_ShellLink);
  671. SL := IUnk as IShellLink;
  672. PF := IUnk as IPersistFile;
  673. HRes := PF.Load(PChar(SourceFile), STGM_READ);
  674. if Succeeded(Hres) then
  675. begin
  676. if not ShowDialog then Flags := SLR_NOUPDATE or (1500 shl 8) or SLR_NO_UI
  677. else Flags := SLR_NOUPDATE;
  678. HRes := SL.Resolve(Application.Handle, Flags);
  679. if Succeeded(HRes) then
  680. begin
  681. HRes := SL.GetPath(@TargetDir, MAX_PATH, SRec, {SLGP_UNCPRIORITY}{SLGP_SHORTPATH} 0);
  682. if Succeeded(HRes) then
  683. Result := string(PChar(@TargetDir));
  684. end;
  685. end;
  686. end; {ResolveShortCut}
  687. function CreateFileShortCut(SourceFile, Target, DisplayName: string;
  688. UpdateIfExists: Boolean): Boolean;
  689. var
  690. IUnk: IUnknown;
  691. Hres: HRESULT;
  692. ShellLink: IShellLink; // Interface to ShellLink
  693. IPFile: IPersistFile; // Interface to PersistentFile
  694. TargetFile: string;
  695. begin
  696. Result := False;
  697. if Target = '' then TargetFile := SourceFile + '.lnk'
  698. else TargetFile := Target;
  699. IUnk := CreateComObject(CLSID_ShellLink);
  700. ShellLink := IUnk as IShellLink;
  701. IPFile := IUnk as IPersistFile;
  702. if FileExists(ApiPath(TargetFile)) and UpdateIfExists then
  703. begin
  704. HRes := IPFile.Load(PChar(TargetFile), 0);
  705. if not Succeeded(HRes) then Exit;
  706. end;
  707. with ShellLink do
  708. begin
  709. HRes := SetPath(PChar(SourceFile));
  710. if Succeeded(HRes) then
  711. HRes := SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
  712. if Succeeded(HRes) and (DisplayName <> '') then
  713. HRes := SetDescription(PChar(DisplayName));
  714. end;
  715. if Succeeded(Hres) then
  716. begin
  717. HRes := IPFile.Save(PChar(TargetFile),False);
  718. if Succeeded(HRes) then Result := True;
  719. end;
  720. end; {CreateShortCut}
  721. function OverlayImageList(Size: Integer): TImageList;
  722. procedure GetOverlayBitmap(ImageList: TImageList; BitmapName: string);
  723. var
  724. Bitmap: TBitmap;
  725. begin
  726. Bitmap := TBitmap.Create;
  727. try
  728. Bitmap.LoadFromResourceName(hInstance, BitmapName);
  729. ImageList.AddMasked(Bitmap, Bitmap.Canvas.Pixels[0, 0]);
  730. finally
  731. Bitmap.Free;
  732. end;
  733. end; {GetOverlayBitmap}
  734. begin
  735. // Hardcoded according to sizes of overlays we have in resources
  736. if Size >= 64 then Size := 64
  737. else
  738. if Size >= 48 then Size := 48
  739. else
  740. if Size >= 40 then Size := 40
  741. else
  742. if Size >= 32 then Size := 32
  743. else
  744. if Size >= 24 then Size := 24
  745. else
  746. if Size >= 20 then Size := 20
  747. else Size := 16;
  748. Result := TImageList.CreateSize(Size, Size);
  749. Result.DrawingStyle := dsTransparent;
  750. Result.BkColor := clNone;
  751. GetOverlayBitmap(Result, Format(ResDirUp, [Size]));
  752. GetOverlayBitmap(Result, Format(ResLink, [Size]));
  753. GetOverlayBitmap(Result, Format(ResBrokenLink, [Size]));
  754. GetOverlayBitmap(Result, Format(ResPartial, [Size]));
  755. GetOverlayBitmap(Result, Format(ResEncrypted, [Size]));
  756. end;
  757. { TCustomizableDragDropFilesEx }
  758. function TCustomizableDragDropFilesEx.Execute(DataObject: TDataObject): TDragResult;
  759. begin
  760. if not Assigned(DataObject) then
  761. begin
  762. DataObject := CreateDataObject;
  763. end;
  764. Result := ExecuteOperation(DataObject);
  765. end;
  766. { TCustomDirView }
  767. constructor TCustomDirView.Create(AOwner: TComponent);
  768. begin
  769. InitFileControls;
  770. inherited;
  771. FWatchForChanges := False;
  772. FFilesSize := 0;
  773. FFilesSelSize := 0;
  774. FDimmHiddenFiles := True;
  775. FShowHiddenFiles := True;
  776. FFormatSizeBytes := fbNone;
  777. FWantUseDragImages := False;
  778. FAddParentDir := False;
  779. FullDrag := True;
  780. FInvalidNameChars := coInvalidDosChars;
  781. FHasParentDir := False;
  782. FDragOnDriveIsMove := False;
  783. FCaseSensitive := False;
  784. FIsRecycleBin := False;
  785. FLoading := False;
  786. FLoadEnabled := True;
  787. FAbortLoading := False;
  788. FDirty := False;
  789. FLastPath := '';
  790. FHistoryPath := '';
  791. FNotifyEnabled := True;
  792. FForceRename := False;
  793. FLastRenameName := '';
  794. FSavedSelection := False;
  795. FPendingFocusSomething := False;
  796. FSavedNames := TStringList.Create;
  797. FContextMenu := False;
  798. FUseSystemContextMenu := True;
  799. FStartPos.X := -1;
  800. FStartPos.Y := -1;
  801. FDragPos := FStartPos;
  802. FDragEnabled := False;
  803. FDDOwnerIsSource := False;
  804. FDDLinkOnExeDrag := False;
  805. FDragDrive := '';
  806. FExeDrag := False;
  807. FMask := '';
  808. FNaturalOrderNumericalSorting := True;
  809. FAlwaysSortDirectoriesByName := False;
  810. FDarkMode := False;
  811. FDoubleBufferedScrollingWorkaround := not IsVistaHard();
  812. FOnHistoryChange := nil;
  813. FOnPathChange := nil;
  814. FHistoryPaths := TStringList.Create;
  815. FBackCount := 0;
  816. FDontRecordPath := False;
  817. FMaxHistoryCount := DefaultHistoryCount;
  818. FStatusFileInfo.FilesCount := -1;
  819. OnCustomDrawItem := DumbCustomDrawItem;
  820. OnCustomDrawSubItem := DumbCustomDrawSubItem;
  821. FOnMatchMask := nil;
  822. FOnGetOverlay := nil;
  823. FOnGetItemColor := nil;
  824. FDragDropFilesEx := TCustomizableDragDropFilesEx.Create(Self);
  825. with FDragDropFilesEx do
  826. begin
  827. AutoDetectDnD := False;
  828. DragDetectDelta := 4;
  829. AcceptOwnDnD := True;
  830. BringToFront := True;
  831. CompleteFileList := True;
  832. NeedValid := [nvFileName];
  833. RenderDataOn := rdoEnterAndDropSync;
  834. TargetPopUpMenu := True;
  835. SourceEffects := DragSourceEffects;
  836. TargetEffects := [deCopy, deMove];
  837. OnDragEnter := DDDragEnter;
  838. OnDragLeave := DDDragLeave;
  839. OnDragOver := DDDragOver;
  840. OnDrop := DDDrop;
  841. OnQueryContinueDrag := DDQueryContinueDrag;
  842. OnSpecifyDropTarget := DDSpecifyDropTarget;
  843. OnMenuPopup := DDMenuPopup;
  844. OnMenuDestroy := DDMenuDone;
  845. OnDropHandlerSucceeded := DDDropHandlerSucceeded;
  846. OnGiveFeedback := DDGiveFeedback;
  847. OnProcessDropped := DDProcessDropped;
  848. OnDragDetect := DDDragDetect;
  849. end;
  850. FScrollOnDragOver := TListViewScrollOnDragOver.Create(Self, False);
  851. FScrollOnDragOver.OnBeforeUpdate := ScrollOnDragOverBeforeUpdate;
  852. FScrollOnDragOver.OnAfterUpdate := ScrollOnDragOverAfterUpdate;
  853. end;
  854. procedure TCustomDirView.ClearItems;
  855. begin
  856. CancelEdit;
  857. if Assigned(DropTarget) then DropTarget := nil;
  858. try
  859. inherited;
  860. finally
  861. FFilesSelSize := 0;
  862. FFilesSize := 0;
  863. DoUpdateStatusBar;
  864. end;
  865. end;
  866. procedure TCustomDirView.WMNotify(var Msg: TWMNotify);
  867. begin
  868. // This all is to make header text white in dark mode.
  869. if Msg.NMHdr.code = NM_CUSTOMDRAW then
  870. begin
  871. if DarkMode and SupportsDarkMode and
  872. GetSysDarkTheme and // When system app theme is light, headers are not dark
  873. (FHeaderHandle <> 0) and (Msg.NMHdr^.hWndFrom = FHeaderHandle) then
  874. begin
  875. with PNMLVCustomDraw(Msg.NMHdr)^ do
  876. begin
  877. if nmcd.dwDrawStage = CDDS_PREPAINT then
  878. begin
  879. inherited;
  880. Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW;
  881. end
  882. else
  883. if nmcd.dwDrawStage = CDDS_ITEMPREPAINT then
  884. begin
  885. SetTextColor(nmcd.hdc, ColorToRGB(Font.Color));
  886. Msg.Result := CDRF_DODEFAULT;
  887. inherited;
  888. end
  889. else inherited;
  890. end;
  891. end
  892. else inherited;
  893. end
  894. else inherited;
  895. end;
  896. procedure TCustomDirView.DrawThumbnail(Item: TListItem; DC: HDC);
  897. var
  898. Rect: TRect;
  899. Thumbnail: TBitmap;
  900. Size: TSize;
  901. Left, Top: Integer;
  902. BlendFunction: TBlendFunction;
  903. ThumbnailDC: HDC;
  904. begin
  905. Rect := Item.DisplayRect(drIcon);
  906. // For thumbnails: The larger side (e.g. height for portrait oriented images) is rescaled to Size.Width
  907. // For icons: The "generated" images is exactly as requested
  908. Size.Height := MulDiv(Min(Rect.Width, Rect.Height), 9, 10);
  909. Size.Width := Size.Height;
  910. Thumbnail := ItemThumbnail(Item, Size);
  911. if not Assigned(Thumbnail) then
  912. Thumbnail := FallbackThumbnail(ItemIsDirectory(Item), Size);
  913. if Assigned(Thumbnail) then
  914. begin
  915. Left := Rect.Left + ((Rect.Width - Thumbnail.Width) div 2);
  916. Top := Rect.Bottom - Thumbnail.Height - MulDiv(Rect.Height, 1, 20); // Bottom-aligned, as Explorer does
  917. // https://stackoverflow.com/q/24595717/850848
  918. // https://stackoverflow.com/q/10028531/850848#10044325
  919. ThumbnailDC := CreateCompatibleDC(0);
  920. try
  921. SelectObject(ThumbnailDC, Thumbnail.Handle);
  922. BlendFunction.BlendOp := AC_SRC_OVER;
  923. BlendFunction.BlendFlags := 0;
  924. BlendFunction.SourceConstantAlpha := 255;
  925. BlendFunction.AlphaFormat := AC_SRC_ALPHA;
  926. AlphaBlend(DC, Left, Top, Thumbnail.Width, Thumbnail.Height, ThumbnailDC, 0, 0, Thumbnail.Width, Thumbnail.Height, BlendFunction);
  927. finally
  928. DeleteDC(ThumbnailDC);
  929. end;
  930. end;
  931. end;
  932. procedure TCustomDirView.CNNotify(var Message: TWMNotify);
  933. procedure DrawOverlayImage(DC: HDC; Image: Integer; Item: TListItem);
  934. var
  935. OverlayImages: TCustomImageList;
  936. Rect: TRect;
  937. Point: TPoint;
  938. Index: Integer;
  939. begin
  940. Rect := Item.DisplayRect(drIcon);
  941. Point := Rect.TopLeft;
  942. if ViewStyle = vsIcon then
  943. begin
  944. OverlayImages := FOverlayLargeImages;
  945. end
  946. else
  947. begin
  948. OverlayImages := FOverlaySmallImages;
  949. end;
  950. // center on the rect
  951. Inc(Point.X, (Rect.Width - OverlayImages.Width) div 2);
  952. Inc(Point.Y, (Rect.Height - OverlayImages.Height) div 2);
  953. Index := 0;
  954. while Image > 1 do
  955. begin
  956. Inc(Index);
  957. Image := Image shr 1;
  958. end;
  959. if (ViewStyle <> vsReport) or
  960. (8 + OverlayImages.Width <= Columns[0].Width) then
  961. begin
  962. ImageList_Draw(OverlayImages.Handle, Index, DC, Point.X, Point.Y, ILD_TRANSPARENT);
  963. end;
  964. end;
  965. var
  966. FileSize: Int64;
  967. Item: TListItem;
  968. InfoMask: LongWord;
  969. OverlayIndex: Word;
  970. OverlayIndexes: Word;
  971. UpdateStatusBarPending: Boolean;
  972. Nmcd: PNMCustomDraw;
  973. begin
  974. UpdateStatusBarPending := False;
  975. case Message.NMHdr^.code of
  976. LVN_ITEMCHANGED:
  977. with PNMListView(Message.NMHdr)^ do
  978. if (uChanged = LVIF_STATE) and Valid and (not FClearingItems) then
  979. begin
  980. if ((uOldState and (LVIS_SELECTED or LVIS_FOCUSED)) <> (uNewState and (LVIS_SELECTED or LVIS_FOCUSED))) then
  981. begin
  982. Item := Items[iItem];
  983. UpdateStatusBarPending := True;
  984. if (uOldState and LVIS_SELECTED) <> (uNewState and LVIS_SELECTED) then
  985. begin
  986. FileSize := ItemFileSize(Item);
  987. if (uOldState and LVIS_SELECTED) <> 0 then Dec(FFilesSelSize, FileSize)
  988. else Inc(FFilesSelSize, FileSize);
  989. end;
  990. if (uOldState and LVIS_FOCUSED) <> (uNewState and LVIS_FOCUSED) then
  991. begin
  992. if Assigned(OnChangeFocus) then
  993. OnChangeFocus(Self, Item);
  994. end;
  995. end;
  996. end;
  997. LVN_ENDLABELEDIT:
  998. // enable loading now only when editing was canceled.
  999. // when it was confirmed, it will be enabled only after actual
  1000. // file renaming is completed. see Edit().
  1001. with PLVDispInfo(Message.NMHdr)^ do
  1002. if (item.pszText = nil) or (item.IItem = -1) then
  1003. LoadEnabled := True;
  1004. LVN_BEGINDRAG:
  1005. if FDragEnabled and (not Loading) then
  1006. begin
  1007. DDBeforeDrag;
  1008. DDDragDetect(MK_LBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
  1009. end;
  1010. LVN_BEGINRDRAG:
  1011. if FDragEnabled and (not Loading) then
  1012. begin
  1013. DDBeforeDrag;
  1014. DDDragDetect(MK_RBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
  1015. end;
  1016. end;
  1017. inherited;
  1018. if Message.NMHdr.code = LVN_GETDISPINFO then
  1019. begin
  1020. if FNotifyEnabled and Valid and (not Loading) then
  1021. with PLVDispInfo(Pointer(Message.NMHdr))^.Item do
  1022. try
  1023. InfoMask := PLVDispInfo(Pointer(Message.NMHdr))^.item.Mask;
  1024. if (InfoMask and LVIF_PARAM) <> 0 then Item := TListItem(lParam)
  1025. else
  1026. if iItem < Items.Count then Item := Items[iItem]
  1027. else Item := nil;
  1028. if Assigned(Item) and Assigned(Item.Data) then
  1029. GetDisplayInfo(Item, PLVDispInfo(Pointer(Message.NMHdr))^.item);
  1030. except
  1031. end;
  1032. end;
  1033. if (Message.NMHdr.code = NM_CUSTOMDRAW) and Valid and (not Loading) then
  1034. begin
  1035. Nmcd := @PNMLVCustomDraw(Message.NMHdr).nmcd;
  1036. try
  1037. if (Nmcd.dwDrawStage and CDDS_SUBITEM) = 0 then
  1038. begin
  1039. if (Nmcd.dwDrawStage and CDDS_ITEMPREPAINT) = CDDS_ITEMPREPAINT then
  1040. begin
  1041. Message.Result := Message.Result or CDRF_NOTIFYPOSTPAINT;
  1042. end
  1043. else
  1044. if ((Nmcd.dwDrawStage and CDDS_ITEMPOSTPAINT) = CDDS_ITEMPOSTPAINT) and
  1045. (Nmcd.rc.Width > 0) then // We get called many times with empty rect while view is recreating (e.g. when switching to thumnails mode)
  1046. begin
  1047. Item := Items[Nmcd.dwItemSpec];
  1048. if IsItemVisible(Item) then // particularly the thumbnail drawing is expensive
  1049. begin
  1050. if FThumbnail then
  1051. begin
  1052. DrawThumbnail(Item, Nmcd.hdc);
  1053. end
  1054. else
  1055. begin
  1056. OverlayIndexes := ItemOverlayIndexes(Item);
  1057. OverlayIndex := 1;
  1058. while OverlayIndexes > 0 do
  1059. begin
  1060. if (OverlayIndex and OverlayIndexes) <> 0 then
  1061. begin
  1062. DrawOverlayImage(Nmcd.hdc, OverlayIndex, Item);
  1063. Dec(OverlayIndexes, OverlayIndex);
  1064. end;
  1065. OverlayIndex := OverlayIndex shl 1;
  1066. end;
  1067. end;
  1068. end;
  1069. end;
  1070. end;
  1071. except
  1072. end;
  1073. end;
  1074. if UpdateStatusBarPending then DoUpdateStatusBar;
  1075. end;
  1076. function TCustomDirView.FileNameMatchesMasks(FileName: string;
  1077. Directory: Boolean; Size: Int64; Modification: TDateTime; Masks: string;
  1078. AllowImplicitMatches: Boolean): Boolean;
  1079. begin
  1080. Result := False;
  1081. if Assigned(OnMatchMask) then
  1082. OnMatchMask(Self, FileName, Directory, Size, Modification, Masks, Result, AllowImplicitMatches)
  1083. end;
  1084. procedure TCustomDirView.SetAddParentDir(Value: Boolean);
  1085. begin
  1086. if FAddParentDir <> Value then
  1087. begin
  1088. FAddParentDir := Value;
  1089. if DirOK then Reload(True);
  1090. end;
  1091. end;
  1092. procedure TCustomDirView.SetDimmHiddenFiles(Value: Boolean);
  1093. begin
  1094. if Value <> FDimmHiddenFiles then
  1095. begin
  1096. FDimmHiddenFiles := Value;
  1097. Self.Repaint;
  1098. end;
  1099. end; {SetDimmHiddenFiles}
  1100. procedure TCustomDirView.SetPathLabel(Value: TCustomPathLabel);
  1101. begin
  1102. if FPathLabel <> Value then
  1103. begin
  1104. if Assigned(FPathLabel) and (FPathLabel.FocusControl = Self) then
  1105. FPathLabel.FocusControl := nil;
  1106. FPathLabel := Value;
  1107. if Assigned(Value) then
  1108. begin
  1109. Value.FreeNotification(Self);
  1110. if not Assigned(Value.FocusControl) then
  1111. Value.FocusControl := Self;
  1112. UpdatePathLabel;
  1113. end;
  1114. end;
  1115. end; { SetPathLabel }
  1116. procedure TCustomDirView.SetShowHiddenFiles(Value: Boolean);
  1117. begin
  1118. if ShowHiddenFiles <> Value then
  1119. begin
  1120. FShowHiddenFiles := Value;
  1121. if DirOK then Reload(False);
  1122. end;
  1123. end;
  1124. procedure TCustomDirView.SetFormatSizeBytes(Value: TFormatBytesStyle);
  1125. begin
  1126. if Value <> FFormatSizeBytes then
  1127. begin
  1128. FFormatSizeBytes := Value;
  1129. Self.Repaint;
  1130. end;
  1131. end; {SetFormatSizeBytes}
  1132. function TCustomDirView.GetDragSourceEffects: TDropEffectSet;
  1133. begin
  1134. Result := [deCopy, deMove, deLink];
  1135. end;
  1136. function TCustomDirView.GetUseDragImages: Boolean;
  1137. begin
  1138. Result := FWantUseDragImages;
  1139. end;
  1140. procedure TCustomDirView.SetTargetPopupMenu(Value: Boolean);
  1141. begin
  1142. if Assigned(FDragDropFilesEx) then FDragDropFilesEx.TargetPopupMenu := Value;
  1143. end;
  1144. function TCustomDirView.NeedImageList(Size: TImageListSize; Recreate: Boolean; var OverlayImages: TImageList): TImageList;
  1145. begin
  1146. Result := ShellImageListForControl(Self, Size);
  1147. if (not Assigned(OverlayImages)) or Recreate then
  1148. begin
  1149. FreeAndNil(OverlayImages);
  1150. OverlayImages := OverlayImageList(Result.Width);
  1151. end;
  1152. end;
  1153. procedure TCustomDirView.NeedImageLists(Recreate: Boolean);
  1154. var
  1155. ALargeImages: TImageList;
  1156. ThumbnailSize: Integer;
  1157. begin
  1158. SmallImages := NeedImageList(ilsSmall, Recreate, FOverlaySmallImages);
  1159. ALargeImages := NeedImageList(ilsLarge, Recreate, FOverlayLargeImages);
  1160. if FThumbnail then
  1161. begin
  1162. ThumbnailSize := ScaleByPixelsPerInch(128, Self);
  1163. // ShellImageListForSize would normally prefer smaller icons (for row sizing purposes).
  1164. // But for thumbnails, we prefer larger version as will will scale it when painting.
  1165. // The *2 is hackish way to achieve that.
  1166. FThumbnailShellImages := ShellImageListForSize(ThumbnailSize * 2);
  1167. if (not Assigned(FThumbnailImages)) or (FThumbnailImages.Width <> ThumbnailSize) then
  1168. begin
  1169. if Assigned(FThumbnailImages) then
  1170. FreeAndNil(FThumbnailImages);
  1171. // Dummy image list, whose sole purpose it to autosize the items in the view
  1172. FThumbnailImages := TImageList.CreateSize(ThumbnailSize, ThumbnailSize);
  1173. end;
  1174. LargeImages := FThumbnailImages
  1175. end
  1176. else LargeImages := ALargeImages;
  1177. end;
  1178. procedure TCustomDirView.CMDPIChanged(var Message: TMessage);
  1179. begin
  1180. inherited;
  1181. NeedImageLists(True);
  1182. end;
  1183. const
  1184. RequiredStyles = LVS_EX_DOUBLEBUFFER or LVS_EX_TRANSPARENTBKGND;
  1185. procedure TCustomDirView.CMEnabledChanged(var Message: TMessage);
  1186. var
  1187. ListViewStyle: DWORD;
  1188. begin
  1189. inherited;
  1190. // We need this so that we can control background color of disabled file panel for dark theme.
  1191. // See comment in LVMSetExtendedListViewStyle for an explanation.
  1192. ListViewStyle := ListView_GetExtendedListViewStyle(Handle);
  1193. if Enabled then
  1194. begin
  1195. ListView_SetExtendedListViewStyle(Handle, (ListViewStyle or RequiredStyles));
  1196. end
  1197. else
  1198. begin
  1199. ListView_SetExtendedListViewStyle(Handle, (ListViewStyle and (not RequiredStyles)));
  1200. end;
  1201. end;
  1202. procedure TCustomDirView.FreeImageLists;
  1203. begin
  1204. FreeAndNil(FOverlaySmallImages);
  1205. FreeAndNil(FOverlayLargeImages);
  1206. FreeAndNil(FThumbnailImages);
  1207. SmallImages := nil;
  1208. LargeImages := nil;
  1209. end;
  1210. procedure TCustomDirView.WMThemeChanged(var Message: TMessage);
  1211. begin
  1212. if SupportsDarkMode then // To reduce impact
  1213. begin
  1214. UpdateDarkMode;
  1215. RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
  1216. end;
  1217. inherited;
  1218. end;
  1219. procedure TCustomDirView.UpdateDarkMode;
  1220. begin
  1221. if SupportsDarkMode then // To reduce impact
  1222. begin
  1223. AllowDarkModeForWindow(Self, DarkMode);
  1224. if FHeaderHandle <> 0 then
  1225. begin
  1226. AllowDarkModeForWindow(FHeaderHandle, DarkMode);
  1227. SendMessage(FHeaderHandle, WM_THEMECHANGED, 0, 0);
  1228. end;
  1229. end;
  1230. end;
  1231. procedure TCustomDirView.CreateWnd;
  1232. begin
  1233. inherited;
  1234. if Assigned(PopupMenu) then
  1235. PopupMenu.Autopopup := False;
  1236. FDragDropFilesEx.DragDropControl := Self;
  1237. if SupportsDarkMode then
  1238. begin
  1239. // This enables dark mode - List view itself supports dark mode somewhat even in the our 'Explorer' theme.
  1240. // The 'ItemsView' has better (Explorer-like) dark mode selection color, but on the other hand it does not have dark scrollbars.
  1241. // win32-darkmode has ugly fix for that (FixDarkScrollBar), which we do not want to employ.
  1242. // The 'DarkMode_Explorer' uses the standard selection color (bright blue).
  1243. // Enables dark headers:
  1244. SetWindowTheme(FHeaderHandle, 'ItemsView', nil);
  1245. if DarkMode then UpdateDarkMode;
  1246. end;
  1247. NeedImageLists(False);
  1248. end;
  1249. procedure TCustomDirView.LVMSetExtendedListViewStyle(var Message: TMessage);
  1250. // Only TWinControl.DoubleBuffered actually prevents flicker
  1251. // on Win7 when moving mouse over list view, not LVS_EX_DOUBLEBUFFER.
  1252. // But LVS_EX_DOUBLEBUFFER brings nice alpha blended marquee selection.
  1253. // Double buffering introduces artefacts when scrolling using
  1254. // keyboard (Page-up/Down). This gets fixed by LVS_EX_TRANSPARENTBKGND,
  1255. // but that works on Vista and newer only. See WMKeyDown
  1256. // for workaround on earlier systems.
  1257. begin
  1258. // This prevents TCustomListView.ResetExStyles resetting our styles
  1259. if Enabled and
  1260. (Message.WParam = 0) and
  1261. ((Message.LParam and RequiredStyles) <> RequiredStyles) then
  1262. begin
  1263. ListView_SetExtendedListViewStyle(Handle, Message.LParam or RequiredStyles);
  1264. end
  1265. else
  1266. begin
  1267. inherited;
  1268. end;
  1269. end;
  1270. procedure TCustomDirView.DestroyWnd;
  1271. begin
  1272. // to force drag&drop re-registration when recreating handle
  1273. // (occurs when changing ViewStyle)
  1274. FDragDropFilesEx.DragDropControl := nil;
  1275. inherited;
  1276. end;
  1277. procedure TCustomDirView.CMRecreateWnd(var Message: TMessage);
  1278. var
  1279. HadHandle: Boolean;
  1280. begin
  1281. HadHandle := HandleAllocated;
  1282. inherited;
  1283. // See comment in TCustomDriveView.CMRecreateWnd
  1284. if HadHandle then
  1285. begin
  1286. HandleNeeded;
  1287. end;
  1288. end;
  1289. function TCustomDirView.DoItemColor(Item: TListItem): TColor;
  1290. var
  1291. Precision: TDateTimePrecision;
  1292. begin
  1293. Result := clDefaultItemColor;
  1294. if Assigned(OnGetItemColor) then
  1295. begin
  1296. OnGetItemColor(Self, ItemFullFileName(Item), ItemIsDirectory(Item), ItemFileSize(Item), ItemFileTime(Item, Precision), Result);
  1297. end;
  1298. end;
  1299. procedure TCustomDirView.DoCustomDrawItem(Item: TListItem; Stage: TCustomDrawStage);
  1300. var
  1301. Color: TColor;
  1302. begin
  1303. if (Item <> nil) and (Stage = cdPrePaint) then
  1304. begin
  1305. Color := DoItemColor(Item);
  1306. if Color = clDefaultItemColor then Color := ItemColor(Item);
  1307. if (Color <> clDefaultItemColor) and
  1308. (Canvas.Font.Color <> Color) then
  1309. begin
  1310. Canvas.Font.Color := Color;
  1311. end;
  1312. end;
  1313. end;
  1314. function TCustomDirView.CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  1315. Stage: TCustomDrawStage): Boolean;
  1316. begin
  1317. DoCustomDrawItem(Item, Stage);
  1318. Result := inherited CustomDrawItem(Item, State, Stage);
  1319. end;
  1320. function TCustomDirView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  1321. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
  1322. begin
  1323. DoCustomDrawItem(Item, Stage);
  1324. Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
  1325. end;
  1326. procedure TCustomDirView.Delete(Item: TListItem);
  1327. begin
  1328. if Assigned(Item) then
  1329. begin
  1330. // This causes access violation when size is stored in structure
  1331. // pointed by TListItem->Data and this structure is not valid any more
  1332. if Valid then Dec(FFilesSize, ItemFileSize(Item));
  1333. inherited Delete(Item);
  1334. end;
  1335. end;
  1336. destructor TCustomDirView.Destroy;
  1337. begin
  1338. Assert(not FSavedSelection);
  1339. FreeAndNil(FScrollOnDragOver);
  1340. FreeAndNil(FSavedNames);
  1341. FreeAndNil(FHistoryPaths);
  1342. FreeAndNil(FDragDropFilesEx);
  1343. FreeImageLists;
  1344. FreeThumbnails;
  1345. inherited;
  1346. end;
  1347. procedure TCustomDirView.SelectFiles(Filter: TFileFilter; Select: Boolean);
  1348. var
  1349. Item: TListItem;
  1350. Index: Integer;
  1351. OldCursor: TCursor;
  1352. begin
  1353. Assert(Valid);
  1354. OldCursor := Screen.Cursor;
  1355. Items.BeginUpdate;
  1356. BeginSelectionUpdate;
  1357. try
  1358. Screen.Cursor := crHourGlass;
  1359. for Index := 0 to Items.Count-1 do
  1360. begin
  1361. Item := Items[Index];
  1362. Assert(Assigned(Item));
  1363. if (GetItemSelectedByIndex(Index) <> Select) and
  1364. ItemMatchesFilter(Item, Filter) then
  1365. SetItemSelectedByIndex(Index, Select);
  1366. end;
  1367. finally
  1368. Screen.Cursor := OldCursor;
  1369. Items.EndUpdate;
  1370. EndSelectionUpdate;
  1371. end;
  1372. end;
  1373. function TCustomDirView.DragCompleteFileList: Boolean;
  1374. begin
  1375. Result := (MarkedCount <= 100) and (not IsRecycleBin);
  1376. end;
  1377. procedure TCustomDirView.DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  1378. begin
  1379. end;
  1380. procedure TCustomDirView.DumbCustomDrawSubItem(Sender: TCustomListView;
  1381. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  1382. var DefaultDraw: Boolean);
  1383. begin
  1384. end;
  1385. function TCustomDirView.GetTargetPopupMenu: Boolean;
  1386. begin
  1387. if Assigned(FDragDropFilesEx) then Result := FDragDropFilesEx.TargetPopupMenu
  1388. else Result := True;
  1389. end;
  1390. procedure TCustomDirView.SetMultiSelect(Value: Boolean);
  1391. begin
  1392. if Value <> MultiSelect then
  1393. begin
  1394. inherited SetMultiSelect(Value);
  1395. if not (csLoading in ComponentState) and Assigned(ColProperties) then
  1396. begin
  1397. ColProperties.RecreateColumns;
  1398. SetColumnImages;
  1399. if DirOK then Reload(True);
  1400. end;
  1401. end;
  1402. end;
  1403. function TCustomDirView.GetValid: Boolean;
  1404. begin
  1405. Result := (not (csDestroying in ComponentState)) and
  1406. (not Loading) and (not FClearingItems);
  1407. end;
  1408. function TCustomDirView.ItemCanDrag(Item: TListItem): Boolean;
  1409. begin
  1410. Result := (not ItemIsParentDirectory(Item));
  1411. end;
  1412. function TCustomDirView.ItemColor(Item: TListItem): TColor;
  1413. begin
  1414. Result := clDefaultItemColor;
  1415. end;
  1416. function TCustomDirView.ItemThumbnail(Item: TListItem; Size: TSize): TBitmap;
  1417. begin
  1418. Result := nil;
  1419. end;
  1420. function TCustomDirView.GetThumbnail(Path: string; Size: TSize): TBitmap;
  1421. var
  1422. ImageFactory: IShellItemImageFactory;
  1423. X, Y: Integer;
  1424. Row: PRGBQuadArray;
  1425. Pixel: PRGBQuad;
  1426. Alpha: Byte;
  1427. Handle: HBITMAP;
  1428. begin
  1429. Result := nil;
  1430. SHCreateItemFromParsingName(PChar(Path), nil, IShellItemImageFactory, ImageFactory);
  1431. if Assigned(ImageFactory) then
  1432. begin
  1433. if Succeeded(ImageFactory.GetImage(Size, SIIGBF_RESIZETOFIT, Handle)) then
  1434. begin
  1435. Result := TBitmap.Create;
  1436. try
  1437. Result.Handle := Handle;
  1438. Result.PixelFormat := pf32bit;
  1439. for Y := 0 to Result.Height - 1 do
  1440. begin
  1441. Row := Result.ScanLine[Y];
  1442. for X := 0 to Result.Width - 1 do
  1443. begin
  1444. Pixel := @Row[X];
  1445. Alpha := Pixel.rgbReserved;
  1446. Pixel.rgbBlue := (Pixel.rgbBlue * Alpha) div 255;
  1447. Pixel.rgbGreen := (Pixel.rgbGreen * Alpha) div 255;
  1448. Pixel.rgbRed := (Pixel.rgbRed * Alpha) div 255;
  1449. end;
  1450. end;
  1451. except
  1452. Result.Free;
  1453. raise;
  1454. end;
  1455. end;
  1456. ImageFactory := nil; // Redundant?
  1457. end;
  1458. end;
  1459. procedure TCustomDirView.FreeThumbnails;
  1460. begin
  1461. FreeAndNil(FFallbackThumbnail[True]);
  1462. FreeAndNil(FFallbackThumbnail[False]);
  1463. end;
  1464. function TCustomDirView.FallbackThumbnail(Dir: Boolean; Size: TSize): TBitmap;
  1465. var
  1466. FallbackPath: string;
  1467. Existed: Boolean;
  1468. Index: Integer;
  1469. begin
  1470. Result := nil;
  1471. try
  1472. if FFallbackThumbnailSize <> Size then
  1473. begin
  1474. FreeThumbnails;
  1475. end;
  1476. if not Assigned(FFallbackThumbnail[Dir]) then
  1477. begin
  1478. Index := 1;
  1479. repeat
  1480. FallbackPath := TPath.Combine(TempDir, 'default.' + IntToStr(Index) + '.thumbnailimage');
  1481. Existed := FileExists(FallbackPath) or DirectoryExists(FallbackPath);
  1482. if not Existed then
  1483. begin
  1484. if Dir then
  1485. CreateDir(FallbackPath)
  1486. else
  1487. TFile.WriteAllText(FallbackPath, '');
  1488. end;
  1489. Inc(Index);
  1490. until not Existed;
  1491. FFallbackThumbnailSize := Size;
  1492. FFallbackThumbnail[Dir] := GetThumbnail(FallbackPath, Size);
  1493. if Existed then
  1494. begin
  1495. if Dir then
  1496. RemoveDir(FallbackPath)
  1497. else
  1498. DeleteFile(FallbackPath);
  1499. end;
  1500. end;
  1501. Result := FFallbackThumbnail[Dir];
  1502. except
  1503. end;
  1504. end;
  1505. function TCustomDirView.GetFilesMarkedSize: Int64;
  1506. begin
  1507. if SelCount > 0 then Result := FilesSelSize
  1508. else
  1509. if Assigned(ItemFocused) then Result := ItemFileSize(ItemFocused)
  1510. else Result := 0;
  1511. end;
  1512. function TCustomDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1513. begin
  1514. Result := False;
  1515. end;
  1516. function TCustomDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1517. begin
  1518. Result := oiNoOverlay;
  1519. if Assigned(OnGetOverlay) then
  1520. OnGetOverlay(Self, Item, Result);
  1521. end;
  1522. function TCustomDirView.IsItemVisible(Item: TListItem): Boolean;
  1523. begin
  1524. Result := (ListView_IsItemVisible(Handle, Item.Index) <> 0);
  1525. end;
  1526. procedure TCustomDirView.WMKeyDown(var Message: TWMKeyDown);
  1527. begin
  1528. if DoubleBuffered and (Message.CharCode in [VK_PRIOR, VK_NEXT]) and
  1529. FDoubleBufferedScrollingWorkaround then
  1530. begin
  1531. // WORKAROUND
  1532. // When scrolling with double-buffering enabled, ugly artefacts
  1533. // are shown temporarily.
  1534. // LVS_EX_TRANSPARENTBKGND fixes it on Vista and newer
  1535. SendMessage(Handle, WM_SETREDRAW, 0, 0);
  1536. try
  1537. inherited;
  1538. finally
  1539. SendMessage(Handle, WM_SETREDRAW, 1, 0);
  1540. end;
  1541. Repaint;
  1542. end
  1543. else
  1544. begin
  1545. inherited;
  1546. end;
  1547. end;
  1548. procedure TCustomDirView.DoDisplayPropertiesMenu;
  1549. begin
  1550. if not IsBusy then
  1551. DisplayPropertiesMenu;
  1552. end;
  1553. procedure TCustomDirView.DoExecute(Item: TListItem; ForceEnter: Boolean);
  1554. begin
  1555. BusyOperation(procedure begin Execute(Item, ForceEnter); end);
  1556. end;
  1557. procedure TCustomDirView.DoExecuteParentDirectory;
  1558. begin
  1559. BusyOperation(ExecuteParentDirectory);
  1560. end;
  1561. procedure TCustomDirView.CNKeyDown(var Message: TWMKeyDown);
  1562. begin
  1563. // Prevent Backspace being handled via "Parent directory" command in the context menu.
  1564. // We want it handled here in KeyDown
  1565. // (among other as the mechanism there makes sure it works differently while incrementally searching).
  1566. if Message.CharCode <> VK_BACK then
  1567. begin
  1568. inherited;
  1569. end;
  1570. end;
  1571. procedure TCustomDirView.KeyDown(var Key: Word; Shift: TShiftState);
  1572. var
  1573. AKey: Word;
  1574. begin
  1575. if Valid and (not IsEditing) and (not Loading) then
  1576. begin
  1577. if (Key = VK_RETURN) or
  1578. ((Key = VK_NEXT) and (ssCtrl in Shift)) then
  1579. begin
  1580. if Assigned(ItemFocused) then
  1581. begin
  1582. AKey := Key;
  1583. Key := 0;
  1584. if (AKey = VK_RETURN) and (Shift = [ssAlt]) then DoDisplayPropertiesMenu
  1585. else
  1586. if (AKey <> VK_RETURN) or (Shift = []) then DoExecute(ItemFocused, (AKey <> VK_RETURN));
  1587. end;
  1588. end
  1589. else
  1590. if ((Key = VK_BACK) or ((Key = VK_PRIOR) and (ssCtrl in Shift))) and
  1591. (not IsRoot) then
  1592. begin
  1593. inherited;
  1594. // If not handled in TCustomScpExplorerForm::DirViewKeyDown
  1595. if Key <> 0 then
  1596. begin
  1597. Key := 0;
  1598. DoExecuteParentDirectory;
  1599. end;
  1600. end
  1601. else
  1602. if ((Key = VK_UP) and (ssAlt in Shift)) and
  1603. (not IsRoot) then
  1604. begin
  1605. Key := 0;
  1606. // U+25D8 is 'INVERSE BULLET', what is glyph representing '\x8' (or '\b')
  1607. // ('up' key is the '8' key on numeric pad)
  1608. // We could obtain the value programatically using
  1609. // MultiByteToWideChar(CP_OEMCP, MB_USEGLYPHCHARS, "\x8", 1, ...)
  1610. FNextCharToIgnore := $25D8;
  1611. DoExecuteParentDirectory;
  1612. end
  1613. else
  1614. if (Key = 220 { backslash }) and (ssCtrl in Shift) and (not IsRoot) then
  1615. begin
  1616. Key := 0;
  1617. BusyOperation(ExecuteRootDirectory);
  1618. end
  1619. else
  1620. if (Key = VK_LEFT) and (ssAlt in Shift) then
  1621. begin
  1622. if BackCount >= 1 then DoHistoryGo(-1);
  1623. end
  1624. else
  1625. if (Key = VK_RIGHT) and (ssAlt in Shift) then
  1626. begin
  1627. if ForwardCount >= 1 then DoHistoryGo(1);
  1628. end
  1629. else
  1630. begin
  1631. inherited;
  1632. end;
  1633. end
  1634. else
  1635. begin
  1636. inherited;
  1637. end;
  1638. end;
  1639. procedure TCustomDirView.KeyPress(var Key: Char);
  1640. begin
  1641. if IsEditing and (Pos(Key, FInvalidNameChars) <> 0) Then
  1642. begin
  1643. Beep;
  1644. Key := #0;
  1645. end;
  1646. inherited;
  1647. end;
  1648. procedure TCustomDirView.DisplayContextMenuInSitu;
  1649. var
  1650. R: TRect;
  1651. P: TPoint;
  1652. begin
  1653. if Assigned(ItemFocused) then
  1654. begin
  1655. R := ItemFocused.DisplayRect(drIcon);
  1656. P.X := (R.Left + R.Right) div 2;
  1657. P.Y := (R.Top + R.Bottom) div 2;
  1658. end
  1659. else
  1660. begin
  1661. P.X := 0;
  1662. P.Y := 0;
  1663. end;
  1664. P := ClientToScreen(P);
  1665. DisplayContextMenu(P);
  1666. end;
  1667. procedure TCustomDirView.KeyUp(var Key: Word; Shift: TShiftState);
  1668. var
  1669. P: TPoint;
  1670. begin
  1671. if Key = VK_APPS then
  1672. begin
  1673. if (not Loading) and (not IsBusy) then
  1674. begin
  1675. if MarkedCount > 0 then
  1676. begin
  1677. DisplayContextMenuInSitu;
  1678. end
  1679. else
  1680. if Assigned(PopupMenu) then
  1681. begin
  1682. P.X := 0;
  1683. P.Y := 0;
  1684. P := ClientToScreen(P);
  1685. PopupMenu.Popup(P.X, P.Y);
  1686. end;
  1687. end;
  1688. end
  1689. else
  1690. inherited KeyUp(Key, Shift);
  1691. end;
  1692. procedure TCustomDirView.SetWatchForChanges(Value: Boolean);
  1693. begin
  1694. if FWatchForChanges <> Value then
  1695. FWatchForChanges := Value;
  1696. end;
  1697. function TCustomDirView.TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean;
  1698. begin
  1699. Assert(Assigned(DragDropFilesEx) and Assigned(Item));
  1700. Result :=
  1701. DragDropFilesEx.TargetHasDropHandler(nil, ItemFullFileName(Item), Effect);
  1702. if Assigned(OnDDTargetHasDropHandler) then
  1703. begin
  1704. OnDDTargetHasDropHandler(Self, Item, Effect, Result);
  1705. end;
  1706. end;
  1707. procedure TCustomDirView.UpdatePathLabelCaption;
  1708. begin
  1709. PathLabel.Caption := PathName;
  1710. // Do not display mask on otherwise empty label (i.e. on a disconnected remote panel)
  1711. if PathLabel.Caption <> '' then PathLabel.Mask := Mask
  1712. else PathLabel.Mask := '';
  1713. end;
  1714. procedure TCustomDirView.UpdatePathLabel;
  1715. begin
  1716. if Assigned(PathLabel) then
  1717. begin
  1718. if csDesigning in ComponentState then
  1719. begin
  1720. PathLabel.Caption := PathLabel.Name;
  1721. PathLabel.Mask := '';
  1722. end
  1723. else
  1724. begin
  1725. UpdatePathLabelCaption;
  1726. end;
  1727. PathLabel.UpdateStatus;
  1728. end;
  1729. end; { UpdatePathLabel }
  1730. procedure TCustomDirView.DoUpdateStatusBar(Force: Boolean);
  1731. var
  1732. StatusFileInfo: TStatusFileInfo;
  1733. begin
  1734. if (FUpdatingSelection = 0) and Assigned(OnUpdateStatusBar) then
  1735. begin
  1736. with StatusFileInfo do
  1737. begin
  1738. SelectedSize := FilesSelSize;
  1739. FilesSize := Self.FilesSize;
  1740. SelectedCount := SelCount;
  1741. FilesCount := Self.FilesCount;
  1742. HiddenCount := Self.HiddenCount;
  1743. FilteredCount := Self.FilteredCount;
  1744. end;
  1745. if Force or (not CompareMem(@StatusFileInfo, @FStatusFileInfo, SizeOf(StatusFileInfo))) then
  1746. begin
  1747. FStatusFileInfo := StatusFileInfo;
  1748. OnUpdateStatusBar(Self, FStatusFileInfo);
  1749. end;
  1750. end;
  1751. end; { UpdateStatusBar }
  1752. procedure TCustomDirView.UpdateStatusBar;
  1753. begin
  1754. DoUpdateStatusBar(True);
  1755. end;
  1756. procedure TCustomDirView.WMContextMenu(var Message: TWMContextMenu);
  1757. var
  1758. Point: TPoint;
  1759. begin
  1760. FDragEnabled := False;
  1761. if Assigned(PopupMenu) then
  1762. PopupMenu.AutoPopup := False;
  1763. //inherited;
  1764. if FContextMenu and (not Loading) then
  1765. begin
  1766. Point.X := Message.XPos;
  1767. Point.Y := Message.YPos;
  1768. Point := ScreenToClient(Point);
  1769. if Assigned(OnMouseDown) then
  1770. begin
  1771. OnMouseDown(Self, mbRight, [], Point.X, Point.Y);
  1772. end;
  1773. if FUseSystemContextMenu and Assigned(ItemFocused) and
  1774. (GetItemAt(Point.X, Point.Y) = ItemFocused) then
  1775. begin
  1776. Point.X := Message.XPos;
  1777. Point.Y := Message.YPos;
  1778. DisplayContextMenu(Point);
  1779. end
  1780. else
  1781. if Assigned(PopupMenu) and (not PopupMenu.AutoPopup) then
  1782. begin
  1783. PopupMenu.Popup(Message.XPos, Message.YPos);
  1784. end;
  1785. end;
  1786. FContextMenu := False;
  1787. //inherited;
  1788. end;
  1789. function TCustomDirView.EnableDragOnClick: Boolean;
  1790. begin
  1791. Result := (not Loading) and inherited EnableDragOnClick;
  1792. end;
  1793. procedure TCustomDirView.WMLButtonDown(var Message: TWMLButtonDown);
  1794. begin
  1795. GetCursorPos(FStartPos);
  1796. FDragEnabled := EnableDragOnClick;
  1797. inherited;
  1798. end;
  1799. procedure TCustomDirView.WMRButtonDown(var Message: TWMRButtonDown);
  1800. begin
  1801. GetCursorPos(FStartPos);
  1802. if FDragDropFilesEx.DragDetectStatus <> ddsDrag then
  1803. FDragEnabled := EnableDragOnClick;
  1804. FContextMenu := True;
  1805. inherited;
  1806. end;
  1807. procedure TCustomDirView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1808. begin
  1809. inherited;
  1810. if Assigned(ItemFocused) and (not Loading) and
  1811. (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) then
  1812. begin
  1813. if GetKeyState(VK_MENU) < 0 then DoDisplayPropertiesMenu
  1814. else DoExecute(ItemFocused, False);
  1815. end;
  1816. end;
  1817. procedure TCustomDirView.WMLButtonUp(var Message: TWMLButtonUp);
  1818. begin
  1819. FDragEnabled := False;
  1820. inherited;
  1821. end;
  1822. procedure TCustomDirView.WMXButtonUp(var Message: TWMXMouse);
  1823. begin
  1824. if Message.Button = _XBUTTON1 then
  1825. begin
  1826. if BackCount >= 1 then DoHistoryGo(-1);
  1827. Message.Result := 1;
  1828. end
  1829. else
  1830. if Message.Button = _XBUTTON2 then
  1831. begin
  1832. if ForwardCount >= 1 then DoHistoryGo(1);
  1833. Message.Result := 1;
  1834. end;
  1835. end;
  1836. procedure TCustomDirView.CancelEdit;
  1837. begin
  1838. // - Do nothing when handle is not allocated (we cannot be editing anyway
  1839. // without a handle), otherwise this causes handle allocation,
  1840. // what is wrong particularly when we are called from ClearItems
  1841. // when we are being destroyed
  1842. // - If editing, it has to be focused item
  1843. if HandleAllocated and IsEditing and Assigned(ItemFocused) then
  1844. begin
  1845. ItemFocused.CancelEdit;
  1846. FLoadEnabled := True;
  1847. end;
  1848. end;
  1849. procedure TCustomDirView.Reload(CacheIcons: Boolean);
  1850. var
  1851. OldSelection: TStringList;
  1852. OldItemFocused: string;
  1853. OldFocusedShown: Boolean;
  1854. OldShownItemOffset: Integer;
  1855. Index: Integer;
  1856. FoundIndex: Integer;
  1857. IconCache: TStringList;
  1858. Item: TListItem;
  1859. ItemToFocus: TListItem;
  1860. FileName: string;
  1861. R: TRect;
  1862. P: TPoint;
  1863. begin
  1864. if Path <> '' then
  1865. begin
  1866. CancelEdit;
  1867. OldSelection := nil;
  1868. IconCache := nil;
  1869. Items.BeginUpdate;
  1870. try
  1871. OldSelection := TStringList.Create;
  1872. OldSelection.CaseSensitive := FCaseSensitive;
  1873. if CacheIcons then
  1874. IconCache := TStringList.Create;
  1875. for Index := 0 to Items.Count-1 do
  1876. begin
  1877. Item := Items[Index];
  1878. // cannot use ItemFileName as for TUnixDirView the file object
  1879. // is no longer valid
  1880. FileName := Item.Caption;
  1881. if GetItemSelectedByIndex(Index) then
  1882. OldSelection.Add(FileName);
  1883. if CacheIcons and (ItemImageIndex(Item, True) >= 0) then
  1884. IconCache.AddObject(FileName, TObject(ItemImageIndex(Item, True)));
  1885. end;
  1886. if FSelectFile <> '' then
  1887. begin
  1888. OldItemFocused := FSelectFile;
  1889. OldFocusedShown := False;
  1890. OldShownItemOffset := -1;
  1891. FSelectFile := '';
  1892. end
  1893. else
  1894. begin
  1895. if Assigned(ItemFocused) then
  1896. begin
  1897. if ViewStyle = vsReport then
  1898. begin
  1899. if Assigned(TopItem) then
  1900. begin
  1901. R := ItemFocused.DisplayRect(drBounds);
  1902. if (R.Top < TopItem.DisplayRect(drBounds).Top) or (R.Top > ClientHeight) then
  1903. begin
  1904. OldFocusedShown := False;
  1905. OldShownItemOffset := TopItem.Index;
  1906. end
  1907. else
  1908. begin
  1909. OldFocusedShown := True;
  1910. OldShownItemOffset := ItemFocused.Index - TopItem.Index;
  1911. end;
  1912. end
  1913. else
  1914. begin
  1915. // seen with one user only
  1916. OldFocusedShown := False;
  1917. OldShownItemOffset := 0;
  1918. end;
  1919. end
  1920. else
  1921. begin
  1922. // to satisfy compiler, never used
  1923. OldFocusedShown := False;
  1924. OldShownItemOffset := -1;
  1925. end;
  1926. OldItemFocused := ItemFocused.Caption;
  1927. end
  1928. else
  1929. begin
  1930. OldItemFocused := '';
  1931. OldFocusedShown := False;
  1932. if Assigned(TopItem) then OldShownItemOffset := TopItem.Index
  1933. else OldShownItemOffset := -1;
  1934. end;
  1935. end;
  1936. Load(False);
  1937. OldSelection.Sort;
  1938. if CacheIcons then IconCache.Sort;
  1939. ItemToFocus := nil;
  1940. for Index := 0 to Items.Count - 1 do
  1941. begin
  1942. Item := Items[Index];
  1943. FileName := ItemFileName(Item);
  1944. if FileName = OldItemFocused then
  1945. ItemToFocus := Item;
  1946. if OldSelection.Find(FileName, FoundIndex) then
  1947. SetItemSelectedByIndex(Index, True);
  1948. if CacheIcons and (ItemImageIndex(Item, True) < 0) then
  1949. begin
  1950. FoundIndex := IconCache.IndexOf(FileName);
  1951. if FoundIndex >= 0 then
  1952. SetItemImageIndex(Item, Integer(IconCache.Objects[FoundIndex]));
  1953. end;
  1954. end;
  1955. finally
  1956. Items.EndUpdate;
  1957. OldSelection.Free;
  1958. if CacheIcons then IconCache.Free;
  1959. end;
  1960. // This is below Items.EndUpdate(), to make Scroll() work properly
  1961. if Assigned(ItemToFocus) then
  1962. begin
  1963. // we have found item that was previously focused and visible, scroll to it
  1964. if (ViewStyle = vsReport) and OldFocusedShown and
  1965. (ItemToFocus.Index > OldShownItemOffset) then
  1966. begin
  1967. P := Items[ItemToFocus.Index - OldShownItemOffset].GetPosition;
  1968. // GetPosition is shifted bit low below actual row top.
  1969. // Scroll to the GetPosition would scroll one line lower.
  1970. Scroll(0, P.Y - Items[0].GetPosition.Y);
  1971. end;
  1972. // Strangely after this mouse selection works correctly, so we do not have to call FocusItem.
  1973. ItemFocused := ItemToFocus;
  1974. end;
  1975. // could not scroll when focus is not visible because
  1976. // of previous call to hack-implementation of FocusItem()
  1977. // - no longer true, this can be re-enabled after some testing
  1978. {$IF False}
  1979. // previously focus item was not visible, scroll to the same position
  1980. // as before
  1981. if (ViewStyle = vsReport) and (not OldFocusedShown) and
  1982. (OldShownItemOffset >= 0) and (Items.Count > 0) then
  1983. begin
  1984. if OldShownItemOffset < Items.Count - VisibleRowCount then
  1985. Scroll(0, OldShownItemOffset)
  1986. else
  1987. Items.Item[Items.Count - 1].MakeVisible(false);
  1988. end
  1989. // do not know where to scroll to, so scroll to focus
  1990. // (or we have tried to scroll to previously focused and visible item,
  1991. // now make sute that it is really visible)
  1992. else {$IFEND}
  1993. if Assigned(ItemToFocus) then ItemToFocus.MakeVisible(false);
  1994. FocusSomething;
  1995. end;
  1996. end;
  1997. procedure TCustomDirView.Load(DoFocusSomething: Boolean);
  1998. var
  1999. SaveCursor: TCursor;
  2000. Delimiters: string;
  2001. LastDirName: string;
  2002. begin
  2003. if not FLoadEnabled or Loading then
  2004. begin
  2005. FDirty := True;
  2006. FAbortLoading := True;
  2007. end
  2008. else
  2009. begin
  2010. FLoading := True;
  2011. FInsertingNewUnselectedItem := True;
  2012. try
  2013. FHasParentDir := False;
  2014. if Assigned(FOnStartLoading) then FOnStartLoading(Self);
  2015. SaveCursor := Screen.Cursor;
  2016. Screen.Cursor := crHourGlass;
  2017. try
  2018. FNotifyEnabled := False;
  2019. ClearItems;
  2020. FFilesSize := 0;
  2021. FFilesSelSize := 0;
  2022. SortType := stNone;
  2023. Items.BeginUpdate;
  2024. try
  2025. LoadFiles;
  2026. finally
  2027. Items.EndUpdate;
  2028. end;
  2029. finally
  2030. Screen.Cursor := SaveCursor;
  2031. end;
  2032. finally
  2033. FLoading := False;
  2034. FInsertingNewUnselectedItem := False;
  2035. try
  2036. if FAbortLoading then
  2037. begin
  2038. FAbortLoading := False;
  2039. Reload(False);
  2040. end
  2041. else
  2042. begin
  2043. if DirOK then SortItems;
  2044. FAbortLoading := False;
  2045. FDirty := False;
  2046. if (Length(LastPath) > Length(PathName)) and
  2047. (Copy(LastPath, 1, Length(PathName)) = PathName) and
  2048. (Items.Count > 0) then
  2049. begin
  2050. LastDirName := Copy(LastPath, Length(PathName) + 1, MaxInt);
  2051. Delimiters := '\:/';
  2052. if IsDelimiter(Delimiters, LastDirName, 1) then
  2053. begin
  2054. LastDirName := Copy(LastDirName, 2, MaxInt);
  2055. end;
  2056. if LastDelimiter(Delimiters, LastDirName) = 0 then
  2057. begin
  2058. ItemFocused := FindFileItem(LastDirName);
  2059. end;
  2060. end;
  2061. end;
  2062. finally
  2063. // nested try .. finally block is included
  2064. // because we really want these to be executed
  2065. FNotifyEnabled := True;
  2066. if DoFocusSomething then
  2067. begin
  2068. if FAnnouncedState is TDirViewState then
  2069. begin
  2070. RestoreFocus(TDirViewState(FAnnouncedState).FocusedItem);
  2071. end;
  2072. FocusSomething;
  2073. end;
  2074. if Assigned(FOnLoaded) then
  2075. begin
  2076. FOnLoaded(Self);
  2077. end;
  2078. UpdatePathLabel;
  2079. DoUpdateStatusBar;
  2080. end;
  2081. end;
  2082. end;
  2083. end;
  2084. procedure TCustomDirView.SetLoadEnabled(Enabled: Boolean);
  2085. begin
  2086. if Enabled <> LoadEnabled then
  2087. begin
  2088. FLoadEnabled := Enabled;
  2089. if Enabled and Dirty then Reload(True);
  2090. end;
  2091. end;
  2092. function TCustomDirView.GetFilesCount: Integer;
  2093. begin
  2094. Result := Items.Count;
  2095. if (Result > 0) and HasParentDir then Dec(Result);
  2096. end;
  2097. procedure TCustomDirView.SetViewStyle(Value: TViewStyle);
  2098. begin
  2099. if (Value <> ViewStyle) and (not FLoading) then
  2100. begin
  2101. FNotifyEnabled := False;
  2102. inherited;
  2103. FNotifyEnabled := True;
  2104. // this is workaround for bug in TCustomNortonLikeListView
  2105. // that clears Items on recreating wnd (caused by change to ViewStyle)
  2106. Reload(True);
  2107. end;
  2108. end;
  2109. procedure TCustomDirView.ColClick(Column: TListColumn);
  2110. var
  2111. ScrollToFocused: Boolean;
  2112. begin
  2113. ScrollToFocused := Assigned(ItemFocused);
  2114. inherited;
  2115. if ScrollToFocused and Assigned(ItemFocused) then
  2116. ItemFocused.MakeVisible(False);
  2117. end;
  2118. procedure TCustomDirView.CustomSortItems(SortProc: Pointer);
  2119. var
  2120. SavedCursor: TCursor;
  2121. SavedNotifyEnabled: Boolean;
  2122. begin
  2123. if HandleAllocated then
  2124. begin
  2125. SavedNotifyEnabled := FNotifyEnabled;
  2126. SavedCursor := Screen.Cursor;
  2127. Items.BeginUpdate;
  2128. try
  2129. Screen.Cursor := crHourglass;
  2130. FNotifyEnabled := False;
  2131. CustomSort(TLVCompare(SortProc), Integer(Pointer(Self)));
  2132. finally
  2133. Screen.Cursor := SavedCursor;
  2134. FNotifyEnabled := SavedNotifyEnabled;
  2135. Items.EndUpdate;
  2136. ItemsReordered;
  2137. end;
  2138. end;
  2139. end;
  2140. procedure TCustomDirView.ReloadForce(CacheIcons: Boolean);
  2141. begin
  2142. FLoadEnabled := True;
  2143. FDirty := False;
  2144. Reload(CacheIcons);
  2145. end;
  2146. procedure TCustomDirView.ScrollOnDragOverBeforeUpdate(ObjectToValidate: TObject);
  2147. begin
  2148. GlobalDragImageList.HideDragImage;
  2149. end;
  2150. procedure TCustomDirView.ScrollOnDragOverAfterUpdate;
  2151. begin
  2152. GlobalDragImageList.ShowDragImage;
  2153. end;
  2154. procedure TCustomDirView.DDDragEnter(DataObj: IDataObject; grfKeyState: Longint;
  2155. Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  2156. var
  2157. Index: Integer;
  2158. begin
  2159. Accept := Accept and DirOK and (not Loading);
  2160. if Accept and
  2161. (DragDropFilesEx.FileList.Count > 0) and
  2162. (Length(TFDDListItem(DragDropFilesEx.FileList[0]^).Name) > 0) and
  2163. (not IsRecycleBin or not DragDropFilesEx.FileNamesAreMapped) then
  2164. begin
  2165. try
  2166. FDragDrive := DriveInfo.GetDriveKey(TFDDListItem(DragDropFilesEx.FileList[0]^).Name);
  2167. except
  2168. // WinRAR gives us only filename on "enter", we get a full path only on "drop".
  2169. FDragDrive := '';
  2170. end;
  2171. FExeDrag := FDDLinkOnExeDrag and
  2172. (deLink in DragDropFilesEx.TargetEffects) and
  2173. ((DragDropFilesEx.AvailableDropEffects and DROPEFFECT_LINK) <> 0);
  2174. if FExeDrag then
  2175. begin
  2176. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  2177. if not IsExecutable(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  2178. begin
  2179. FExeDrag := False;
  2180. Break;
  2181. end;
  2182. end;
  2183. end
  2184. else
  2185. begin
  2186. FDragDrive := '';
  2187. end;
  2188. FScrollOnDragOver.StartDrag;
  2189. if Assigned(FOnDDDragEnter) then
  2190. FOnDDDragEnter(Self, DataObj, grfKeyState, Point, dwEffect, Accept);
  2191. end;
  2192. procedure TCustomDirView.DDDragLeave;
  2193. begin
  2194. if Assigned(DropTarget) then
  2195. begin
  2196. if GlobalDragImageList.Dragging then
  2197. GlobalDragImageList.HideDragImage;
  2198. DropTarget := nil;
  2199. Update; {ie30}
  2200. end
  2201. else DropTarget := nil;
  2202. if Assigned(FOnDDDragLeave) then
  2203. FOnDDDragLeave(Self);
  2204. end;
  2205. procedure TCustomDirView.DDDragOver(grfKeyState: Integer; Point: TPoint;
  2206. var dwEffect: Integer; PreferredEffect: Integer);
  2207. var
  2208. DropItem: TListItem;
  2209. CanDrop: Boolean;
  2210. HasDropHandler: Boolean;
  2211. begin
  2212. FDDOwnerIsSource := DragDropFilesEx.OwnerIsSource;
  2213. {Set droptarget if target is directory:}
  2214. if not Loading then DropItem := GetItemAt(Point.X, Point.Y)
  2215. else DropItem := nil;
  2216. HasDropHandler := (Assigned(DropItem) and (not IsRecycleBin) and
  2217. TargetHasDropHandler(DropItem, dwEffect));
  2218. CanDrop := Assigned(DropItem) and (not IsRecycleBin) and
  2219. (ItemIsDirectory(DropItem) or HasDropHandler);
  2220. if (CanDrop and (DropTarget <> DropItem)) or
  2221. (not CanDrop and Assigned(DropTarget)) then
  2222. begin
  2223. if GlobalDragImageList.Dragging then
  2224. begin
  2225. GlobalDragImageList.HideDragImage;
  2226. DropTarget := nil;
  2227. Update;
  2228. if CanDrop then
  2229. begin
  2230. DropTarget := DropItem;
  2231. Update;
  2232. end;
  2233. GlobalDragImageList.ShowDragImage;
  2234. end
  2235. else
  2236. begin
  2237. DropTarget := nil;
  2238. if CanDrop then DropTarget := DropItem;
  2239. end;
  2240. end;
  2241. if not Loading then
  2242. FScrollOnDragOver.DragOver(Point);
  2243. {Set dropeffect:}
  2244. if (not HasDropHandler) and (not Loading) then
  2245. begin
  2246. DDChooseEffect(grfKeyState, dwEffect, PreferredEffect);
  2247. if Assigned(FOnDDDragOver) then
  2248. FOnDDDragOver(Self, grfKeyState, Point, dwEffect);
  2249. // cannot drop to dragged files
  2250. if DragDropFilesEx.OwnerIsSource and Assigned(DropItem) then
  2251. begin
  2252. if Assigned(ItemFocused) and (not ItemFocused.Selected) then
  2253. begin
  2254. if DropItem = ItemFocused then
  2255. begin
  2256. dwEffect := DROPEFFECT_NONE;
  2257. end;
  2258. end
  2259. else
  2260. if DropItem.Selected then
  2261. begin
  2262. dwEffect := DROPEFFECT_NONE;
  2263. end;
  2264. end;
  2265. if DragDropFilesEx.OwnerIsSource and (dwEffect = DROPEFFECT_MOVE) and
  2266. (not Assigned(DropTarget)) then
  2267. begin
  2268. dwEffect := DROPEFFECT_NONE;
  2269. end
  2270. else
  2271. if Assigned(DropTarget) and ItemIsRecycleBin(DropTarget) and
  2272. (dwEffect <> DROPEFFECT_NONE) then
  2273. begin
  2274. dwEffect := DROPEFFECT_MOVE;
  2275. end;
  2276. end;
  2277. end;
  2278. function TCustomDirView.ItemData(Item: TListItem): TObject;
  2279. begin
  2280. Result := nil;
  2281. end;
  2282. function TCustomDirView.OperateOnFocusedFile(Focused, OnlyFocused: Boolean): Boolean;
  2283. begin
  2284. Result :=
  2285. Assigned(ItemFocused) and
  2286. ((Focused and (not ItemFocused.Selected)) or (SelCount = 0) or OnlyFocused);
  2287. end;
  2288. function TCustomDirView.CustomCreateFileList(Focused, OnlyFocused: Boolean;
  2289. FullPath: Boolean; FileList: TStrings; ItemObject: Boolean): TStrings;
  2290. procedure AddItem(Item: TListItem);
  2291. var
  2292. AObject: TObject;
  2293. begin
  2294. Assert(Assigned(Item));
  2295. if ItemObject then AObject := Item
  2296. else AObject := ItemData(Item);
  2297. if FullPath then Result.AddObject(ItemFullFileName(Item), AObject)
  2298. else Result.AddObject(ItemFileName(Item), AObject);
  2299. end;
  2300. var
  2301. Item: TListItem;
  2302. begin
  2303. if Assigned(FileList) then Result := FileList
  2304. else Result := TStringList.Create;
  2305. try
  2306. if OperateOnFocusedFile(Focused, OnlyFocused) then
  2307. begin
  2308. AddItem(ItemFocused)
  2309. end
  2310. else
  2311. begin
  2312. Item := GetNextItem(nil, sdAll, [isSelected]);
  2313. while Assigned(Item) do
  2314. begin
  2315. AddItem(Item);
  2316. Item := GetNextItem(Item, sdAll, [isSelected]);
  2317. end;
  2318. end;
  2319. except
  2320. if not Assigned(FileList) then FreeAndNil(Result);
  2321. raise;
  2322. end;
  2323. end;
  2324. function TCustomDirView.CreateFocusedFileList(FullPath: Boolean; FileList: TStrings): TStrings;
  2325. begin
  2326. Result := CustomCreateFileList(False, True, FullPath, FileList);
  2327. end;
  2328. function TCustomDirView.CreateFileList(Focused: Boolean; FullPath: Boolean;
  2329. FileList: TStrings; ItemObject: Boolean): TStrings;
  2330. begin
  2331. Result := CustomCreateFileList(Focused, False, FullPath, FileList, ItemObject);
  2332. end;
  2333. procedure TCustomDirView.DDDrop(DataObj: IDataObject; grfKeyState: Integer;
  2334. Point: TPoint; var dwEffect: Integer);
  2335. begin
  2336. if GlobalDragImageList.Dragging then
  2337. GlobalDragImageList.HideDragImage;
  2338. if dwEffect = DROPEFFECT_NONE then
  2339. DropTarget := nil;
  2340. if Assigned(OnDDDrop) then
  2341. OnDDDrop(Self, DataObj, grfKeyState, Point, dwEffect);
  2342. end;
  2343. procedure TCustomDirView.DDQueryContinueDrag(FEscapePressed: LongBool;
  2344. grfKeyState: Integer; var Result: HResult);
  2345. var
  2346. MousePos: TPoint;
  2347. KnowTime: TFileTime;
  2348. begin
  2349. // this method cannot throw exceptions, if it does d&d will not be possible
  2350. // anymore (see TDragDrop.ExecuteOperation, global GInternalSource)
  2351. if Result = DRAGDROP_S_DROP then
  2352. begin
  2353. GetSystemTimeAsFileTime(KnowTime);
  2354. if ((Int64(KnowTime) - Int64(FDragStartTime)) <= DDDragStartDelay) then
  2355. Result := DRAGDROP_S_CANCEL;
  2356. end;
  2357. if Assigned(OnDDQueryContinueDrag) then
  2358. begin
  2359. OnDDQueryContinueDrag(Self, FEscapePressed, grfKeyState, Result);
  2360. end;
  2361. try
  2362. if FEscapePressed then
  2363. begin
  2364. if GlobalDragImageList.Dragging then
  2365. GlobalDragImageList.HideDragImage;
  2366. end
  2367. else
  2368. begin
  2369. if GlobalDragImageList.Dragging Then
  2370. begin
  2371. MousePos := ParentForm.ScreenToClient(Mouse.CursorPos);
  2372. {Move the drag image to the new position and show it:}
  2373. if (MousePos.X <> FDragPos.X) or (MousePos.Y <> FDragPos.Y) then
  2374. begin
  2375. FDragPos := MousePos;
  2376. if PtInRect(ParentForm.BoundsRect, Mouse.CursorPos) then
  2377. begin
  2378. GlobalDragImageList.DragMove(MousePos.X, MousePos.Y);
  2379. GlobalDragImageList.ShowDragImage;
  2380. end
  2381. else GlobalDragImageList.HideDragImage;
  2382. end;
  2383. end;
  2384. end;
  2385. except
  2386. // do not care if the above fails
  2387. // (Mouse.CursorPos fails when desktop is locked by user)
  2388. end;
  2389. end;
  2390. procedure TCustomDirView.DDSpecifyDropTarget(Sender: TObject;
  2391. DragDropHandler: Boolean; Point: TPoint; var pidlFQ: PItemIDList;
  2392. var Filename: string);
  2393. var
  2394. Item: TListItem;
  2395. begin
  2396. pidlFQ := nil;
  2397. if DirOK and (not Loading) then
  2398. begin
  2399. if DragDropHandler then
  2400. begin
  2401. if Assigned(DropTarget) and ItemIsDirectory(DropTarget) then
  2402. FileName := ItemFullFileName(DropTarget)
  2403. else
  2404. FileName := PathName;
  2405. end
  2406. else
  2407. begin
  2408. Item := GetItemAt(Point.X, Point.Y);
  2409. if Assigned(Item) and (not ItemIsDirectory(Item)) and
  2410. (not IsRecycleBin) then
  2411. FileName := ItemFullFileName(Item)
  2412. else
  2413. FileName := '';
  2414. end;
  2415. end
  2416. else FileName := '';
  2417. end;
  2418. procedure TCustomDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu;
  2419. DataObj: IDataObject; AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  2420. begin
  2421. end;
  2422. procedure TCustomDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  2423. begin
  2424. end;
  2425. procedure TCustomDirView.DDDropHandlerSucceeded(Sender: TObject;
  2426. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  2427. begin
  2428. DropTarget := nil;
  2429. end;
  2430. procedure TCustomDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer);
  2431. begin
  2432. if Assigned(FOnDDChooseEffect) then
  2433. FOnDDChooseEffect(Self, grfKeyState, dwEffect);
  2434. end;
  2435. procedure TCustomDirView.DDGiveFeedback(dwEffect: Integer;
  2436. var Result: HResult);
  2437. begin
  2438. if Assigned(FOnDDGiveFeedback) then
  2439. FOnDDGiveFeedback(Self, dwEffect, Result);
  2440. end;
  2441. procedure TCustomDirView.DDProcessDropped(Sender: TObject;
  2442. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  2443. begin
  2444. if DirOK and (not Loading) then
  2445. try
  2446. try
  2447. if Assigned(FOnDDProcessDropped) then
  2448. FOnDDProcessDropped(Self, grfKeyState, Point, dwEffect);
  2449. if dwEffect <> DROPEFFECT_NONE then
  2450. begin
  2451. PerformItemDragDropOperation(DropTarget, dwEffect, False);
  2452. if Assigned(FOnDDExecuted) then
  2453. FOnDDExecuted(Self, dwEffect);
  2454. end;
  2455. finally
  2456. DragDropFilesEx.FileList.Clear;
  2457. DropTarget := nil;
  2458. end;
  2459. except
  2460. Application.HandleException(Self);
  2461. end;
  2462. end;
  2463. function TCustomDirView.AnyFileSelected(
  2464. OnlyFocused: Boolean; FilesOnly: Boolean; FocusedFileOnlyWhenFocused: Boolean): Boolean;
  2465. var
  2466. Item: TListItem;
  2467. begin
  2468. if OnlyFocused or
  2469. ((SelCount = 0) and
  2470. ((not FocusedFileOnlyWhenFocused) or
  2471. (Focused and (GetParentForm(Self).Handle = GetForegroundWindow())))) then
  2472. begin
  2473. Result := Assigned(ItemFocused) and ItemIsFile(ItemFocused) and
  2474. ((not FilesOnly) or (not ItemIsDirectory(ItemFocused)));
  2475. end
  2476. else
  2477. begin
  2478. Result := True;
  2479. Item := GetNextItem(nil, sdAll, [isSelected]);
  2480. while Assigned(Item) do
  2481. begin
  2482. if ItemIsFile(Item) and
  2483. ((not FilesOnly) or (not ItemIsDirectory(Item))) then Exit;
  2484. Item := GetNextItem(Item, sdAll, [isSelected]);
  2485. end;
  2486. Result := False;
  2487. end;
  2488. end;
  2489. function TCustomDirView.CanEdit(Item: TListItem): Boolean;
  2490. begin
  2491. Result :=
  2492. (inherited CanEdit(Item) or FForceRename) and (not Loading) and
  2493. Assigned(Item) and (not ReadOnly) and (not IsRecycleBin) and
  2494. (not ItemIsParentDirectory(Item));
  2495. if Result then FLoadEnabled := False;
  2496. FForceRename := False;
  2497. end;
  2498. function TCustomDirView.CanChangeSelection(Item: TListItem;
  2499. Select: Boolean): Boolean;
  2500. begin
  2501. Result :=
  2502. (not Loading) and
  2503. not (Assigned(Item) and Assigned(Item.Data) and
  2504. ItemIsParentDirectory(Item));
  2505. end;
  2506. procedure TCustomDirView.Edit(const HItem: TLVItem);
  2507. var
  2508. Info: string;
  2509. Index: Integer;
  2510. begin
  2511. // When rename is confirmed by clicking outside of the edit box, and the actual rename operation
  2512. // displays error message or simply pumps a message queue (like during lenghty remote directory reload),
  2513. // drag mouse selection start. It posssibly happens only on the remote panel due to it being completely reloaded.
  2514. ReleaseCapture;
  2515. if Length(HItem.pszText) = 0 then LoadEnabled := True
  2516. else
  2517. begin
  2518. {Does the changed filename contains invalid characters?}
  2519. if StrContains(FInvalidNameChars, HItem.pszText) then
  2520. begin
  2521. Info := FInvalidNameChars;
  2522. for Index := Length(Info) downto 1 do
  2523. System.Insert(Space, Info, Index);
  2524. MessageBeep(MB_ICONHAND);
  2525. if MessageDlg(SErrorInvalidName + Space + Info, mtError,
  2526. [mbOK, mbAbort], 0) = mrOK then RetryRename(HItem.pszText);
  2527. LoadEnabled := True;
  2528. end
  2529. else
  2530. begin
  2531. InternalEdit(HItem);
  2532. end;
  2533. end;
  2534. end; {Edit}
  2535. procedure TCustomDirView.EndSelectionUpdate;
  2536. begin
  2537. inherited;
  2538. if FUpdatingSelection = 0 then
  2539. DoUpdateStatusBar;
  2540. end; { EndUpdatingSelection }
  2541. procedure TCustomDirView.ExecuteCurrentFile;
  2542. begin
  2543. Assert(Assigned(ItemFocused));
  2544. Execute(ItemFocused, False);
  2545. end;
  2546. function TCustomDirView.DoExecFile(Item: TListItem; ForceEnter: Boolean): Boolean;
  2547. begin
  2548. Result := True;
  2549. if Assigned(FOnExecFile) then FOnExecFile(Self, Item, Result);
  2550. end;
  2551. procedure TCustomDirView.Execute(Item: TListItem; ForceEnter: Boolean);
  2552. begin
  2553. Assert(Assigned(Item));
  2554. if Assigned(Item) and Assigned(Item.Data) and (not Loading) then
  2555. begin
  2556. if IsRecycleBin and (not ItemIsParentDirectory(Item)) then DisplayPropertiesMenu
  2557. else
  2558. if DoExecFile(Item, ForceEnter) then
  2559. begin
  2560. if ItemIsParentDirectory(Item) then ExecuteParentDirectory
  2561. else ExecuteFile(Item);
  2562. end;
  2563. end;
  2564. end;
  2565. procedure TCustomDirView.GetDisplayInfo(ListItem: TListItem;
  2566. var DispInfo: TLVItem);
  2567. begin
  2568. // Nothing
  2569. end;
  2570. procedure TCustomDirView.WMUserRename(var Message: TMessage);
  2571. var
  2572. Dummy: Boolean;
  2573. begin
  2574. if Assigned(ItemFocused) then
  2575. begin
  2576. FForceRename := True;
  2577. ListView_EditLabel(Handle, ItemFocused.Index);
  2578. SetWindowText(ListView_GetEditControl(Self.Handle),
  2579. PChar(FLastRenameName));
  2580. // This was called already by VCL.
  2581. // But we do it again for the base-name selection side effect this has in TCustomScpExplorerForm::DirViewEditing,
  2582. // after we have updated the text above.
  2583. if Assigned(OnEditing) then
  2584. OnEditing(Self, ItemFocused, Dummy);
  2585. end;
  2586. end;
  2587. procedure TCustomDirView.RetryRename(NewName: string);
  2588. begin
  2589. FLastRenameName := NewName;
  2590. PostMessage(Self.Handle, WM_USER_RENAME, Longint(PChar(NewName)), 0);
  2591. end;
  2592. procedure TCustomDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2593. begin
  2594. FileList.AddItem(nil, ItemFullFileName(Item));
  2595. end;
  2596. procedure TCustomDirView.DDDragDetect(grfKeyState: Integer; DetectStart,
  2597. Point: TPoint; DragStatus: TDragDetectStatus);
  2598. var
  2599. FilesCount: Integer;
  2600. DirsCount: Integer;
  2601. Item: TListItem;
  2602. FirstItem : TListItem;
  2603. Bitmap: TBitmap;
  2604. ImageListHandle: HImageList;
  2605. Spot: TPoint;
  2606. ItemPos: TPoint;
  2607. DragText: string;
  2608. ClientPoint: TPoint;
  2609. FileListCreated: Boolean;
  2610. AvoidDragImage: Boolean;
  2611. DataObject: TDataObject;
  2612. begin
  2613. if Assigned(FOnDDDragDetect) then
  2614. FOnDDDragDetect(Self, grfKeyState, DetectStart, Point, DragStatus);
  2615. FLastDDResult := drCancelled;
  2616. if (DragStatus = ddsDrag) and (not Loading) and (MarkedCount > 0) then
  2617. begin
  2618. DragDropFilesEx.CompleteFileList := DragCompleteFileList;
  2619. DragDropFilesEx.FileList.Clear;
  2620. FirstItem := nil;
  2621. FilesCount := 0;
  2622. DirsCount := 0;
  2623. FileListCreated := False;
  2624. AvoidDragImage := False;
  2625. if Assigned(OnDDCreateDragFileList) then
  2626. begin
  2627. OnDDCreateDragFileList(Self, DragDropFilesEx.FileList, FileListCreated);
  2628. if FileListCreated then
  2629. begin
  2630. AvoidDragImage := True;
  2631. end;
  2632. end;
  2633. if not FileListCreated then
  2634. begin
  2635. if Assigned(ItemFocused) and (not ItemFocused.Selected) then
  2636. begin
  2637. if ItemCanDrag(ItemFocused) then
  2638. begin
  2639. FirstItem := ItemFocused;
  2640. AddToDragFileList(DragDropFilesEx.FileList, ItemFocused);
  2641. if ItemIsDirectory(ItemFocused) then Inc(DirsCount)
  2642. else Inc(FilesCount);
  2643. end;
  2644. end
  2645. else
  2646. if SelCount > 0 then
  2647. begin
  2648. Item := GetNextItem(nil, sdAll, [isSelected]);
  2649. while Assigned(Item) do
  2650. begin
  2651. if ItemCanDrag(Item) then
  2652. begin
  2653. if not Assigned(FirstItem) then FirstItem := Item;
  2654. AddToDragFileList(DragDropFilesEx.FileList, Item);
  2655. if ItemIsDirectory(Item) then Inc(DirsCount)
  2656. else Inc(FilesCount);
  2657. end;
  2658. Item := GetNextItem(Item, sdAll, [isSelected]);
  2659. end;
  2660. end;
  2661. end;
  2662. if DragDropFilesEx.FileList.Count > 0 then
  2663. begin
  2664. FDragEnabled := False;
  2665. {Create the dragimage:}
  2666. GlobalDragImageList := DragImageList;
  2667. // This code is not used anymore
  2668. if UseDragImages and (not AvoidDragImage) then
  2669. begin
  2670. ImageListHandle := ListView_CreateDragImage(Handle, FirstItem.Index, Spot);
  2671. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2672. if ImageListHandle <> Invalid_Handle_Value then
  2673. begin
  2674. GlobalDragImageList.Handle := ImageListHandle;
  2675. if FilesCount + DirsCount = 1 then
  2676. begin
  2677. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2678. GlobalDragImageList.SetDragImage(0,
  2679. DetectStart.X - ItemPos.X, DetectStart.Y - ItemPos.Y);
  2680. end
  2681. else
  2682. begin
  2683. GlobalDragImageList.Clear;
  2684. GlobalDragImageList.Width := 32;
  2685. GlobalDragImageList.Height := 32;
  2686. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES', 0,
  2687. [lrTransparent], $FFFFFF) Then
  2688. begin
  2689. Bitmap := TBitmap.Create;
  2690. try
  2691. try
  2692. GlobalDragImageList.GetBitmap(0, Bitmap);
  2693. Bitmap.Canvas.Font.Assign(Self.Font);
  2694. DragText := '';
  2695. if FilesCount > 0 then
  2696. DragText := Format(STextFiles, [FilesCount]);
  2697. if DirsCount > 0 then
  2698. begin
  2699. if FilesCount > 0 then
  2700. DragText := DragText + ', ';
  2701. DragText := DragText + Format(STextDirectories, [DirsCount]);
  2702. end;
  2703. Bitmap.Width := 33 + Bitmap.Canvas.TextWidth(DragText);
  2704. Bitmap.TransparentMode := tmAuto;
  2705. Bitmap.Canvas.TextOut(33,
  2706. Max(24 - Abs(Canvas.Font.Height), 0), DragText);
  2707. GlobalDragImageList.Clear;
  2708. GlobalDragImageList.Width := Bitmap.Width;
  2709. GlobalDragImageList.AddMasked(Bitmap,
  2710. Bitmap.Canvas.Pixels[0, 0]);
  2711. GlobalDragImageList.SetDragImage(0, 25, 20);
  2712. except
  2713. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES',
  2714. 0, [lrTransparent], $FFFFFF) then
  2715. GlobalDragImageList.SetDragImage(0, 25, 20);
  2716. end;
  2717. finally
  2718. Bitmap.Free;
  2719. end;
  2720. end;
  2721. end;
  2722. ClientPoint := ParentForm.ScreenToClient(Point);
  2723. GlobalDragImageList.BeginDrag(ParentForm.Handle,
  2724. ClientPoint.X, ClientPoint.Y);
  2725. GlobalDragImageList.HideDragImage;
  2726. ShowCursor(True);
  2727. end;
  2728. end;
  2729. FContextMenu := False;
  2730. if IsRecycleBin then DragDropFilesEx.SourceEffects := [deMove]
  2731. else DragDropFilesEx.SourceEffects := DragSourceEffects;
  2732. DropSourceControl := Self;
  2733. try
  2734. GetSystemTimeAsFileTime(FDragStartTime);
  2735. DataObject := nil;
  2736. if Assigned(OnDDCreateDataObject) then
  2737. begin
  2738. OnDDCreateDataObject(Self, DataObject);
  2739. end;
  2740. {Execute the drag&drop-Operation:}
  2741. FLastDDResult := DragDropFilesEx.Execute(DataObject);
  2742. // The drag&drop operation is finished, so clean up the used drag image.
  2743. // This also restores the default mouse cursor
  2744. // (which is set to "none" in GlobalDragImageList.BeginDrag above)
  2745. // But it's actually too late, we would need to do it when mouse button
  2746. // is realesed already. Otherwise the cursor is hidden when hovering over
  2747. // main window, while target application is processing dropped file
  2748. // (particularly when Explorer displays progress window or
  2749. // overwrite confirmation prompt)
  2750. GlobalDragImageList.EndDrag;
  2751. GlobalDragImageList.Clear;
  2752. Application.ProcessMessages;
  2753. finally
  2754. DragDropFilesEx.FileList.Clear;
  2755. FContextMenu := False;
  2756. try
  2757. if Assigned(OnDDEnd) then
  2758. OnDDEnd(Self);
  2759. finally
  2760. DropTarget := nil;
  2761. DropSourceControl := nil;
  2762. end;
  2763. end;
  2764. end;
  2765. end;
  2766. end;
  2767. procedure TCustomDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2768. begin
  2769. inherited;
  2770. if Operation = opRemove then
  2771. begin
  2772. if AComponent = PathLabel then FPathLabel := nil;
  2773. end;
  2774. end; { Notification }
  2775. procedure TCustomDirView.WMAppCommand(var Message: TMessage);
  2776. var
  2777. Command: Integer;
  2778. Shift: TShiftState;
  2779. begin
  2780. Command := HiWord(Message.lParam) and (not FAPPCOMMAND_MASK);
  2781. Shift := KeyDataToShiftState(HiWord(Message.lParam) and FAPPCOMMAND_MASK);
  2782. if Shift * [ssShift, ssAlt, ssCtrl] = [] then
  2783. begin
  2784. if Command = APPCOMMAND_BROWSER_BACKWARD then
  2785. begin
  2786. Message.Result := 1;
  2787. if BackCount >= 1 then DoHistoryGo(-1);
  2788. end
  2789. else
  2790. if Command = APPCOMMAND_BROWSER_FORWARD then
  2791. begin
  2792. Message.Result := 1;
  2793. if ForwardCount >= 1 then DoHistoryGo(1);
  2794. end
  2795. else
  2796. if Command = APPCOMMAND_BROWSER_REFRESH then
  2797. begin
  2798. Message.Result := 1;
  2799. BusyOperation(ReloadDirectory);
  2800. end
  2801. else
  2802. if Command = APPCOMMAND_BROWSER_HOME then
  2803. begin
  2804. Message.Result := 1;
  2805. BusyOperation(ExecuteHomeDirectory);
  2806. end
  2807. else inherited;
  2808. end
  2809. else inherited;
  2810. end;
  2811. procedure TCustomDirView.CMColorChanged(var Message: TMessage);
  2812. begin
  2813. inherited;
  2814. ForceColorChange(Self);
  2815. end;
  2816. function TCustomDirView.FindFileItem(FileName: string): TListItem;
  2817. type
  2818. TFileNameCompare = function(const S1, S2: string): Integer;
  2819. var
  2820. Index: Integer;
  2821. CompareFunc: TFileNameCompare;
  2822. begin
  2823. if FCaseSensitive then CompareFunc := CompareStr
  2824. else CompareFunc := CompareText;
  2825. // Optimization to avoid duplicate lookups in consequent RestoreFocus calls from Load and RestoreState.
  2826. if Assigned(ItemFocused) and (CompareFunc(FileName, ItemFileName(ItemFocused)) = 0) then
  2827. begin
  2828. Result := ItemFocused;
  2829. Exit;
  2830. end
  2831. else
  2832. begin
  2833. for Index := 0 to Items.Count - 1 do
  2834. begin
  2835. if CompareFunc(FileName, ItemFileName(Items[Index])) = 0 then
  2836. begin
  2837. Result := Items[Index];
  2838. Exit;
  2839. end;
  2840. end;
  2841. end;
  2842. Result := nil;
  2843. end;
  2844. function TCustomDirView.GetForwardCount: Integer;
  2845. begin
  2846. Result := FHistoryPaths.Count - BackCount;
  2847. end; { GetForwardCount }
  2848. procedure TCustomDirView.LimitHistorySize;
  2849. begin
  2850. while FHistoryPaths.Count > MaxHistoryCount do
  2851. begin
  2852. if BackCount > 0 then
  2853. begin
  2854. FHistoryPaths.Delete(0);
  2855. Dec(FBackCount);
  2856. end
  2857. else
  2858. FHistoryPaths.Delete(FHistoryPaths.Count-1);
  2859. end;
  2860. end; { LimitHistorySize }
  2861. function TCustomDirView.GetHistoryPath(Index: Integer): string;
  2862. begin
  2863. Assert(Assigned(FHistoryPaths));
  2864. if Index = 0 then Result := PathName
  2865. else
  2866. if Index < 0 then Result := FHistoryPaths[Index + BackCount]
  2867. else
  2868. if Index > 0 then Result := FHistoryPaths[Index + BackCount - 1];
  2869. end; { GetHistoryPath }
  2870. procedure TCustomDirView.SetMaxHistoryCount(Value: Integer);
  2871. begin
  2872. if FMaxHistoryCount <> Value then
  2873. begin
  2874. FMaxHistoryCount := Value;
  2875. DoHistoryChange;
  2876. end;
  2877. end; { SetMaxHistoryCount }
  2878. procedure TCustomDirView.DoHistoryChange;
  2879. begin
  2880. LimitHistorySize;
  2881. if Assigned(OnHistoryChange) then
  2882. OnHistoryChange(Self);
  2883. end; { DoHistoryChange }
  2884. procedure TCustomDirView.DoHistoryGo(Index: Integer);
  2885. var
  2886. Cancel: Boolean;
  2887. begin
  2888. if StartBusy then
  2889. try
  2890. Cancel := False;
  2891. if Assigned(OnHistoryGo) then
  2892. OnHistoryGo(Self, Index, Cancel);
  2893. if not Cancel then HistoryGo(Index);
  2894. finally
  2895. EndBusy;
  2896. end;
  2897. end;
  2898. procedure TCustomDirView.HistoryGo(Index: Integer);
  2899. var
  2900. PrevPath: string;
  2901. begin
  2902. if Index <> 0 then
  2903. begin
  2904. PrevPath := FHistoryPath;
  2905. FDontRecordPath := True;
  2906. try
  2907. Path := HistoryPath[Index];
  2908. finally
  2909. FDontRecordPath := False;
  2910. end;
  2911. FHistoryPaths.Insert(FBackCount, PrevPath);
  2912. FHistoryPaths.Delete(Index + BackCount);
  2913. Inc(FBackCount, Index);
  2914. DoHistoryChange;
  2915. end;
  2916. end; { HistoryGo }
  2917. procedure TCustomDirView.PathChanging(Relative: Boolean);
  2918. begin
  2919. if Relative then FLastPath := PathName
  2920. else FLastPath := '';
  2921. FSavedNames.Clear;
  2922. end;
  2923. procedure TCustomDirView.PathChanged;
  2924. var
  2925. Index: Integer;
  2926. begin
  2927. if Assigned(OnPathChange) then
  2928. OnPathChange(Self);
  2929. if (not FDontRecordPath) and (FHistoryPath <> '') and (FHistoryPath <> PathName) then
  2930. begin
  2931. Assert(Assigned(FHistoryPaths));
  2932. for Index := FHistoryPaths.Count - 1 downto BackCount do
  2933. FHistoryPaths.Delete(Index);
  2934. FHistoryPaths.Add(FHistoryPath);
  2935. Inc(FBackCount);
  2936. DoHistoryChange;
  2937. end;
  2938. FHistoryPath := PathName;
  2939. end; { PathChanged }
  2940. procedure TCustomDirView.ProcessChangedFiles(DirView: TCustomDirView;
  2941. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  2942. Criterias: TCompareCriterias);
  2943. var
  2944. Item, MirrorItem: TListItem;
  2945. FileTime, MirrorFileTime: TDateTime;
  2946. OldCursor: TCursor;
  2947. Index: Integer;
  2948. Changed: Boolean;
  2949. SameTime: Boolean;
  2950. Precision, MirrorPrecision: TDateTimePrecision;
  2951. begin
  2952. Assert(Valid);
  2953. OldCursor := Screen.Cursor;
  2954. if not Assigned(FileList) then
  2955. begin
  2956. Items.BeginUpdate;
  2957. BeginSelectionUpdate;
  2958. end;
  2959. try
  2960. Screen.Cursor := crHourGlass;
  2961. for Index := 0 to Items.Count-1 do
  2962. begin
  2963. Item := Items[Index];
  2964. Changed := False;
  2965. if not ItemIsDirectory(Item) then
  2966. begin
  2967. MirrorItem := DirView.FindFileItem(ItemFileName(Item));
  2968. if MirrorItem = nil then
  2969. begin
  2970. Changed := not ExistingOnly;
  2971. end
  2972. else
  2973. begin
  2974. if ccTime in Criterias then
  2975. begin
  2976. FileTime := ItemFileTime(Item, Precision);
  2977. MirrorFileTime := DirView.ItemFileTime(MirrorItem, MirrorPrecision);
  2978. if MirrorPrecision < Precision then Precision := MirrorPrecision;
  2979. if Precision <> tpMillisecond then
  2980. begin
  2981. ReduceDateTimePrecision(FileTime, Precision);
  2982. ReduceDateTimePrecision(MirrorFileTime, Precision);
  2983. end;
  2984. SameTime := (FileTime = MirrorFileTime);
  2985. if Precision = tpSecond then
  2986. begin
  2987. // 1 ms more solves the rounding issues
  2988. // (see also Common.cpp)
  2989. MirrorFileTime := MirrorFileTime + EncodeTime(0, 0, 1, 1);
  2990. end;
  2991. Changed :=
  2992. (FileTime > MirrorFileTime);
  2993. end
  2994. else
  2995. begin
  2996. SameTime := True;
  2997. end;
  2998. if (not Changed) and SameTime and (ccSize in Criterias) then
  2999. begin
  3000. Changed := ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem);
  3001. end
  3002. end;
  3003. end;
  3004. if Assigned(FileList) then
  3005. begin
  3006. if Changed then
  3007. begin
  3008. if FullPath then
  3009. begin
  3010. FileList.AddObject(ItemFullFileName(Item), Item.Data)
  3011. end
  3012. else
  3013. begin
  3014. FileList.AddObject(ItemFileName(Item), Item.Data);
  3015. end;
  3016. end;
  3017. end
  3018. else
  3019. begin
  3020. Item.Selected := Changed;
  3021. end;
  3022. end;
  3023. finally
  3024. Screen.Cursor := OldCursor;
  3025. if not Assigned(FileList) then
  3026. begin
  3027. Items.EndUpdate;
  3028. EndSelectionUpdate;
  3029. end;
  3030. end;
  3031. end;
  3032. function TCustomDirView.CreateChangedFileList(DirView: TCustomDirView;
  3033. FullPath: Boolean; ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  3034. begin
  3035. Result := TStringList.Create;
  3036. try
  3037. ProcessChangedFiles(DirView, Result, FullPath, ExistingOnly, Criterias);
  3038. except
  3039. FreeAndNil(Result);
  3040. raise;
  3041. end;
  3042. end;
  3043. function TCustomDirView.CanPasteFromClipBoard: Boolean;
  3044. begin
  3045. Result := False;
  3046. if DirOK and (Path <> '') and Windows.OpenClipboard(0) then
  3047. begin
  3048. Result := IsClipboardFormatAvailable(CF_HDROP);
  3049. Windows.CloseClipBoard;
  3050. end;
  3051. end; {CanPasteFromClipBoard}
  3052. procedure TCustomDirView.CompareFiles(DirView: TCustomDirView;
  3053. ExistingOnly: Boolean; Criterias: TCompareCriterias);
  3054. begin
  3055. ProcessChangedFiles(DirView, nil, True, ExistingOnly, Criterias);
  3056. end;
  3057. function TCustomDirView.GetColumnText(ListItem: TListItem; Index: Integer): string;
  3058. var
  3059. DispInfo: TLVItem;
  3060. begin
  3061. FillChar(DispInfo, SizeOf(DispInfo), 0);
  3062. DispInfo.Mask := LVIF_TEXT;
  3063. DispInfo.iSubItem := Index;
  3064. DispInfo.cchTextMax := 260;
  3065. SetLength(Result, DispInfo.cchTextMax);
  3066. DispInfo.pszText := PChar(Result);
  3067. GetDisplayInfo(ListItem, DispInfo);
  3068. SetLength(Result, StrLen(PChar(Result)));
  3069. end;
  3070. procedure TCustomDirView.FocusSomething;
  3071. begin
  3072. if FSavedSelection then FPendingFocusSomething := True
  3073. else inherited;
  3074. end;
  3075. procedure TCustomDirView.SaveSelection;
  3076. var
  3077. Closest: TListItem;
  3078. begin
  3079. Assert(not FSavedSelection);
  3080. FSavedSelectionFile := '';
  3081. FSavedSelectionLastFile := '';
  3082. if Assigned(ItemFocused) then
  3083. begin
  3084. FSavedSelectionLastFile := ItemFocused.Caption;
  3085. end;
  3086. Closest := ClosestUnselected(ItemFocused);
  3087. if Assigned(Closest) then
  3088. begin
  3089. FSavedSelectionFile := Closest.Caption;
  3090. end;
  3091. FSavedSelection := True;
  3092. end;
  3093. procedure TCustomDirView.RestoreSelection;
  3094. var
  3095. ItemToSelect: TListItem;
  3096. begin
  3097. Assert(FSavedSelection);
  3098. FSavedSelection := False;
  3099. if (FSavedSelectionLastFile <> '') and
  3100. ((not Assigned(ItemFocused)) or
  3101. (ItemFocused.Caption <> FSavedSelectionLastFile)) then
  3102. begin
  3103. ItemToSelect := FindFileItem(FSavedSelectionFile);
  3104. if Assigned(ItemToSelect) then
  3105. begin
  3106. ItemFocused := ItemToSelect;
  3107. end;
  3108. end;
  3109. if not Assigned(ItemFocused) then FocusSomething
  3110. else ItemFocused.MakeVisible(False);
  3111. end;
  3112. procedure TCustomDirView.DiscardSavedSelection;
  3113. begin
  3114. Assert(FSavedSelection);
  3115. FSavedSelection := False;
  3116. if FPendingFocusSomething then
  3117. begin
  3118. FPendingFocusSomething := False;
  3119. FocusSomething;
  3120. end;
  3121. end;
  3122. procedure TCustomDirView.SaveSelectedNames;
  3123. var
  3124. Index: Integer;
  3125. Item: TListItem;
  3126. begin
  3127. FSavedNames.Clear;
  3128. FSavedNames.CaseSensitive := FCaseSensitive;
  3129. if SelCount > 0 then // optimalisation
  3130. begin
  3131. for Index := 0 to Items.Count-1 do
  3132. begin
  3133. Item := Items[Index];
  3134. if Item.Selected then
  3135. FSavedNames.Add(ItemFileName(Item));
  3136. end;
  3137. end;
  3138. // as optimalisation the list is sorted only when the selection is restored
  3139. end;
  3140. procedure TCustomDirView.RestoreSelectedNames;
  3141. var
  3142. Index, FoundIndex: Integer;
  3143. Item: TListItem;
  3144. begin
  3145. FSavedNames.Sort;
  3146. for Index := 0 to Items.Count - 1 do
  3147. begin
  3148. Item := Items[Index];
  3149. Item.Selected := FSavedNames.Find(ItemFileName(Item), FoundIndex);
  3150. end;
  3151. end;
  3152. function TCustomDirView.GetSelectedNamesSaved: Boolean;
  3153. begin
  3154. Result := (FSavedNames.Count > 0);
  3155. end;
  3156. procedure TCustomDirView.ContinueSession(Continue: Boolean);
  3157. begin
  3158. if Continue then FLastPath := PathName
  3159. else FLastPath := '';
  3160. end;
  3161. procedure TCustomDirView.AnnounceState(AState: TObject);
  3162. begin
  3163. FAnnouncedState := AState;
  3164. end;
  3165. function TCustomDirView.SaveState: TObject;
  3166. var
  3167. State: TDirViewState;
  3168. DirColProperties: TCustomDirViewColProperties;
  3169. begin
  3170. State := TDirViewState.Create;
  3171. State.HistoryPaths := TStringList.Create;
  3172. State.HistoryPaths.Assign(FHistoryPaths);
  3173. State.BackCount := FBackCount;
  3174. // TCustomDirViewColProperties should not be here
  3175. DirColProperties := ColProperties as TCustomDirViewColProperties;
  3176. Assert(Assigned(DirColProperties));
  3177. State.SortStr := DirColProperties.SortStr;
  3178. State.Mask := Mask;
  3179. if Assigned(ItemFocused) then State.FocusedItem := ItemFocused.Caption
  3180. else State.FocusedItem := '';
  3181. Result := State;
  3182. end;
  3183. procedure TCustomDirView.RestoreFocus(FocusedItem: string);
  3184. var
  3185. ListItem: TListItem;
  3186. begin
  3187. if FocusedItem <> '' then
  3188. begin
  3189. ListItem := FindFileItem(FocusedItem);
  3190. if Assigned(ListItem) then
  3191. begin
  3192. ItemFocused := ListItem;
  3193. ListItem.MakeVisible(False);
  3194. end;
  3195. end;
  3196. end;
  3197. procedure TCustomDirView.RestoreState(AState: TObject);
  3198. var
  3199. State: TDirViewState;
  3200. DirColProperties: TCustomDirViewColProperties;
  3201. begin
  3202. if Assigned(AState) then
  3203. begin
  3204. Assert(AState is TDirViewState);
  3205. State := AState as TDirViewState;
  3206. Assert(Assigned(State));
  3207. FHistoryPaths.Assign(State.HistoryPaths);
  3208. FBackCount := State.BackCount;
  3209. DoHistoryChange;
  3210. // TCustomDirViewColProperties should not be here
  3211. DirColProperties := ColProperties as TCustomDirViewColProperties;
  3212. Assert(Assigned(DirColProperties));
  3213. DirColProperties.SortStr := State.SortStr;
  3214. Mask := State.Mask;
  3215. RestoreFocus(State.FocusedItem);
  3216. end
  3217. else
  3218. begin
  3219. FHistoryPaths.Clear;
  3220. FBackCount := 0;
  3221. DoHistoryChange;
  3222. end;
  3223. end;
  3224. procedure TCustomDirView.SetMask(Value: string);
  3225. begin
  3226. if Mask <> Value then
  3227. begin
  3228. FMask := Value;
  3229. UpdatePathLabel;
  3230. if DirOK then Reload(False);
  3231. end;
  3232. end;{SetMask}
  3233. procedure TCustomDirView.SetNaturalOrderNumericalSorting(Value: Boolean);
  3234. begin
  3235. if NaturalOrderNumericalSorting <> Value then
  3236. begin
  3237. FNaturalOrderNumericalSorting := Value;
  3238. SortItems;
  3239. end;
  3240. end;
  3241. procedure TCustomDirView.SetAlwaysSortDirectoriesByName(Value: Boolean);
  3242. begin
  3243. if AlwaysSortDirectoriesByName <> Value then
  3244. begin
  3245. FAlwaysSortDirectoriesByName := Value;
  3246. SortItems;
  3247. end;
  3248. end;
  3249. procedure TCustomDirView.SetDarkMode(Value: Boolean);
  3250. begin
  3251. if DarkMode <> Value then
  3252. begin
  3253. FDarkMode := Value;
  3254. // Call only when switching to dark more and when switching back to the light mode.
  3255. // But not for initial light mode - To reduce an impact of calling an undocumented function.
  3256. if HandleAllocated then UpdateDarkMode;
  3257. end;
  3258. end;
  3259. // WM_SETFOCUS works even when focus is moved to another window/app,
  3260. // while .Enter works only when focus is moved to other control of the same window.
  3261. procedure TCustomDirView.WMSetFocus(var Message: TWMSetFocus);
  3262. begin
  3263. inherited;
  3264. EnsureSelectionRedrawn;
  3265. UpdatePathLabel;
  3266. end;
  3267. procedure TCustomDirView.WMKillFocus(var Message: TWMKillFocus);
  3268. begin
  3269. inherited;
  3270. EnsureSelectionRedrawn;
  3271. UpdatePathLabel;
  3272. end;
  3273. procedure TCustomDirView.EnsureSelectionRedrawn;
  3274. begin
  3275. // WORKAROUND
  3276. // when receiving/losing focus, selection is not redrawn in report view
  3277. // (except for focus item selection),
  3278. // probably when double buffering is enabled (LVS_EX_DOUBLEBUFFER).
  3279. // But even without LVS_EX_DOUBLEBUFFER, selection behind file icon is not updated.
  3280. if ViewStyle = vsReport then
  3281. begin
  3282. if (SelCount >= 2) or ((SelCount >= 1) and ((not Assigned(ItemFocused)) or (not ItemFocused.Selected))) then
  3283. begin
  3284. Invalidate;
  3285. end
  3286. else
  3287. if Assigned(ItemFocused) and ItemFocused.Selected then
  3288. begin
  3289. // Optimization. When no item is selected, redraw just the focused item.
  3290. ItemFocused.Update;
  3291. end;
  3292. end;
  3293. end;
  3294. function TCustomDirView.DoBusy(Busy: Integer): Boolean;
  3295. begin
  3296. Result := True;
  3297. if Assigned(OnBusy) then
  3298. begin
  3299. OnBusy(Self, Busy, Result);
  3300. end;
  3301. end;
  3302. function TCustomDirView.StartBusy: Boolean;
  3303. begin
  3304. Result := DoBusy(1);
  3305. end;
  3306. function TCustomDirView.IsBusy: Boolean;
  3307. begin
  3308. Result := DoBusy(0);
  3309. end;
  3310. procedure TCustomDirView.EndBusy;
  3311. begin
  3312. DoBusy(-1);
  3313. end;
  3314. procedure TCustomDirView.BusyOperation(Operation: TBusyOperation);
  3315. begin
  3316. if StartBusy then
  3317. try
  3318. Operation;
  3319. finally
  3320. EndBusy;
  3321. end;
  3322. end;
  3323. procedure TCustomDirView.ItemCalculatedSizeUpdated(Item: TListItem; OldSize, NewSize: Int64);
  3324. begin
  3325. if OldSize >= 0 then
  3326. begin
  3327. Dec(FFilesSize, OldSize);
  3328. if Item.Selected then Dec(FFilesSelSize, OldSize);
  3329. end;
  3330. if NewSize >= 0 then
  3331. begin
  3332. Inc(FFilesSize, NewSize);
  3333. if Item.Selected then Inc(FFilesSelSize, NewSize);
  3334. end;
  3335. Item.Update;
  3336. UpdateStatusBar;
  3337. end;
  3338. function TCustomDirView.GetDirViewStyle: TDirViewStyle;
  3339. begin
  3340. if (ViewStyle = vsIcon) and FThumbnail then Result := dvsThumbnail
  3341. else Result := TDirViewStyle(ViewStyle);
  3342. end;
  3343. procedure TCustomDirView.SetDirViewStyle(Value: TDirViewStyle);
  3344. var
  3345. NewViewStyle: TViewStyle;
  3346. begin
  3347. if DirViewStyle <> Value then
  3348. begin
  3349. FThumbnail := (Value = dvsThumbnail);
  3350. // Create thumbnail images before recreating the view
  3351. NeedImageLists(False);
  3352. if FThumbnail then NewViewStyle := vsIcon
  3353. else NewViewStyle := TViewStyle(Value);
  3354. if ViewStyle <> NewViewStyle then
  3355. begin
  3356. ViewStyle := NewViewStyle;
  3357. end
  3358. else
  3359. begin
  3360. // Changing ViewStyle recreates the view, we want to be consistent.
  3361. if not (csLoading in ComponentState) then
  3362. RecreateWnd;
  3363. end;
  3364. end;
  3365. end;
  3366. procedure TCustomDirView.InvalidateItem(Item: TListItem);
  3367. var
  3368. R: TRect;
  3369. begin
  3370. R := Item.DisplayRect(drBounds);
  3371. // alternative to TListItem.Update (which causes flicker)
  3372. InvalidateRect(Handle, @R, True);
  3373. end;
  3374. procedure TCustomDirView.WMUserInvalidateItem(var Message: TMessage);
  3375. var
  3376. Index: Integer;
  3377. begin
  3378. Index := Integer(Message.WParam);
  3379. if (Index >= 0) and (Index < Items.Count) then
  3380. InvalidateItem(Items[Index]);
  3381. end;
  3382. initialization
  3383. DropSourceControl := nil;
  3384. SetLength(WinDir, MAX_PATH);
  3385. SetLength(WinDir, GetWindowsDirectory(PChar(WinDir), MAX_PATH));
  3386. SetLength(TempDir, MAX_PATH);
  3387. SetLength(TempDir, GetTempPath(MAX_PATH, PChar(TempDir)));
  3388. SpecialFolderLocation(CSIDL_PERSONAL, UserDocumentDirectory);
  3389. WinDir := IncludeTrailingPathDelimiter(WinDir);
  3390. TempDir := IncludeTrailingPathDelimiter(TempDir);
  3391. finalization
  3392. SetLength(StdDirTypeName, 0);
  3393. SetLength(WinDir, 0);
  3394. SetLength(TempDir, 0);
  3395. end.