CustomDirView.pas 114 KB

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