CustomDirView.pas 107 KB

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