CustomDirView.pas 113 KB

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