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