CustomDirView.pas 105 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420
  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) and
  953. FNotifyEnabled and Valid and (not Loading) then
  954. with PLVDispInfo(Pointer(Message.NMHdr))^.Item do
  955. try
  956. InfoMask := PLVDispInfo(Pointer(Message.NMHdr))^.item.Mask;
  957. if (InfoMask and LVIF_PARAM) <> 0 then Item := TListItem(lParam)
  958. else
  959. if iItem < Items.Count then Item := Items[iItem]
  960. else Item := nil;
  961. if Assigned(Item) and Assigned(Item.Data) then
  962. GetDisplayInfo(Item, PLVDispInfo(Pointer(Message.NMHdr))^.item);
  963. except
  964. end;
  965. if (Message.NMHdr.code = NM_CUSTOMDRAW) and
  966. Valid and (not Loading) then
  967. with PNMLVCustomDraw(Message.NMHdr)^ do
  968. try
  969. Message.Result := Message.Result or CDRF_NOTIFYPOSTPAINT;
  970. if (nmcd.dwDrawStage = CDDS_ITEMPOSTPAINT) and
  971. ((nmcd.dwDrawStage and CDDS_SUBITEM) = 0) and
  972. Assigned(Columns[0]) and (Columns[0].Width > 0) then
  973. begin
  974. Assert(Assigned(Items[nmcd.dwItemSpec]));
  975. OverlayIndexes := ItemOverlayIndexes(Items[nmcd.dwItemSpec]);
  976. OverlayIndex := 1;
  977. while OverlayIndexes > 0 do
  978. begin
  979. if (OverlayIndex and OverlayIndexes) <> 0 then
  980. begin
  981. DrawOverlayImage(nmcd.hdc, OverlayIndex);
  982. Dec(OverlayIndexes, OverlayIndex);
  983. end;
  984. OverlayIndex := OverlayIndex shl 1;
  985. end;
  986. end;
  987. except
  988. end;
  989. if UpdateStatusBarPending then DoUpdateStatusBar;
  990. end;
  991. function TCustomDirView.FileNameMatchesMasks(FileName: string;
  992. Directory: Boolean; Size: Int64; Modification: TDateTime; Masks: string;
  993. AllowImplicitMatches: Boolean): Boolean;
  994. begin
  995. Result := False;
  996. if Assigned(OnMatchMask) then
  997. OnMatchMask(Self, FileName, Directory, Size, Modification, Masks, Result, AllowImplicitMatches)
  998. end;
  999. procedure TCustomDirView.SetAddParentDir(Value: Boolean);
  1000. begin
  1001. if FAddParentDir <> Value then
  1002. begin
  1003. FAddParentDir := Value;
  1004. if DirOK then Reload(True);
  1005. end;
  1006. end;
  1007. procedure TCustomDirView.SetDimmHiddenFiles(Value: Boolean);
  1008. begin
  1009. if Value <> FDimmHiddenFiles then
  1010. begin
  1011. FDimmHiddenFiles := Value;
  1012. Self.Repaint;
  1013. end;
  1014. end; {SetDimmHiddenFiles}
  1015. procedure TCustomDirView.SetPathLabel(Value: TCustomPathLabel);
  1016. begin
  1017. if FPathLabel <> Value then
  1018. begin
  1019. if Assigned(FPathLabel) and (FPathLabel.FocusControl = Self) then
  1020. FPathLabel.FocusControl := nil;
  1021. FPathLabel := Value;
  1022. if Assigned(Value) then
  1023. begin
  1024. Value.FreeNotification(Self);
  1025. if not Assigned(Value.FocusControl) then
  1026. Value.FocusControl := Self;
  1027. UpdatePathLabel;
  1028. end;
  1029. end;
  1030. end; { SetPathLabel }
  1031. procedure TCustomDirView.SetShowHiddenFiles(Value: Boolean);
  1032. begin
  1033. if ShowHiddenFiles <> Value then
  1034. begin
  1035. FShowHiddenFiles := Value;
  1036. if DirOK then Reload(False);
  1037. end;
  1038. end;
  1039. procedure TCustomDirView.SetFormatSizeBytes(Value: TFormatBytesStyle);
  1040. begin
  1041. if Value <> FFormatSizeBytes then
  1042. begin
  1043. FFormatSizeBytes := Value;
  1044. Self.Repaint;
  1045. end;
  1046. end; {SetFormatSizeBytes}
  1047. function TCustomDirView.GetDragSourceEffects: TDropEffectSet;
  1048. begin
  1049. Result := [deCopy, deMove, deLink];
  1050. end;
  1051. function TCustomDirView.GetUseDragImages: Boolean;
  1052. begin
  1053. Result := FWantUseDragImages;
  1054. end;
  1055. procedure TCustomDirView.SetTargetPopupMenu(Value: Boolean);
  1056. begin
  1057. if Assigned(FDragDropFilesEx) then FDragDropFilesEx.TargetPopupMenu := Value;
  1058. end;
  1059. procedure TCustomDirView.NeedImageLists(Recreate: Boolean);
  1060. begin
  1061. SmallImages := ShellImageListForControl(Self, ilsSmall);
  1062. LargeImages := ShellImageListForControl(Self, ilsLarge);
  1063. if (not Assigned(FImageList16)) or Recreate then
  1064. begin
  1065. FreeAndNil(FImageList16);
  1066. FImageList16 := OverlayImageList(SmallImages.Width);
  1067. end;
  1068. if (not Assigned(FImageList32)) or Recreate then
  1069. begin
  1070. FreeAndNil(FImageList32);
  1071. FImageList32 := OverlayImageList(LargeImages.Width);
  1072. end;
  1073. end;
  1074. procedure TCustomDirView.CMDPIChanged(var Message: TMessage);
  1075. begin
  1076. inherited;
  1077. NeedImageLists(True);
  1078. end;
  1079. const
  1080. RequiredStyles = LVS_EX_DOUBLEBUFFER or LVS_EX_TRANSPARENTBKGND;
  1081. procedure TCustomDirView.CMEnabledChanged(var Message: TMessage);
  1082. var
  1083. ListViewStyle: DWORD;
  1084. begin
  1085. inherited;
  1086. // We need this so that we can control background color of disabled file panel for dark theme.
  1087. // See comment in LVMSetExtendedListViewStyle for an explanation.
  1088. ListViewStyle := ListView_GetExtendedListViewStyle(Handle);
  1089. if Enabled then
  1090. begin
  1091. ListView_SetExtendedListViewStyle(Handle, (ListViewStyle or RequiredStyles));
  1092. end
  1093. else
  1094. begin
  1095. ListView_SetExtendedListViewStyle(Handle, (ListViewStyle and (not RequiredStyles)));
  1096. end;
  1097. end;
  1098. procedure TCustomDirView.FreeImageLists;
  1099. begin
  1100. FreeAndNil(FImageList16);
  1101. FreeAndNil(FImageList32);
  1102. SmallImages := nil;
  1103. LargeImages := nil;
  1104. end;
  1105. procedure TCustomDirView.WMThemeChanged(var Message: TMessage);
  1106. begin
  1107. if SupportsDarkMode then // To reduce impact
  1108. begin
  1109. UpdateDarkMode;
  1110. RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
  1111. end;
  1112. inherited;
  1113. end;
  1114. procedure TCustomDirView.UpdateDarkMode;
  1115. begin
  1116. if SupportsDarkMode then // To reduce impact
  1117. begin
  1118. AllowDarkModeForWindow(Self, DarkMode);
  1119. if FHeaderHandle <> 0 then
  1120. begin
  1121. AllowDarkModeForWindow(FHeaderHandle, DarkMode);
  1122. SendMessage(FHeaderHandle, WM_THEMECHANGED, 0, 0);
  1123. end;
  1124. end;
  1125. end;
  1126. procedure TCustomDirView.CreateWnd;
  1127. begin
  1128. inherited;
  1129. if Assigned(PopupMenu) then
  1130. PopupMenu.Autopopup := False;
  1131. FDragDropFilesEx.DragDropControl := Self;
  1132. if SupportsDarkMode then
  1133. begin
  1134. // This enables dark mode - List view itself supports dark mode somewhat even in the our 'Explorer' theme.
  1135. // The 'ItemsView' has better dark mode selection color, but on the other hand is does not have dark scrollbars.
  1136. // win32-darkmode has ugly fix for that (FixDarkScrollBar), which we do not want to employ.
  1137. SetWindowTheme(FHeaderHandle, 'ItemsView', nil);
  1138. if DarkMode then UpdateDarkMode;
  1139. end;
  1140. NeedImageLists(False);
  1141. end;
  1142. procedure TCustomDirView.LVMSetExtendedListViewStyle(var Message: TMessage);
  1143. // Only TWinControl.DoubleBuffered actually prevents flicker
  1144. // on Win7 when moving mouse over list view, not LVS_EX_DOUBLEBUFFER.
  1145. // But LVS_EX_DOUBLEBUFFER brings nice alpha blended marquee selection.
  1146. // Double buffering introduces artefacts when scrolling using
  1147. // keyboard (Page-up/Down). This gets fixed by LVS_EX_TRANSPARENTBKGND,
  1148. // but that works on Vista and newer only. See WMKeyDown
  1149. // for workaround on earlier systems.
  1150. begin
  1151. // This prevents TCustomListView.ResetExStyles resetting our styles
  1152. if Enabled and
  1153. (Message.WParam = 0) and
  1154. ((Message.LParam and RequiredStyles) <> RequiredStyles) then
  1155. begin
  1156. ListView_SetExtendedListViewStyle(Handle, Message.LParam or RequiredStyles);
  1157. end
  1158. else
  1159. begin
  1160. inherited;
  1161. end;
  1162. end;
  1163. procedure TCustomDirView.DestroyWnd;
  1164. begin
  1165. // to force drag&drop re-registration when recreating handle
  1166. // (occurs when changing ViewStyle)
  1167. FDragDropFilesEx.DragDropControl := nil;
  1168. inherited;
  1169. end;
  1170. procedure TCustomDirView.CMRecreateWnd(var Message: TMessage);
  1171. var
  1172. HadHandle: Boolean;
  1173. begin
  1174. HadHandle := HandleAllocated;
  1175. inherited;
  1176. // See comment in TCustomDriveView.CMRecreateWnd
  1177. if HadHandle then
  1178. begin
  1179. HandleNeeded;
  1180. end;
  1181. end;
  1182. function TCustomDirView.DoItemColor(Item: TListItem): TColor;
  1183. var
  1184. Precision: TDateTimePrecision;
  1185. begin
  1186. Result := clDefaultItemColor;
  1187. if Assigned(OnGetItemColor) then
  1188. begin
  1189. OnGetItemColor(Self, ItemFileName(Item), ItemIsDirectory(Item), ItemFileSize(Item), ItemFileTime(Item, Precision), Result);
  1190. end;
  1191. end;
  1192. procedure TCustomDirView.DoCustomDrawItem(Item: TListItem; Stage: TCustomDrawStage);
  1193. var
  1194. Color: TColor;
  1195. begin
  1196. if (Item <> nil) and (Stage = cdPrePaint) then
  1197. begin
  1198. Color := DoItemColor(Item);
  1199. if Color = clDefaultItemColor then Color := ItemColor(Item);
  1200. if (Color <> clDefaultItemColor) and
  1201. (Canvas.Font.Color <> Color) then
  1202. begin
  1203. Canvas.Font.Color := Color;
  1204. end;
  1205. end;
  1206. end;
  1207. function TCustomDirView.CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  1208. Stage: TCustomDrawStage): Boolean;
  1209. begin
  1210. DoCustomDrawItem(Item, Stage);
  1211. Result := inherited CustomDrawItem(Item, State, Stage);
  1212. end;
  1213. function TCustomDirView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  1214. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
  1215. begin
  1216. DoCustomDrawItem(Item, Stage);
  1217. Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
  1218. end;
  1219. procedure TCustomDirView.Delete(Item: TListItem);
  1220. begin
  1221. if Assigned(Item) then
  1222. begin
  1223. // This causes access violation when size is stored in structure
  1224. // pointed by TListItem->Data and this structure is not valid any more
  1225. if Valid then Dec(FFilesSize, ItemFileSize(Item));
  1226. inherited Delete(Item);
  1227. end;
  1228. end;
  1229. destructor TCustomDirView.Destroy;
  1230. begin
  1231. Assert(not FSavedSelection);
  1232. FreeAndNil(FScrollOnDragOver);
  1233. FreeAndNil(FSavedNames);
  1234. FreeAndNil(FHistoryPaths);
  1235. FreeAndNil(FDragDropFilesEx);
  1236. FreeImageLists;
  1237. inherited;
  1238. end;
  1239. procedure TCustomDirView.SelectFiles(Filter: TFileFilter; Select: Boolean);
  1240. var
  1241. Item: TListItem;
  1242. Index: Integer;
  1243. OldCursor: TCursor;
  1244. begin
  1245. Assert(Valid);
  1246. OldCursor := Screen.Cursor;
  1247. Items.BeginUpdate;
  1248. BeginSelectionUpdate;
  1249. try
  1250. Screen.Cursor := crHourGlass;
  1251. for Index := 0 to Items.Count-1 do
  1252. begin
  1253. Item := Items[Index];
  1254. Assert(Assigned(Item));
  1255. if (Item.Selected <> Select) and
  1256. ItemMatchesFilter(Item, Filter) then
  1257. Item.Selected := Select;
  1258. end;
  1259. finally
  1260. Screen.Cursor := OldCursor;
  1261. Items.EndUpdate;
  1262. EndSelectionUpdate;
  1263. end;
  1264. end;
  1265. function TCustomDirView.DragCompleteFileList: Boolean;
  1266. begin
  1267. Result := (MarkedCount <= 100) and (not IsRecycleBin);
  1268. end;
  1269. procedure TCustomDirView.DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  1270. begin
  1271. end;
  1272. procedure TCustomDirView.DumbCustomDrawSubItem(Sender: TCustomListView;
  1273. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  1274. var DefaultDraw: Boolean);
  1275. begin
  1276. end;
  1277. function TCustomDirView.GetTargetPopupMenu: Boolean;
  1278. begin
  1279. if Assigned(FDragDropFilesEx) then Result := FDragDropFilesEx.TargetPopupMenu
  1280. else Result := True;
  1281. end;
  1282. procedure TCustomDirView.SetMultiSelect(Value: Boolean);
  1283. begin
  1284. if Value <> MultiSelect then
  1285. begin
  1286. inherited SetMultiSelect(Value);
  1287. if not (csLoading in ComponentState) and Assigned(ColProperties) then
  1288. begin
  1289. ColProperties.RecreateColumns;
  1290. SetColumnImages;
  1291. if DirOK then Reload(True);
  1292. end;
  1293. end;
  1294. end;
  1295. function TCustomDirView.GetValid: Boolean;
  1296. begin
  1297. Result := (not (csDestroying in ComponentState)) and
  1298. (not Loading) and (not FClearingItems);
  1299. end;
  1300. function TCustomDirView.ItemCanDrag(Item: TListItem): Boolean;
  1301. begin
  1302. Result := (not ItemIsParentDirectory(Item));
  1303. end;
  1304. function TCustomDirView.ItemColor(Item: TListItem): TColor;
  1305. begin
  1306. Result := clDefaultItemColor;
  1307. end;
  1308. function TCustomDirView.GetFilesMarkedSize: Int64;
  1309. begin
  1310. if SelCount > 0 then Result := FilesSelSize
  1311. else
  1312. if Assigned(ItemFocused) then Result := ItemFileSize(ItemFocused)
  1313. else Result := 0;
  1314. end;
  1315. function TCustomDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1316. begin
  1317. Result := False;
  1318. end;
  1319. function TCustomDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1320. begin
  1321. Result := oiNoOverlay;
  1322. if Assigned(OnGetOverlay) then
  1323. OnGetOverlay(Self, Item, Result);
  1324. end;
  1325. procedure TCustomDirView.WMKeyDown(var Message: TWMKeyDown);
  1326. begin
  1327. if DoubleBuffered and (Message.CharCode in [VK_PRIOR, VK_NEXT]) and
  1328. FDoubleBufferedScrollingWorkaround then
  1329. begin
  1330. // WORKAROUND
  1331. // When scrolling with double-buffering enabled, ugly artefacts
  1332. // are shown temporarily.
  1333. // LVS_EX_TRANSPARENTBKGND fixes it on Vista and newer
  1334. SendMessage(Handle, WM_SETREDRAW, 0, 0);
  1335. try
  1336. inherited;
  1337. finally
  1338. SendMessage(Handle, WM_SETREDRAW, 1, 0);
  1339. end;
  1340. Repaint;
  1341. end
  1342. else
  1343. begin
  1344. inherited;
  1345. end;
  1346. end;
  1347. procedure TCustomDirView.DoDisplayPropertiesMenu;
  1348. begin
  1349. if not IsBusy then
  1350. DisplayPropertiesMenu;
  1351. end;
  1352. procedure TCustomDirView.DoExecute(Item: TListItem; ForceEnter: Boolean);
  1353. begin
  1354. BusyOperation(procedure begin Execute(Item, ForceEnter); end);
  1355. end;
  1356. procedure TCustomDirView.DoExecuteParentDirectory;
  1357. begin
  1358. BusyOperation(ExecuteParentDirectory);
  1359. end;
  1360. procedure TCustomDirView.KeyDown(var Key: Word; Shift: TShiftState);
  1361. var
  1362. AKey: Word;
  1363. begin
  1364. if Valid and (not IsEditing) and (not Loading) then
  1365. begin
  1366. if (Key = VK_RETURN) or
  1367. ((Key = VK_NEXT) and (ssCtrl in Shift)) then
  1368. begin
  1369. if Assigned(ItemFocused) then
  1370. begin
  1371. AKey := Key;
  1372. Key := 0;
  1373. if (AKey = VK_RETURN) and (Shift = [ssAlt]) then DoDisplayPropertiesMenu
  1374. else
  1375. if (AKey <> VK_RETURN) or (Shift = []) then DoExecute(ItemFocused, (AKey <> VK_RETURN));
  1376. end;
  1377. end
  1378. else
  1379. if ((Key = VK_BACK) or ((Key = VK_PRIOR) and (ssCtrl in Shift))) and
  1380. (not IsRoot) then
  1381. begin
  1382. inherited;
  1383. // If not handled in TCustomScpExplorerForm::DirViewKeyDown
  1384. if Key <> 0 then
  1385. begin
  1386. Key := 0;
  1387. DoExecuteParentDirectory;
  1388. end;
  1389. end
  1390. else
  1391. if ((Key = VK_UP) and (ssAlt in Shift)) and
  1392. (not IsRoot) then
  1393. begin
  1394. Key := 0;
  1395. // U+25D8 is 'INVERSE BULLET', what is glyph representing '\x8' (or '\b')
  1396. // ('up' key is the '8' key on numeric pad)
  1397. // We could obtain the value programatically using
  1398. // MultiByteToWideChar(CP_OEMCP, MB_USEGLYPHCHARS, "\x8", 1, ...)
  1399. FNextCharToIgnore := $25D8;
  1400. DoExecuteParentDirectory;
  1401. end
  1402. else
  1403. if (Key = 220 { backslash }) and (ssCtrl in Shift) and (not IsRoot) then
  1404. begin
  1405. Key := 0;
  1406. BusyOperation(ExecuteRootDirectory);
  1407. end
  1408. else
  1409. if (Key = VK_LEFT) and (ssAlt in Shift) then
  1410. begin
  1411. if BackCount >= 1 then DoHistoryGo(-1);
  1412. end
  1413. else
  1414. if (Key = VK_RIGHT) and (ssAlt in Shift) then
  1415. begin
  1416. if ForwardCount >= 1 then DoHistoryGo(1);
  1417. end
  1418. else
  1419. begin
  1420. inherited;
  1421. end;
  1422. end
  1423. else
  1424. begin
  1425. inherited;
  1426. end;
  1427. end;
  1428. procedure TCustomDirView.KeyPress(var Key: Char);
  1429. begin
  1430. if IsEditing and (Pos(Key, FInvalidNameChars) <> 0) Then
  1431. begin
  1432. Beep;
  1433. Key := #0;
  1434. end;
  1435. inherited;
  1436. end;
  1437. procedure TCustomDirView.DisplayContextMenuInSitu;
  1438. var
  1439. R: TRect;
  1440. P: TPoint;
  1441. begin
  1442. if Assigned(ItemFocused) then
  1443. begin
  1444. R := ItemFocused.DisplayRect(drIcon);
  1445. P.X := (R.Left + R.Right) div 2;
  1446. P.Y := (R.Top + R.Bottom) div 2;
  1447. end
  1448. else
  1449. begin
  1450. P.X := 0;
  1451. P.Y := 0;
  1452. end;
  1453. P := ClientToScreen(P);
  1454. DisplayContextMenu(P);
  1455. end;
  1456. procedure TCustomDirView.KeyUp(var Key: Word; Shift: TShiftState);
  1457. var
  1458. P: TPoint;
  1459. begin
  1460. if Key = VK_APPS then
  1461. begin
  1462. if (not Loading) and (not IsBusy) then
  1463. begin
  1464. if MarkedCount > 0 then
  1465. begin
  1466. DisplayContextMenuInSitu;
  1467. end
  1468. else
  1469. if Assigned(PopupMenu) then
  1470. begin
  1471. P.X := 0;
  1472. P.Y := 0;
  1473. P := ClientToScreen(P);
  1474. PopupMenu.Popup(P.X, P.Y);
  1475. end;
  1476. end;
  1477. end
  1478. else
  1479. inherited KeyUp(Key, Shift);
  1480. end;
  1481. procedure TCustomDirView.SetWatchForChanges(Value: Boolean);
  1482. begin
  1483. if FWatchForChanges <> Value then
  1484. FWatchForChanges := Value;
  1485. end;
  1486. function TCustomDirView.TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean;
  1487. begin
  1488. Assert(Assigned(DragDropFilesEx) and Assigned(Item));
  1489. Result :=
  1490. DragDropFilesEx.TargetHasDropHandler(nil, ItemFullFileName(Item), Effect);
  1491. if Assigned(OnDDTargetHasDropHandler) then
  1492. begin
  1493. OnDDTargetHasDropHandler(Self, Item, Effect, Result);
  1494. end;
  1495. end;
  1496. procedure TCustomDirView.UpdatePathLabelCaption;
  1497. begin
  1498. PathLabel.Caption := PathName;
  1499. PathLabel.Mask := Mask;
  1500. end;
  1501. procedure TCustomDirView.UpdatePathLabel;
  1502. begin
  1503. if Assigned(PathLabel) then
  1504. begin
  1505. if csDesigning in ComponentState then
  1506. begin
  1507. PathLabel.Caption := PathLabel.Name;
  1508. PathLabel.Mask := '';
  1509. end
  1510. else
  1511. begin
  1512. UpdatePathLabelCaption;
  1513. end;
  1514. PathLabel.UpdateStatus;
  1515. end;
  1516. end; { UpdatePathLabel }
  1517. procedure TCustomDirView.DoUpdateStatusBar(Force: Boolean);
  1518. var
  1519. StatusFileInfo: TStatusFileInfo;
  1520. begin
  1521. if (FUpdatingSelection = 0) and Assigned(OnUpdateStatusBar) then
  1522. begin
  1523. with StatusFileInfo do
  1524. begin
  1525. SelectedSize := FilesSelSize;
  1526. FilesSize := Self.FilesSize;
  1527. SelectedCount := SelCount;
  1528. FilesCount := Self.FilesCount;
  1529. HiddenCount := Self.HiddenCount;
  1530. FilteredCount := Self.FilteredCount;
  1531. end;
  1532. if Force or (not CompareMem(@StatusFileInfo, @FStatusFileInfo, SizeOf(StatusFileInfo))) then
  1533. begin
  1534. FStatusFileInfo := StatusFileInfo;
  1535. OnUpdateStatusBar(Self, FStatusFileInfo);
  1536. end;
  1537. end;
  1538. end; { UpdateStatusBar }
  1539. procedure TCustomDirView.UpdateStatusBar;
  1540. begin
  1541. DoUpdateStatusBar(True);
  1542. end;
  1543. procedure TCustomDirView.WMContextMenu(var Message: TWMContextMenu);
  1544. var
  1545. Point: TPoint;
  1546. begin
  1547. FDragEnabled := False;
  1548. if Assigned(PopupMenu) then
  1549. PopupMenu.AutoPopup := False;
  1550. //inherited;
  1551. if FContextMenu and (not Loading) then
  1552. begin
  1553. Point.X := Message.XPos;
  1554. Point.Y := Message.YPos;
  1555. Point := ScreenToClient(Point);
  1556. if Assigned(OnMouseDown) then
  1557. begin
  1558. OnMouseDown(Self, mbRight, [], Point.X, Point.Y);
  1559. end;
  1560. if FUseSystemContextMenu and Assigned(ItemFocused) and
  1561. (GetItemAt(Point.X, Point.Y) = ItemFocused) then
  1562. begin
  1563. Point.X := Message.XPos;
  1564. Point.Y := Message.YPos;
  1565. DisplayContextMenu(Point);
  1566. end
  1567. else
  1568. if Assigned(PopupMenu) and (not PopupMenu.AutoPopup) then
  1569. begin
  1570. PopupMenu.Popup(Message.XPos, Message.YPos);
  1571. end;
  1572. end;
  1573. FContextMenu := False;
  1574. //inherited;
  1575. end;
  1576. function TCustomDirView.EnableDragOnClick: Boolean;
  1577. begin
  1578. Result := (not Loading) and inherited EnableDragOnClick;
  1579. end;
  1580. procedure TCustomDirView.WMLButtonDown(var Message: TWMLButtonDown);
  1581. begin
  1582. GetCursorPos(FStartPos);
  1583. FDragEnabled := EnableDragOnClick;
  1584. inherited;
  1585. end;
  1586. procedure TCustomDirView.WMRButtonDown(var Message: TWMRButtonDown);
  1587. begin
  1588. GetCursorPos(FStartPos);
  1589. if FDragDropFilesEx.DragDetectStatus <> ddsDrag then
  1590. FDragEnabled := EnableDragOnClick;
  1591. FContextMenu := True;
  1592. inherited;
  1593. end;
  1594. procedure TCustomDirView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1595. begin
  1596. inherited;
  1597. if Assigned(ItemFocused) and (not Loading) and
  1598. (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) then
  1599. begin
  1600. if GetKeyState(VK_MENU) < 0 then DoDisplayPropertiesMenu
  1601. else DoExecute(ItemFocused, False);
  1602. end;
  1603. end;
  1604. procedure TCustomDirView.WMLButtonUp(var Message: TWMLButtonUp);
  1605. begin
  1606. FDragEnabled := False;
  1607. inherited;
  1608. end;
  1609. procedure TCustomDirView.WMXButtonUp(var Message: TWMXMouse);
  1610. begin
  1611. if Message.Button = _XBUTTON1 then
  1612. begin
  1613. if BackCount >= 1 then DoHistoryGo(-1);
  1614. Message.Result := 1;
  1615. end
  1616. else
  1617. if Message.Button = _XBUTTON2 then
  1618. begin
  1619. if ForwardCount >= 1 then DoHistoryGo(1);
  1620. Message.Result := 1;
  1621. end;
  1622. end;
  1623. procedure TCustomDirView.CancelEdit;
  1624. begin
  1625. // - Do nothing when handle is not allocated (we cannot be editing anyway
  1626. // without a handle), otherwise this causes handle allocation,
  1627. // what is wrong particularly when we are called from ClearItems
  1628. // when we are being destroyed
  1629. // - If editing, it has to be focused item
  1630. if HandleAllocated and IsEditing and Assigned(ItemFocused) then
  1631. begin
  1632. ItemFocused.CancelEdit;
  1633. FLoadEnabled := True;
  1634. end;
  1635. end;
  1636. procedure TCustomDirView.Reload(CacheIcons: Boolean);
  1637. var
  1638. OldSelection: TStringList;
  1639. OldItemFocused: string;
  1640. OldFocusedShown: Boolean;
  1641. OldShownItemOffset: Integer;
  1642. Index: Integer;
  1643. FoundIndex: Integer;
  1644. IconCache: TStringList;
  1645. Item: TListItem;
  1646. ItemToFocus: TListItem;
  1647. FileName: string;
  1648. R: TRect;
  1649. P: TPoint;
  1650. begin
  1651. if Path <> '' then
  1652. begin
  1653. CancelEdit;
  1654. OldSelection := nil;
  1655. IconCache := nil;
  1656. Items.BeginUpdate;
  1657. try
  1658. OldSelection := TStringList.Create;
  1659. OldSelection.CaseSensitive := FCaseSensitive;
  1660. if CacheIcons then
  1661. IconCache := TStringList.Create;
  1662. for Index := 0 to Items.Count-1 do
  1663. begin
  1664. Item := Items[Index];
  1665. // cannot use ItemFileName as for TUnixDirView the file object
  1666. // is no longer valid
  1667. FileName := Item.Caption;
  1668. if Item.Selected then
  1669. OldSelection.Add(FileName);
  1670. if CacheIcons and (ItemImageIndex(Item, True) >= 0) then
  1671. IconCache.AddObject(FileName, TObject(ItemImageIndex(Item, True)));
  1672. end;
  1673. if FSelectFile <> '' then
  1674. begin
  1675. OldItemFocused := FSelectFile;
  1676. OldFocusedShown := False;
  1677. OldShownItemOffset := -1;
  1678. FSelectFile := '';
  1679. end
  1680. else
  1681. begin
  1682. if Assigned(ItemFocused) then
  1683. begin
  1684. if ViewStyle = vsReport then
  1685. begin
  1686. if Assigned(TopItem) then
  1687. begin
  1688. R := ItemFocused.DisplayRect(drBounds);
  1689. if (R.Top < TopItem.DisplayRect(drBounds).Top) or (R.Top > ClientHeight) then
  1690. begin
  1691. OldFocusedShown := False;
  1692. OldShownItemOffset := TopItem.Index;
  1693. end
  1694. else
  1695. begin
  1696. OldFocusedShown := True;
  1697. OldShownItemOffset := ItemFocused.Index - TopItem.Index;
  1698. end;
  1699. end
  1700. else
  1701. begin
  1702. // seen with one user only
  1703. OldFocusedShown := False;
  1704. OldShownItemOffset := 0;
  1705. end;
  1706. end
  1707. else
  1708. begin
  1709. // to satisfy compiler, never used
  1710. OldFocusedShown := False;
  1711. OldShownItemOffset := -1;
  1712. end;
  1713. OldItemFocused := ItemFocused.Caption;
  1714. end
  1715. else
  1716. begin
  1717. OldItemFocused := '';
  1718. OldFocusedShown := False;
  1719. if Assigned(TopItem) then OldShownItemOffset := TopItem.Index
  1720. else OldShownItemOffset := -1;
  1721. end;
  1722. end;
  1723. Load(False);
  1724. OldSelection.Sort;
  1725. if CacheIcons then IconCache.Sort;
  1726. ItemToFocus := nil;
  1727. for Index := 0 to Items.Count - 1 do
  1728. begin
  1729. Item := Items[Index];
  1730. FileName := ItemFileName(Item);
  1731. if FileName = OldItemFocused then
  1732. ItemToFocus := Item;
  1733. if OldSelection.Find(FileName, FoundIndex) then
  1734. Item.Selected := True;
  1735. if CacheIcons and (ItemImageIndex(Item, True) < 0) then
  1736. begin
  1737. FoundIndex := IconCache.IndexOf(FileName);
  1738. if FoundIndex >= 0 then
  1739. SetItemImageIndex(Item, Integer(IconCache.Objects[FoundIndex]));
  1740. end;
  1741. end;
  1742. finally
  1743. Items.EndUpdate;
  1744. OldSelection.Free;
  1745. if CacheIcons then IconCache.Free;
  1746. end;
  1747. // This is below Items.EndUpdate(), to make Scroll() work properly
  1748. if Assigned(ItemToFocus) then
  1749. begin
  1750. // we have found item that was previously focused and visible, scroll to it
  1751. if (ViewStyle = vsReport) and OldFocusedShown and
  1752. (ItemToFocus.Index > OldShownItemOffset) then
  1753. begin
  1754. P := Items[ItemToFocus.Index - OldShownItemOffset].GetPosition;
  1755. // GetPosition is shifted bit low below actual row top.
  1756. // Scroll to the GetPosition would scroll one line lower.
  1757. Scroll(0, P.Y - Items[0].GetPosition.Y);
  1758. end;
  1759. // Strangely after this mouse selection works correctly, so we do not have to call FocusItem.
  1760. ItemFocused := ItemToFocus;
  1761. end;
  1762. // could not scroll when focus is not visible because
  1763. // of previous call to hack-implementation of FocusItem()
  1764. // - no longer true, this can be re-enabled after some testing
  1765. {$IF False}
  1766. // previously focus item was not visible, scroll to the same position
  1767. // as before
  1768. if (ViewStyle = vsReport) and (not OldFocusedShown) and
  1769. (OldShownItemOffset >= 0) and (Items.Count > 0) then
  1770. begin
  1771. if OldShownItemOffset < Items.Count - VisibleRowCount then
  1772. Scroll(0, OldShownItemOffset)
  1773. else
  1774. Items.Item[Items.Count - 1].MakeVisible(false);
  1775. end
  1776. // do not know where to scroll to, so scroll to focus
  1777. // (or we have tried to scroll to previously focused and visible item,
  1778. // now make sute that it is really visible)
  1779. else {$IFEND}
  1780. if Assigned(ItemToFocus) then ItemToFocus.MakeVisible(false);
  1781. FocusSomething;
  1782. end;
  1783. end;
  1784. procedure TCustomDirView.Load(DoFocusSomething: Boolean);
  1785. var
  1786. SaveCursor: TCursor;
  1787. Delimiters: string;
  1788. LastDirName: string;
  1789. begin
  1790. if not FLoadEnabled or Loading then
  1791. begin
  1792. FDirty := True;
  1793. FAbortLoading := True;
  1794. end
  1795. else
  1796. begin
  1797. FLoading := True;
  1798. try
  1799. FHasParentDir := False;
  1800. if Assigned(FOnStartLoading) then FOnStartLoading(Self);
  1801. SaveCursor := Screen.Cursor;
  1802. Screen.Cursor := crHourGlass;
  1803. try
  1804. FNotifyEnabled := False;
  1805. ClearItems;
  1806. FFilesSize := 0;
  1807. FFilesSelSize := 0;
  1808. SortType := stNone;
  1809. Items.BeginUpdate;
  1810. try
  1811. LoadFiles;
  1812. finally
  1813. Items.EndUpdate;
  1814. end;
  1815. finally
  1816. Screen.Cursor := SaveCursor;
  1817. end;
  1818. finally
  1819. FLoading := False;
  1820. try
  1821. if FAbortLoading then
  1822. begin
  1823. FAbortLoading := False;
  1824. Reload(False);
  1825. end
  1826. else
  1827. begin
  1828. if DirOK then SortItems;
  1829. FAbortLoading := False;
  1830. FDirty := False;
  1831. if (Length(LastPath) > Length(PathName)) and
  1832. (Copy(LastPath, 1, Length(PathName)) = PathName) and
  1833. (Items.Count > 0) then
  1834. begin
  1835. LastDirName := Copy(LastPath, Length(PathName) + 1, MaxInt);
  1836. Delimiters := '\:/';
  1837. if IsDelimiter(Delimiters, LastDirName, 1) then
  1838. begin
  1839. LastDirName := Copy(LastDirName, 2, MaxInt);
  1840. end;
  1841. if LastDelimiter('\:/', LastDirName) = 0 then
  1842. begin
  1843. ItemFocused := FindFileItem(LastDirName);
  1844. end;
  1845. end;
  1846. end;
  1847. finally
  1848. // nested try .. finally block is included
  1849. // because we really want these to be executed
  1850. FNotifyEnabled := True;
  1851. if DoFocusSomething then
  1852. begin
  1853. FocusSomething;
  1854. end;
  1855. if Assigned(FOnLoaded) then
  1856. begin
  1857. FOnLoaded(Self);
  1858. end;
  1859. UpdatePathLabel;
  1860. DoUpdateStatusBar;
  1861. end;
  1862. end;
  1863. end;
  1864. end;
  1865. procedure TCustomDirView.SetLoadEnabled(Enabled: Boolean);
  1866. begin
  1867. if Enabled <> LoadEnabled then
  1868. begin
  1869. FLoadEnabled := Enabled;
  1870. if Enabled and Dirty then Reload(True);
  1871. end;
  1872. end;
  1873. function TCustomDirView.GetFilesCount: Integer;
  1874. begin
  1875. Result := Items.Count;
  1876. if (Result > 0) and HasParentDir then Dec(Result);
  1877. end;
  1878. procedure TCustomDirView.SetViewStyle(Value: TViewStyle);
  1879. begin
  1880. if (Value <> ViewStyle) and (not FLoading) then
  1881. begin
  1882. FNotifyEnabled := False;
  1883. inherited;
  1884. FNotifyEnabled := True;
  1885. // this is workaround for bug in TCustomNortonLikeListView
  1886. // that clears Items on recreating wnd (caused by change to ViewStyle)
  1887. Reload(True);
  1888. end;
  1889. end;
  1890. procedure TCustomDirView.ColClick(Column: TListColumn);
  1891. var
  1892. ScrollToFocused: Boolean;
  1893. begin
  1894. ScrollToFocused := Assigned(ItemFocused);
  1895. inherited;
  1896. if ScrollToFocused and Assigned(ItemFocused) then
  1897. ItemFocused.MakeVisible(False);
  1898. end;
  1899. procedure TCustomDirView.CustomSortItems(SortProc: Pointer);
  1900. var
  1901. SavedCursor: TCursor;
  1902. SavedNotifyEnabled: Boolean;
  1903. begin
  1904. if HandleAllocated then
  1905. begin
  1906. SavedNotifyEnabled := FNotifyEnabled;
  1907. SavedCursor := Screen.Cursor;
  1908. Items.BeginUpdate;
  1909. try
  1910. Screen.Cursor := crHourglass;
  1911. FNotifyEnabled := False;
  1912. CustomSort(TLVCompare(SortProc), Integer(Pointer(Self)));
  1913. finally
  1914. Screen.Cursor := SavedCursor;
  1915. FNotifyEnabled := SavedNotifyEnabled;
  1916. Items.EndUpdate;
  1917. ItemsReordered;
  1918. end;
  1919. end;
  1920. end;
  1921. procedure TCustomDirView.ReloadForce(CacheIcons: Boolean);
  1922. begin
  1923. FLoadEnabled := True;
  1924. FDirty := False;
  1925. Reload(CacheIcons);
  1926. end;
  1927. procedure TCustomDirView.ScrollOnDragOverBeforeUpdate(ObjectToValidate: TObject);
  1928. begin
  1929. GlobalDragImageList.HideDragImage;
  1930. end;
  1931. procedure TCustomDirView.ScrollOnDragOverAfterUpdate;
  1932. begin
  1933. GlobalDragImageList.ShowDragImage;
  1934. end;
  1935. procedure TCustomDirView.DDDragEnter(DataObj: IDataObject; grfKeyState: Longint;
  1936. Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  1937. var
  1938. Index: Integer;
  1939. begin
  1940. Accept := Accept and DirOK and (not Loading);
  1941. if Accept and
  1942. (DragDropFilesEx.FileList.Count > 0) and
  1943. (Length(TFDDListItem(DragDropFilesEx.FileList[0]^).Name) > 0) and
  1944. (not IsRecycleBin or not DragDropFilesEx.FileNamesAreMapped) then
  1945. begin
  1946. try
  1947. FDragDrive := DriveInfo.GetDriveKey(TFDDListItem(DragDropFilesEx.FileList[0]^).Name);
  1948. except
  1949. // WinRAR gives us only filename on "enter", we get a full path only on "drop".
  1950. FDragDrive := '';
  1951. end;
  1952. FExeDrag := FDDLinkOnExeDrag and
  1953. (deLink in DragDropFilesEx.TargetEffects) and
  1954. ((DragDropFilesEx.AvailableDropEffects and DROPEFFECT_LINK) <> 0);
  1955. if FExeDrag then
  1956. begin
  1957. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  1958. if not IsExecutable(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  1959. begin
  1960. FExeDrag := False;
  1961. Break;
  1962. end;
  1963. end;
  1964. end
  1965. else
  1966. begin
  1967. FDragDrive := '';
  1968. end;
  1969. FScrollOnDragOver.StartDrag;
  1970. if Assigned(FOnDDDragEnter) then
  1971. FOnDDDragEnter(Self, DataObj, grfKeyState, Point, dwEffect, Accept);
  1972. end;
  1973. procedure TCustomDirView.DDDragLeave;
  1974. begin
  1975. if Assigned(DropTarget) then
  1976. begin
  1977. if GlobalDragImageList.Dragging then
  1978. GlobalDragImageList.HideDragImage;
  1979. DropTarget := nil;
  1980. Update; {ie30}
  1981. end
  1982. else DropTarget := nil;
  1983. if Assigned(FOnDDDragLeave) then
  1984. FOnDDDragLeave(Self);
  1985. end;
  1986. procedure TCustomDirView.DDDragOver(grfKeyState: Integer; Point: TPoint;
  1987. var dwEffect: Integer; PreferredEffect: Integer);
  1988. var
  1989. DropItem: TListItem;
  1990. CanDrop: Boolean;
  1991. HasDropHandler: Boolean;
  1992. begin
  1993. FDDOwnerIsSource := DragDropFilesEx.OwnerIsSource;
  1994. {Set droptarget if target is directory:}
  1995. if not Loading then DropItem := GetItemAt(Point.X, Point.Y)
  1996. else DropItem := nil;
  1997. HasDropHandler := (Assigned(DropItem) and (not IsRecycleBin) and
  1998. TargetHasDropHandler(DropItem, dwEffect));
  1999. CanDrop := Assigned(DropItem) and (not IsRecycleBin) and
  2000. (ItemIsDirectory(DropItem) or HasDropHandler);
  2001. if (CanDrop and (DropTarget <> DropItem)) or
  2002. (not CanDrop and Assigned(DropTarget)) then
  2003. begin
  2004. if GlobalDragImageList.Dragging then
  2005. begin
  2006. GlobalDragImageList.HideDragImage;
  2007. DropTarget := nil;
  2008. Update;
  2009. if CanDrop then
  2010. begin
  2011. DropTarget := DropItem;
  2012. Update;
  2013. end;
  2014. GlobalDragImageList.ShowDragImage;
  2015. end
  2016. else
  2017. begin
  2018. DropTarget := nil;
  2019. if CanDrop then DropTarget := DropItem;
  2020. end;
  2021. end;
  2022. if not Loading then
  2023. FScrollOnDragOver.DragOver(Point);
  2024. {Set dropeffect:}
  2025. if (not HasDropHandler) and (not Loading) then
  2026. begin
  2027. DDChooseEffect(grfKeyState, dwEffect, PreferredEffect);
  2028. if Assigned(FOnDDDragOver) then
  2029. FOnDDDragOver(Self, grfKeyState, Point, dwEffect);
  2030. // cannot drop to dragged files
  2031. if DragDropFilesEx.OwnerIsSource and Assigned(DropItem) then
  2032. begin
  2033. if Assigned(ItemFocused) and (not ItemFocused.Selected) then
  2034. begin
  2035. if DropItem = ItemFocused then
  2036. begin
  2037. dwEffect := DROPEFFECT_NONE;
  2038. end;
  2039. end
  2040. else
  2041. if DropItem.Selected then
  2042. begin
  2043. dwEffect := DROPEFFECT_NONE;
  2044. end;
  2045. end;
  2046. if DragDropFilesEx.OwnerIsSource and (dwEffect = DROPEFFECT_MOVE) and
  2047. (not Assigned(DropTarget)) then
  2048. begin
  2049. dwEffect := DROPEFFECT_NONE;
  2050. end
  2051. else
  2052. if Assigned(DropTarget) and ItemIsRecycleBin(DropTarget) and
  2053. (dwEffect <> DROPEFFECT_NONE) then
  2054. begin
  2055. dwEffect := DROPEFFECT_MOVE;
  2056. end;
  2057. end;
  2058. end;
  2059. function TCustomDirView.ItemData(Item: TListItem): TObject;
  2060. begin
  2061. Result := nil;
  2062. end;
  2063. function TCustomDirView.OperateOnFocusedFile(Focused, OnlyFocused: Boolean): Boolean;
  2064. begin
  2065. Result :=
  2066. Assigned(ItemFocused) and
  2067. ((Focused and (not ItemFocused.Selected)) or (SelCount = 0) or OnlyFocused);
  2068. end;
  2069. function TCustomDirView.CustomCreateFileList(Focused, OnlyFocused: Boolean;
  2070. FullPath: Boolean; FileList: TStrings; ItemObject: Boolean): TStrings;
  2071. procedure AddItem(Item: TListItem);
  2072. var
  2073. AObject: TObject;
  2074. begin
  2075. Assert(Assigned(Item));
  2076. if ItemObject then AObject := Item
  2077. else AObject := ItemData(Item);
  2078. if FullPath then Result.AddObject(ItemFullFileName(Item), AObject)
  2079. else Result.AddObject(ItemFileName(Item), AObject);
  2080. end;
  2081. var
  2082. Item: TListItem;
  2083. begin
  2084. if Assigned(FileList) then Result := FileList
  2085. else Result := TStringList.Create;
  2086. try
  2087. if OperateOnFocusedFile(Focused, OnlyFocused) then
  2088. begin
  2089. AddItem(ItemFocused)
  2090. end
  2091. else
  2092. begin
  2093. Item := GetNextItem(nil, sdAll, [isSelected]);
  2094. while Assigned(Item) do
  2095. begin
  2096. AddItem(Item);
  2097. Item := GetNextItem(Item, sdAll, [isSelected]);
  2098. end;
  2099. end;
  2100. except
  2101. if not Assigned(FileList) then FreeAndNil(Result);
  2102. raise;
  2103. end;
  2104. end;
  2105. function TCustomDirView.CreateFocusedFileList(FullPath: Boolean; FileList: TStrings): TStrings;
  2106. begin
  2107. Result := CustomCreateFileList(False, True, FullPath, FileList);
  2108. end;
  2109. function TCustomDirView.CreateFileList(Focused: Boolean; FullPath: Boolean;
  2110. FileList: TStrings): TStrings;
  2111. begin
  2112. Result := CustomCreateFileList(Focused, False, FullPath, FileList);
  2113. end;
  2114. procedure TCustomDirView.DDDrop(DataObj: IDataObject; grfKeyState: Integer;
  2115. Point: TPoint; var dwEffect: Integer);
  2116. begin
  2117. if GlobalDragImageList.Dragging then
  2118. GlobalDragImageList.HideDragImage;
  2119. if dwEffect = DROPEFFECT_NONE then
  2120. DropTarget := nil;
  2121. if Assigned(OnDDDrop) then
  2122. OnDDDrop(Self, DataObj, grfKeyState, Point, dwEffect);
  2123. end;
  2124. procedure TCustomDirView.DDQueryContinueDrag(FEscapePressed: LongBool;
  2125. grfKeyState: Integer; var Result: HResult);
  2126. var
  2127. MousePos: TPoint;
  2128. KnowTime: TFileTime;
  2129. begin
  2130. // this method cannot throw exceptions, if it does d&d will not be possible
  2131. // anymore (see TDragDrop.ExecuteOperation, global GInternalSource)
  2132. if Result = DRAGDROP_S_DROP then
  2133. begin
  2134. GetSystemTimeAsFileTime(KnowTime);
  2135. if ((Int64(KnowTime) - Int64(FDragStartTime)) <= DDDragStartDelay) then
  2136. Result := DRAGDROP_S_CANCEL;
  2137. end;
  2138. if Assigned(OnDDQueryContinueDrag) then
  2139. begin
  2140. OnDDQueryContinueDrag(Self, FEscapePressed, grfKeyState, Result);
  2141. end;
  2142. try
  2143. if FEscapePressed then
  2144. begin
  2145. if GlobalDragImageList.Dragging then
  2146. GlobalDragImageList.HideDragImage;
  2147. end
  2148. else
  2149. begin
  2150. if GlobalDragImageList.Dragging Then
  2151. begin
  2152. MousePos := ParentForm.ScreenToClient(Mouse.CursorPos);
  2153. {Move the drag image to the new position and show it:}
  2154. if (MousePos.X <> FDragPos.X) or (MousePos.Y <> FDragPos.Y) then
  2155. begin
  2156. FDragPos := MousePos;
  2157. if PtInRect(ParentForm.BoundsRect, Mouse.CursorPos) then
  2158. begin
  2159. GlobalDragImageList.DragMove(MousePos.X, MousePos.Y);
  2160. GlobalDragImageList.ShowDragImage;
  2161. end
  2162. else GlobalDragImageList.HideDragImage;
  2163. end;
  2164. end;
  2165. end;
  2166. except
  2167. // do not care if the above fails
  2168. // (Mouse.CursorPos fails when desktop is locked by user)
  2169. end;
  2170. end;
  2171. procedure TCustomDirView.DDSpecifyDropTarget(Sender: TObject;
  2172. DragDropHandler: Boolean; Point: TPoint; var pidlFQ: PItemIDList;
  2173. var Filename: string);
  2174. var
  2175. Item: TListItem;
  2176. begin
  2177. pidlFQ := nil;
  2178. if DirOK and (not Loading) then
  2179. begin
  2180. if DragDropHandler then
  2181. begin
  2182. if Assigned(DropTarget) and ItemIsDirectory(DropTarget) then
  2183. FileName := ItemFullFileName(DropTarget)
  2184. else
  2185. FileName := PathName;
  2186. end
  2187. else
  2188. begin
  2189. Item := GetItemAt(Point.X, Point.Y);
  2190. if Assigned(Item) and (not ItemIsDirectory(Item)) and
  2191. (not IsRecycleBin) then
  2192. FileName := ItemFullFileName(Item)
  2193. else
  2194. FileName := '';
  2195. end;
  2196. end
  2197. else FileName := '';
  2198. end;
  2199. procedure TCustomDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu;
  2200. DataObj: IDataObject; AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  2201. begin
  2202. end;
  2203. procedure TCustomDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  2204. begin
  2205. end;
  2206. procedure TCustomDirView.DDDropHandlerSucceeded(Sender: TObject;
  2207. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  2208. begin
  2209. DropTarget := nil;
  2210. end;
  2211. procedure TCustomDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer);
  2212. begin
  2213. if Assigned(FOnDDChooseEffect) then
  2214. FOnDDChooseEffect(Self, grfKeyState, dwEffect);
  2215. end;
  2216. procedure TCustomDirView.DDGiveFeedback(dwEffect: Integer;
  2217. var Result: HResult);
  2218. begin
  2219. if Assigned(FOnDDGiveFeedback) then
  2220. FOnDDGiveFeedback(Self, dwEffect, Result);
  2221. end;
  2222. procedure TCustomDirView.DDProcessDropped(Sender: TObject;
  2223. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  2224. begin
  2225. if DirOK and (not Loading) then
  2226. try
  2227. try
  2228. if Assigned(FOnDDProcessDropped) then
  2229. FOnDDProcessDropped(Self, grfKeyState, Point, dwEffect);
  2230. if dwEffect <> DROPEFFECT_NONE then
  2231. begin
  2232. PerformItemDragDropOperation(DropTarget, dwEffect, False);
  2233. if Assigned(FOnDDExecuted) then
  2234. FOnDDExecuted(Self, dwEffect);
  2235. end;
  2236. finally
  2237. DragDropFilesEx.FileList.Clear;
  2238. DropTarget := nil;
  2239. end;
  2240. except
  2241. Application.HandleException(Self);
  2242. end;
  2243. end;
  2244. function TCustomDirView.AnyFileSelected(
  2245. OnlyFocused: Boolean; FilesOnly: Boolean; FocusedFileOnlyWhenFocused: Boolean): Boolean;
  2246. var
  2247. Item: TListItem;
  2248. begin
  2249. if OnlyFocused or
  2250. ((SelCount = 0) and
  2251. ((not FocusedFileOnlyWhenFocused) or
  2252. (Focused and (GetParentForm(Self).Handle = GetForegroundWindow())))) then
  2253. begin
  2254. Result := Assigned(ItemFocused) and ItemIsFile(ItemFocused) and
  2255. ((not FilesOnly) or (not ItemIsDirectory(ItemFocused)));
  2256. end
  2257. else
  2258. begin
  2259. Result := True;
  2260. Item := GetNextItem(nil, sdAll, [isSelected]);
  2261. while Assigned(Item) do
  2262. begin
  2263. if ItemIsFile(Item) and
  2264. ((not FilesOnly) or (not ItemIsDirectory(Item))) then Exit;
  2265. Item := GetNextItem(Item, sdAll, [isSelected]);
  2266. end;
  2267. Result := False;
  2268. end;
  2269. end;
  2270. function TCustomDirView.CanEdit(Item: TListItem): Boolean;
  2271. begin
  2272. Result :=
  2273. (inherited CanEdit(Item) or FForceRename) and (not Loading) and
  2274. Assigned(Item) and (not ReadOnly) and (not IsRecycleBin) and
  2275. (not ItemIsParentDirectory(Item));
  2276. if Result then FLoadEnabled := False;
  2277. FForceRename := False;
  2278. end;
  2279. function TCustomDirView.CanChangeSelection(Item: TListItem;
  2280. Select: Boolean): Boolean;
  2281. begin
  2282. Result :=
  2283. (not Loading) and
  2284. not (Assigned(Item) and Assigned(Item.Data) and
  2285. ItemIsParentDirectory(Item));
  2286. end;
  2287. procedure TCustomDirView.Edit(const HItem: TLVItem);
  2288. var
  2289. Info: string;
  2290. Index: Integer;
  2291. begin
  2292. // When rename is confirmed by clicking outside of the edit box, and the actual rename operation
  2293. // displays error message or simply pumps a message queue (like during lenghty remote directory reload),
  2294. // drag mouse selection start. It posssibly happens only on the remote panel due to it being completelly reloaded.
  2295. ReleaseCapture;
  2296. if Length(HItem.pszText) = 0 then LoadEnabled := True
  2297. else
  2298. begin
  2299. {Does the changed filename contains invalid characters?}
  2300. if StrContains(FInvalidNameChars, HItem.pszText) then
  2301. begin
  2302. Info := FInvalidNameChars;
  2303. for Index := Length(Info) downto 1 do
  2304. System.Insert(Space, Info, Index);
  2305. MessageBeep(MB_ICONHAND);
  2306. if MessageDlg(SErrorInvalidName + Space + Info, mtError,
  2307. [mbOK, mbAbort], 0) = mrOK then RetryRename(HItem.pszText);
  2308. LoadEnabled := True;
  2309. end
  2310. else
  2311. begin
  2312. InternalEdit(HItem);
  2313. end;
  2314. end;
  2315. end; {Edit}
  2316. procedure TCustomDirView.EndSelectionUpdate;
  2317. begin
  2318. inherited;
  2319. if FUpdatingSelection = 0 then
  2320. DoUpdateStatusBar;
  2321. end; { EndUpdatingSelection }
  2322. procedure TCustomDirView.ExecuteCurrentFile;
  2323. begin
  2324. Assert(Assigned(ItemFocused));
  2325. Execute(ItemFocused, False);
  2326. end;
  2327. function TCustomDirView.DoExecFile(Item: TListItem; ForceEnter: Boolean): Boolean;
  2328. begin
  2329. Result := True;
  2330. if Assigned(FOnExecFile) then FOnExecFile(Self, Item, Result);
  2331. end;
  2332. procedure TCustomDirView.Execute(Item: TListItem; ForceEnter: Boolean);
  2333. begin
  2334. Assert(Assigned(Item));
  2335. if Assigned(Item) and Assigned(Item.Data) and (not Loading) then
  2336. begin
  2337. if IsRecycleBin and (not ItemIsParentDirectory(Item)) then DisplayPropertiesMenu
  2338. else
  2339. if DoExecFile(Item, ForceEnter) then
  2340. begin
  2341. if ItemIsParentDirectory(Item) then ExecuteParentDirectory
  2342. else ExecuteFile(Item);
  2343. end;
  2344. end;
  2345. end;
  2346. procedure TCustomDirView.GetDisplayInfo(ListItem: TListItem;
  2347. var DispInfo: TLVItem);
  2348. begin
  2349. // Nothing
  2350. end;
  2351. procedure TCustomDirView.WMUserRename(var Message: TMessage);
  2352. begin
  2353. if Assigned(ItemFocused) then
  2354. begin
  2355. FForceRename := True;
  2356. ListView_EditLabel(Handle, ItemFocused.Index);
  2357. SetWindowText(ListView_GetEditControl(Self.Handle),
  2358. PChar(FLastRenameName));
  2359. end;
  2360. end;
  2361. procedure TCustomDirView.RetryRename(NewName: string);
  2362. begin
  2363. FLastRenameName := NewName;
  2364. PostMessage(Self.Handle, WM_USER_RENAME, Longint(PChar(NewName)), 0);
  2365. end;
  2366. procedure TCustomDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2367. begin
  2368. FileList.AddItem(nil, ItemFullFileName(Item));
  2369. end;
  2370. procedure TCustomDirView.DDDragDetect(grfKeyState: Integer; DetectStart,
  2371. Point: TPoint; DragStatus: TDragDetectStatus);
  2372. var
  2373. FilesCount: Integer;
  2374. DirsCount: Integer;
  2375. Item: TListItem;
  2376. FirstItem : TListItem;
  2377. Bitmap: TBitmap;
  2378. ImageListHandle: HImageList;
  2379. Spot: TPoint;
  2380. ItemPos: TPoint;
  2381. DragText: string;
  2382. ClientPoint: TPoint;
  2383. FileListCreated: Boolean;
  2384. AvoidDragImage: Boolean;
  2385. DataObject: TDataObject;
  2386. begin
  2387. if Assigned(FOnDDDragDetect) then
  2388. FOnDDDragDetect(Self, grfKeyState, DetectStart, Point, DragStatus);
  2389. FLastDDResult := drCancelled;
  2390. if (DragStatus = ddsDrag) and (not Loading) and (MarkedCount > 0) then
  2391. begin
  2392. DragDropFilesEx.CompleteFileList := DragCompleteFileList;
  2393. DragDropFilesEx.FileList.Clear;
  2394. FirstItem := nil;
  2395. FilesCount := 0;
  2396. DirsCount := 0;
  2397. FileListCreated := False;
  2398. AvoidDragImage := False;
  2399. if Assigned(OnDDCreateDragFileList) then
  2400. begin
  2401. OnDDCreateDragFileList(Self, DragDropFilesEx.FileList, FileListCreated);
  2402. if FileListCreated then
  2403. begin
  2404. AvoidDragImage := True;
  2405. end;
  2406. end;
  2407. if not FileListCreated then
  2408. begin
  2409. if Assigned(ItemFocused) and (not ItemFocused.Selected) then
  2410. begin
  2411. if ItemCanDrag(ItemFocused) then
  2412. begin
  2413. FirstItem := ItemFocused;
  2414. AddToDragFileList(DragDropFilesEx.FileList, ItemFocused);
  2415. if ItemIsDirectory(ItemFocused) then Inc(DirsCount)
  2416. else Inc(FilesCount);
  2417. end;
  2418. end
  2419. else
  2420. if SelCount > 0 then
  2421. begin
  2422. Item := GetNextItem(nil, sdAll, [isSelected]);
  2423. while Assigned(Item) do
  2424. begin
  2425. if ItemCanDrag(Item) then
  2426. begin
  2427. if not Assigned(FirstItem) then FirstItem := Item;
  2428. AddToDragFileList(DragDropFilesEx.FileList, Item);
  2429. if ItemIsDirectory(Item) then Inc(DirsCount)
  2430. else Inc(FilesCount);
  2431. end;
  2432. Item := GetNextItem(Item, sdAll, [isSelected]);
  2433. end;
  2434. end;
  2435. end;
  2436. if DragDropFilesEx.FileList.Count > 0 then
  2437. begin
  2438. FDragEnabled := False;
  2439. {Create the dragimage:}
  2440. GlobalDragImageList := DragImageList;
  2441. // This code is not used anymore
  2442. if UseDragImages and (not AvoidDragImage) then
  2443. begin
  2444. ImageListHandle := ListView_CreateDragImage(Handle, FirstItem.Index, Spot);
  2445. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2446. if ImageListHandle <> Invalid_Handle_Value then
  2447. begin
  2448. GlobalDragImageList.Handle := ImageListHandle;
  2449. if FilesCount + DirsCount = 1 then
  2450. begin
  2451. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2452. GlobalDragImageList.SetDragImage(0,
  2453. DetectStart.X - ItemPos.X, DetectStart.Y - ItemPos.Y);
  2454. end
  2455. else
  2456. begin
  2457. GlobalDragImageList.Clear;
  2458. GlobalDragImageList.Width := 32;
  2459. GlobalDragImageList.Height := 32;
  2460. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES', 0,
  2461. [lrTransparent], $FFFFFF) Then
  2462. begin
  2463. Bitmap := TBitmap.Create;
  2464. try
  2465. try
  2466. GlobalDragImageList.GetBitmap(0, Bitmap);
  2467. Bitmap.Canvas.Font.Assign(Self.Font);
  2468. DragText := '';
  2469. if FilesCount > 0 then
  2470. DragText := Format(STextFiles, [FilesCount]);
  2471. if DirsCount > 0 then
  2472. begin
  2473. if FilesCount > 0 then
  2474. DragText := DragText + ', ';
  2475. DragText := DragText + Format(STextDirectories, [DirsCount]);
  2476. end;
  2477. Bitmap.Width := 33 + Bitmap.Canvas.TextWidth(DragText);
  2478. Bitmap.TransparentMode := tmAuto;
  2479. Bitmap.Canvas.TextOut(33,
  2480. Max(24 - Abs(Canvas.Font.Height), 0), DragText);
  2481. GlobalDragImageList.Clear;
  2482. GlobalDragImageList.Width := Bitmap.Width;
  2483. GlobalDragImageList.AddMasked(Bitmap,
  2484. Bitmap.Canvas.Pixels[0, 0]);
  2485. GlobalDragImageList.SetDragImage(0, 25, 20);
  2486. except
  2487. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES',
  2488. 0, [lrTransparent], $FFFFFF) then
  2489. GlobalDragImageList.SetDragImage(0, 25, 20);
  2490. end;
  2491. finally
  2492. Bitmap.Free;
  2493. end;
  2494. end;
  2495. end;
  2496. ClientPoint := ParentForm.ScreenToClient(Point);
  2497. GlobalDragImageList.BeginDrag(ParentForm.Handle,
  2498. ClientPoint.X, ClientPoint.Y);
  2499. GlobalDragImageList.HideDragImage;
  2500. ShowCursor(True);
  2501. end;
  2502. end;
  2503. FContextMenu := False;
  2504. if IsRecycleBin then DragDropFilesEx.SourceEffects := [deMove]
  2505. else DragDropFilesEx.SourceEffects := DragSourceEffects;
  2506. DropSourceControl := Self;
  2507. try
  2508. GetSystemTimeAsFileTime(FDragStartTime);
  2509. DataObject := nil;
  2510. if Assigned(OnDDCreateDataObject) then
  2511. begin
  2512. OnDDCreateDataObject(Self, DataObject);
  2513. end;
  2514. {Execute the drag&drop-Operation:}
  2515. FLastDDResult := DragDropFilesEx.Execute(DataObject);
  2516. // The drag&drop operation is finished, so clean up the used drag image.
  2517. // This also restores the default mouse cursor
  2518. // (which is set to "none" in GlobalDragImageList.BeginDrag above)
  2519. // But it's actually too late, we would need to do it when mouse button
  2520. // is realesed already. Otherwise the cursor is hidden when hovering over
  2521. // main window, while target application is processing dropped file
  2522. // (particularly when Explorer displays progress window or
  2523. // overwrite confirmation prompt)
  2524. GlobalDragImageList.EndDrag;
  2525. GlobalDragImageList.Clear;
  2526. Application.ProcessMessages;
  2527. finally
  2528. DragDropFilesEx.FileList.Clear;
  2529. FContextMenu := False;
  2530. try
  2531. if Assigned(OnDDEnd) then
  2532. OnDDEnd(Self);
  2533. finally
  2534. DropTarget := nil;
  2535. DropSourceControl := nil;
  2536. end;
  2537. end;
  2538. end;
  2539. end;
  2540. end;
  2541. procedure TCustomDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2542. begin
  2543. inherited;
  2544. if Operation = opRemove then
  2545. begin
  2546. if AComponent = PathLabel then FPathLabel := nil;
  2547. end;
  2548. end; { Notification }
  2549. procedure TCustomDirView.WMAppCommand(var Message: TMessage);
  2550. var
  2551. Command: Integer;
  2552. Shift: TShiftState;
  2553. begin
  2554. Command := HiWord(Message.lParam) and (not FAPPCOMMAND_MASK);
  2555. Shift := KeyDataToShiftState(HiWord(Message.lParam) and FAPPCOMMAND_MASK);
  2556. if Shift * [ssShift, ssAlt, ssCtrl] = [] then
  2557. begin
  2558. if Command = APPCOMMAND_BROWSER_BACKWARD then
  2559. begin
  2560. Message.Result := 1;
  2561. if BackCount >= 1 then DoHistoryGo(-1);
  2562. end
  2563. else
  2564. if Command = APPCOMMAND_BROWSER_FORWARD then
  2565. begin
  2566. Message.Result := 1;
  2567. if ForwardCount >= 1 then DoHistoryGo(1);
  2568. end
  2569. else
  2570. if Command = APPCOMMAND_BROWSER_REFRESH then
  2571. begin
  2572. Message.Result := 1;
  2573. BusyOperation(ReloadDirectory);
  2574. end
  2575. else
  2576. if Command = APPCOMMAND_BROWSER_HOME then
  2577. begin
  2578. Message.Result := 1;
  2579. BusyOperation(ExecuteHomeDirectory);
  2580. end
  2581. else inherited;
  2582. end
  2583. else inherited;
  2584. end;
  2585. procedure TCustomDirView.CMColorChanged(var Message: TMessage);
  2586. begin
  2587. inherited;
  2588. ForceColorChange(Self);
  2589. end;
  2590. function TCustomDirView.FindFileItem(FileName: string): TListItem;
  2591. type
  2592. TFileNameCompare = function(const S1, S2: string): Integer;
  2593. var
  2594. Index: Integer;
  2595. CompareFunc: TFileNameCompare;
  2596. begin
  2597. if FCaseSensitive then CompareFunc := CompareStr
  2598. else CompareFunc := CompareText;
  2599. for Index := 0 to Items.Count - 1 do
  2600. begin
  2601. if CompareFunc(FileName, ItemFileName(Items[Index])) = 0 then
  2602. begin
  2603. Result := Items[Index];
  2604. Exit;
  2605. end;
  2606. end;
  2607. Result := nil;
  2608. end;
  2609. function TCustomDirView.GetForwardCount: Integer;
  2610. begin
  2611. Result := FHistoryPaths.Count - BackCount;
  2612. end; { GetForwardCount }
  2613. procedure TCustomDirView.LimitHistorySize;
  2614. begin
  2615. while FHistoryPaths.Count > MaxHistoryCount do
  2616. begin
  2617. if BackCount > 0 then
  2618. begin
  2619. FHistoryPaths.Delete(0);
  2620. Dec(FBackCount);
  2621. end
  2622. else
  2623. FHistoryPaths.Delete(FHistoryPaths.Count-1);
  2624. end;
  2625. end; { LimitHistorySize }
  2626. function TCustomDirView.GetHistoryPath(Index: Integer): string;
  2627. begin
  2628. Assert(Assigned(FHistoryPaths));
  2629. if Index = 0 then Result := PathName
  2630. else
  2631. if Index < 0 then Result := FHistoryPaths[Index + BackCount]
  2632. else
  2633. if Index > 0 then Result := FHistoryPaths[Index + BackCount - 1];
  2634. end; { GetHistoryPath }
  2635. procedure TCustomDirView.SetMaxHistoryCount(Value: Integer);
  2636. begin
  2637. if FMaxHistoryCount <> Value then
  2638. begin
  2639. FMaxHistoryCount := Value;
  2640. DoHistoryChange;
  2641. end;
  2642. end; { SetMaxHistoryCount }
  2643. procedure TCustomDirView.DoHistoryChange;
  2644. begin
  2645. LimitHistorySize;
  2646. if Assigned(OnHistoryChange) then
  2647. OnHistoryChange(Self);
  2648. end; { DoHistoryChange }
  2649. procedure TCustomDirView.DoHistoryGo(Index: Integer);
  2650. var
  2651. Cancel: Boolean;
  2652. begin
  2653. if StartBusy then
  2654. try
  2655. Cancel := False;
  2656. if Assigned(OnHistoryGo) then
  2657. OnHistoryGo(Self, Index, Cancel);
  2658. if not Cancel then HistoryGo(Index);
  2659. finally
  2660. EndBusy;
  2661. end;
  2662. end;
  2663. procedure TCustomDirView.HistoryGo(Index: Integer);
  2664. var
  2665. PrevPath: string;
  2666. begin
  2667. if Index <> 0 then
  2668. begin
  2669. PrevPath := FHistoryPath;
  2670. FDontRecordPath := True;
  2671. try
  2672. Path := HistoryPath[Index];
  2673. finally
  2674. FDontRecordPath := False;
  2675. end;
  2676. FHistoryPaths.Insert(FBackCount, PrevPath);
  2677. FHistoryPaths.Delete(Index + BackCount);
  2678. Inc(FBackCount, Index);
  2679. DoHistoryChange;
  2680. end;
  2681. end; { HistoryGo }
  2682. procedure TCustomDirView.PathChanging(Relative: Boolean);
  2683. begin
  2684. if Relative then FLastPath := PathName
  2685. else FLastPath := '';
  2686. FSavedNames.Clear;
  2687. end;
  2688. procedure TCustomDirView.PathChanged;
  2689. var
  2690. Index: Integer;
  2691. begin
  2692. if Assigned(OnPathChange) then
  2693. OnPathChange(Self);
  2694. if (not FDontRecordPath) and (FHistoryPath <> '') and (FHistoryPath <> PathName) then
  2695. begin
  2696. Assert(Assigned(FHistoryPaths));
  2697. for Index := FHistoryPaths.Count - 1 downto BackCount do
  2698. FHistoryPaths.Delete(Index);
  2699. FHistoryPaths.Add(FHistoryPath);
  2700. Inc(FBackCount);
  2701. DoHistoryChange;
  2702. end;
  2703. FHistoryPath := PathName;
  2704. end; { PathChanged }
  2705. procedure TCustomDirView.ProcessChangedFiles(DirView: TCustomDirView;
  2706. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  2707. Criterias: TCompareCriterias);
  2708. var
  2709. Item, MirrorItem: TListItem;
  2710. FileTime, MirrorFileTime: TDateTime;
  2711. OldCursor: TCursor;
  2712. Index: Integer;
  2713. Changed: Boolean;
  2714. SameTime: Boolean;
  2715. Precision, MirrorPrecision: TDateTimePrecision;
  2716. begin
  2717. Assert(Valid);
  2718. OldCursor := Screen.Cursor;
  2719. if not Assigned(FileList) then
  2720. begin
  2721. Items.BeginUpdate;
  2722. BeginSelectionUpdate;
  2723. end;
  2724. try
  2725. Screen.Cursor := crHourGlass;
  2726. for Index := 0 to Items.Count-1 do
  2727. begin
  2728. Item := Items[Index];
  2729. Changed := False;
  2730. if not ItemIsDirectory(Item) then
  2731. begin
  2732. MirrorItem := DirView.FindFileItem(ItemFileName(Item));
  2733. if MirrorItem = nil then
  2734. begin
  2735. Changed := not ExistingOnly;
  2736. end
  2737. else
  2738. begin
  2739. if ccTime in Criterias then
  2740. begin
  2741. FileTime := ItemFileTime(Item, Precision);
  2742. MirrorFileTime := DirView.ItemFileTime(MirrorItem, MirrorPrecision);
  2743. if MirrorPrecision < Precision then Precision := MirrorPrecision;
  2744. if Precision <> tpMillisecond then
  2745. begin
  2746. ReduceDateTimePrecision(FileTime, Precision);
  2747. ReduceDateTimePrecision(MirrorFileTime, Precision);
  2748. end;
  2749. SameTime := (FileTime = MirrorFileTime);
  2750. if Precision = tpSecond then
  2751. begin
  2752. // 1 ms more solves the rounding issues
  2753. // (see also Common.cpp)
  2754. MirrorFileTime := MirrorFileTime + EncodeTime(0, 0, 1, 1);
  2755. end;
  2756. Changed :=
  2757. (FileTime > MirrorFileTime);
  2758. end
  2759. else
  2760. begin
  2761. SameTime := True;
  2762. end;
  2763. if (not Changed) and SameTime and (ccSize in Criterias) then
  2764. begin
  2765. Changed := ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem);
  2766. end
  2767. end;
  2768. end;
  2769. if Assigned(FileList) then
  2770. begin
  2771. if Changed then
  2772. begin
  2773. if FullPath then
  2774. begin
  2775. FileList.AddObject(ItemFullFileName(Item), Item.Data)
  2776. end
  2777. else
  2778. begin
  2779. FileList.AddObject(ItemFileName(Item), Item.Data);
  2780. end;
  2781. end;
  2782. end
  2783. else
  2784. begin
  2785. Item.Selected := Changed;
  2786. end;
  2787. end;
  2788. finally
  2789. Screen.Cursor := OldCursor;
  2790. if not Assigned(FileList) then
  2791. begin
  2792. Items.EndUpdate;
  2793. EndSelectionUpdate;
  2794. end;
  2795. end;
  2796. end;
  2797. function TCustomDirView.CreateChangedFileList(DirView: TCustomDirView;
  2798. FullPath: Boolean; ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  2799. begin
  2800. Result := TStringList.Create;
  2801. try
  2802. ProcessChangedFiles(DirView, Result, FullPath, ExistingOnly, Criterias);
  2803. except
  2804. FreeAndNil(Result);
  2805. raise;
  2806. end;
  2807. end;
  2808. function TCustomDirView.CanPasteFromClipBoard: Boolean;
  2809. begin
  2810. Result := False;
  2811. if DirOK and (Path <> '') and Windows.OpenClipboard(0) then
  2812. begin
  2813. Result := IsClipboardFormatAvailable(CF_HDROP);
  2814. Windows.CloseClipBoard;
  2815. end;
  2816. end; {CanPasteFromClipBoard}
  2817. procedure TCustomDirView.CompareFiles(DirView: TCustomDirView;
  2818. ExistingOnly: Boolean; Criterias: TCompareCriterias);
  2819. begin
  2820. ProcessChangedFiles(DirView, nil, True, ExistingOnly, Criterias);
  2821. end;
  2822. function TCustomDirView.GetColumnText(ListItem: TListItem; Index: Integer): string;
  2823. var
  2824. DispInfo: TLVItem;
  2825. begin
  2826. FillChar(DispInfo, SizeOf(DispInfo), 0);
  2827. DispInfo.Mask := LVIF_TEXT;
  2828. DispInfo.iSubItem := Index;
  2829. DispInfo.cchTextMax := 260;
  2830. SetLength(Result, DispInfo.cchTextMax);
  2831. DispInfo.pszText := PChar(Result);
  2832. GetDisplayInfo(ListItem, DispInfo);
  2833. SetLength(Result, StrLen(PChar(Result)));
  2834. end;
  2835. procedure TCustomDirView.FocusSomething;
  2836. begin
  2837. if FSavedSelection then FPendingFocusSomething := True
  2838. else inherited;
  2839. end;
  2840. procedure TCustomDirView.SaveSelection;
  2841. var
  2842. Closest: TListItem;
  2843. begin
  2844. Assert(not FSavedSelection);
  2845. FSavedSelectionFile := '';
  2846. FSavedSelectionLastFile := '';
  2847. if Assigned(ItemFocused) then
  2848. begin
  2849. FSavedSelectionLastFile := ItemFocused.Caption;
  2850. end;
  2851. Closest := ClosestUnselected(ItemFocused);
  2852. if Assigned(Closest) then
  2853. begin
  2854. FSavedSelectionFile := Closest.Caption;
  2855. end;
  2856. FSavedSelection := True;
  2857. end;
  2858. procedure TCustomDirView.RestoreSelection;
  2859. var
  2860. ItemToSelect: TListItem;
  2861. begin
  2862. Assert(FSavedSelection);
  2863. FSavedSelection := False;
  2864. if (FSavedSelectionLastFile <> '') and
  2865. ((not Assigned(ItemFocused)) or
  2866. (ItemFocused.Caption <> FSavedSelectionLastFile)) then
  2867. begin
  2868. ItemToSelect := FindFileItem(FSavedSelectionFile);
  2869. if Assigned(ItemToSelect) then
  2870. begin
  2871. ItemFocused := ItemToSelect;
  2872. end;
  2873. end;
  2874. if not Assigned(ItemFocused) then FocusSomething
  2875. else ItemFocused.MakeVisible(False);
  2876. end;
  2877. procedure TCustomDirView.DiscardSavedSelection;
  2878. begin
  2879. Assert(FSavedSelection);
  2880. FSavedSelection := False;
  2881. if FPendingFocusSomething then
  2882. begin
  2883. FPendingFocusSomething := False;
  2884. FocusSomething;
  2885. end;
  2886. end;
  2887. procedure TCustomDirView.SaveSelectedNames;
  2888. var
  2889. Index: Integer;
  2890. Item: TListItem;
  2891. begin
  2892. FSavedNames.Clear;
  2893. FSavedNames.CaseSensitive := FCaseSensitive;
  2894. if SelCount > 0 then // optimalisation
  2895. begin
  2896. for Index := 0 to Items.Count-1 do
  2897. begin
  2898. Item := Items[Index];
  2899. if Item.Selected then
  2900. FSavedNames.Add(ItemFileName(Item));
  2901. end;
  2902. end;
  2903. // as optimalisation the list is sorted only when the selection is restored
  2904. end;
  2905. procedure TCustomDirView.RestoreSelectedNames;
  2906. var
  2907. Index, FoundIndex: Integer;
  2908. Item: TListItem;
  2909. begin
  2910. FSavedNames.Sort;
  2911. for Index := 0 to Items.Count - 1 do
  2912. begin
  2913. Item := Items[Index];
  2914. Item.Selected := FSavedNames.Find(ItemFileName(Item), FoundIndex);
  2915. end;
  2916. end;
  2917. function TCustomDirView.GetSelectedNamesSaved: Boolean;
  2918. begin
  2919. Result := (FSavedNames.Count > 0);
  2920. end;
  2921. procedure TCustomDirView.ContinueSession(Continue: Boolean);
  2922. begin
  2923. if Continue then FLastPath := PathName
  2924. else FLastPath := '';
  2925. end;
  2926. function TCustomDirView.SaveState: TObject;
  2927. var
  2928. State: TDirViewState;
  2929. DirColProperties: TCustomDirViewColProperties;
  2930. begin
  2931. State := TDirViewState.Create;
  2932. State.HistoryPaths := TStringList.Create;
  2933. State.HistoryPaths.Assign(FHistoryPaths);
  2934. State.BackCount := FBackCount;
  2935. // TCustomDirViewColProperties should not be here
  2936. DirColProperties := ColProperties as TCustomDirViewColProperties;
  2937. Assert(Assigned(DirColProperties));
  2938. State.SortStr := DirColProperties.SortStr;
  2939. State.Mask := Mask;
  2940. if Assigned(ItemFocused) then State.FocusedItem := ItemFocused.Caption
  2941. else State.FocusedItem := '';
  2942. Result := State;
  2943. end;
  2944. procedure TCustomDirView.RestoreState(AState: TObject);
  2945. var
  2946. State: TDirViewState;
  2947. DirColProperties: TCustomDirViewColProperties;
  2948. ListItem: TListItem;
  2949. begin
  2950. Assert(AState is TDirViewState);
  2951. State := AState as TDirViewState;
  2952. Assert(Assigned(State));
  2953. if Assigned(State.HistoryPaths) then
  2954. FHistoryPaths.Assign(State.HistoryPaths);
  2955. FBackCount := State.BackCount;
  2956. DoHistoryChange;
  2957. if State.SortStr <> '' then
  2958. begin
  2959. // TCustomDirViewColProperties should not be here
  2960. DirColProperties := ColProperties as TCustomDirViewColProperties;
  2961. Assert(Assigned(DirColProperties));
  2962. DirColProperties.SortStr := State.SortStr;
  2963. end;
  2964. Mask := State.Mask;
  2965. if State.FocusedItem <> '' then
  2966. begin
  2967. ListItem := FindFileItem(State.FocusedItem);
  2968. if Assigned(ListItem) then
  2969. begin
  2970. ItemFocused := ListItem;
  2971. ListItem.MakeVisible(False);
  2972. end;
  2973. end;
  2974. end;
  2975. procedure TCustomDirView.ClearState;
  2976. begin
  2977. FHistoryPaths.Clear;
  2978. FBackCount := 0;
  2979. DoHistoryChange;
  2980. end;
  2981. procedure TCustomDirView.SetMask(Value: string);
  2982. begin
  2983. if Mask <> Value then
  2984. begin
  2985. FMask := Value;
  2986. UpdatePathLabel;
  2987. if DirOK then Reload(False);
  2988. end;
  2989. end;{SetMask}
  2990. procedure TCustomDirView.SetNaturalOrderNumericalSorting(Value: Boolean);
  2991. begin
  2992. if NaturalOrderNumericalSorting <> Value then
  2993. begin
  2994. FNaturalOrderNumericalSorting := Value;
  2995. SortItems;
  2996. end;
  2997. end;
  2998. procedure TCustomDirView.SetDarkMode(Value: Boolean);
  2999. begin
  3000. if DarkMode <> Value then
  3001. begin
  3002. FDarkMode := Value;
  3003. // Call only when switching to dark more and when switching back to the light mode.
  3004. // But not for initial light mode - To reduce an impact of calling an undocumented function.
  3005. if HandleAllocated then UpdateDarkMode;
  3006. end;
  3007. end;
  3008. // WM_SETFOCUS works even when focus is moved to another window/app,
  3009. // while .Enter works only when focus is moved to other control of the same window.
  3010. procedure TCustomDirView.WMSetFocus(var Message: TWMSetFocus);
  3011. begin
  3012. inherited;
  3013. EnsureSelectionRedrawn;
  3014. UpdatePathLabel;
  3015. end;
  3016. procedure TCustomDirView.WMKillFocus(var Message: TWMKillFocus);
  3017. begin
  3018. inherited;
  3019. EnsureSelectionRedrawn;
  3020. UpdatePathLabel;
  3021. end;
  3022. procedure TCustomDirView.EnsureSelectionRedrawn;
  3023. begin
  3024. // WORKAROUND
  3025. // when receiving/losing focus, selection is not redrawn in report view
  3026. // (except for focus item selection),
  3027. // probably when double buffering is enabled (LVS_EX_DOUBLEBUFFER).
  3028. // But even without LVS_EX_DOUBLEBUFFER, selection behind file icon is not updated.
  3029. if ViewStyle = vsReport then
  3030. begin
  3031. if (SelCount >= 2) or ((SelCount >= 1) and ((not Assigned(ItemFocused)) or (not ItemFocused.Selected))) then
  3032. begin
  3033. Invalidate;
  3034. end
  3035. else
  3036. if Assigned(ItemFocused) and ItemFocused.Selected then
  3037. begin
  3038. // Optimization. When no item is selected, redraw just the focused item.
  3039. ItemFocused.Update;
  3040. end;
  3041. end;
  3042. end;
  3043. function TCustomDirView.DoBusy(Busy: Integer): Boolean;
  3044. begin
  3045. Result := True;
  3046. if Assigned(OnBusy) then
  3047. begin
  3048. OnBusy(Self, Busy, Result);
  3049. end;
  3050. end;
  3051. function TCustomDirView.StartBusy: Boolean;
  3052. begin
  3053. Result := DoBusy(1);
  3054. end;
  3055. function TCustomDirView.IsBusy: Boolean;
  3056. begin
  3057. Result := DoBusy(0);
  3058. end;
  3059. procedure TCustomDirView.EndBusy;
  3060. begin
  3061. DoBusy(-1);
  3062. end;
  3063. procedure TCustomDirView.BusyOperation(Operation: TBusyOperation);
  3064. begin
  3065. if StartBusy then
  3066. try
  3067. Operation;
  3068. finally
  3069. EndBusy;
  3070. end;
  3071. end;
  3072. initialization
  3073. DropSourceControl := nil;
  3074. SetLength(WinDir, MAX_PATH);
  3075. SetLength(WinDir, GetWindowsDirectory(PChar(WinDir), MAX_PATH));
  3076. SetLength(TempDir, MAX_PATH);
  3077. SetLength(TempDir, GetTempPath(MAX_PATH, PChar(TempDir)));
  3078. SpecialFolderLocation(CSIDL_PERSONAL, UserDocumentDirectory);
  3079. WinDir := IncludeTrailingPathDelimiter(WinDir);
  3080. TempDir := IncludeTrailingPathDelimiter(TempDir);
  3081. finalization
  3082. SetLength(StdDirTypeName, 0);
  3083. SetLength(WinDir, 0);
  3084. SetLength(TempDir, 0);
  3085. end.