CustomDirView.pas 116 KB

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