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