CustomDirView.pas 115 KB

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