CustomDirView.pas 108 KB

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