CustomDirView.pas 106 KB

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