CustomDirView.pas 102 KB

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