CustomDirView.pas 107 KB

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