CustomDirView.pas 89 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883
  1. unit CustomDirView;
  2. interface
  3. {$R DirImg.res}
  4. {$WARN UNIT_PLATFORM OFF}
  5. uses
  6. Windows, Messages, Classes, Graphics, Controls,
  7. Forms, ComCtrls, ShellAPI, ComObj, ShlObj, Dialogs,
  8. ActiveX, CommCtrl, Extctrls, ImgList, Menus,
  9. PIDL, BaseUtils, DragDrop, DragDropFilesEx, IEDriveInfo,
  10. IEListView, PathLabel, AssociatedStatusBar, CustomPathComboBox, SysUtils;
  11. const
  12. clDefaultItemColor = -(COLOR_ENDCOLORS + 1);
  13. WM_USER_RENAME = WM_USER + 57;
  14. oiNoOverlay = $00;
  15. oiDirUp = $01;
  16. oiLink = $02;
  17. oiBrokenLink = $04;
  18. oiShared = $08;
  19. DefaultHistoryMenuWidth = 300;
  20. DefaultHistoryMenuLen = 9;
  21. DefaultHistoryCount = 200;
  22. const
  23. DDMaxSlowCount = 3;
  24. DDVScrollDelay = 2000000;
  25. DDHScrollDelay = 2000000;
  26. DDDragStartDelay = 500000;
  27. DirAttrMask = SysUtils.faDirectory or SysUtils.faSysFile or SysUtils.faHidden;
  28. type
  29. {Drag&Drop events:}
  30. TDDError = (DDCreateShortCutError, DDPathNotFoundError);
  31. TDDOnDragEnter = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint; var Accept: Boolean) of object;
  32. TDDOnDragLeave = procedure(Sender: TObject) of object;
  33. TDDOnDragOver = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  34. TDDOnDrop = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  35. TDDOnQueryContinueDrag = procedure(Sender: TObject; FEscapePressed: BOOL; grfKeyState: Longint; var Result: HResult) of object;
  36. TDDOnGiveFeedback = procedure(Sender: TObject; dwEffect: Longint; var Result: HResult) of object;
  37. TDDOnDragDetect = procedure(Sender: TObject; grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus) of object;
  38. TDDOnCreateDragFileList = procedure(Sender: TObject; FileList: TFileList; var Created: Boolean) of object;
  39. TDDOnCreateDataObject = procedure(Sender: TObject; var DataObject: TDataObject) of object;
  40. TDDOnTargetHasDropHandler = procedure(Sender: TObject; Item: TListItem; var Effect: Integer; var DropHandler: Boolean) of object;
  41. TOnProcessDropped = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  42. TDDErrorEvent = procedure(Sender: TObject; ErrorNo: TDDError) of object;
  43. TDDExecutedEvent = procedure(Sender: TObject; dwEffect: Longint) of object;
  44. TDDFileOperationEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string;
  45. var DoOperation: Boolean) of object;
  46. TDDFileOperationExecutedEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string) of object;
  47. TDirViewExecFileEvent = procedure(Sender: TObject; Item: TListItem; var AllowExec: Boolean) of object;
  48. TRenameEvent = procedure(Sender: TObject; Item: TListItem; NewName: string) of object;
  49. type
  50. TCustomDirView = class;
  51. TSelAttr = (selDontCare, selYes, selNo);
  52. TFileFilter = record
  53. Masks: string;
  54. IncludeAttr: Word; { see TSearchRec.Attr }
  55. ExcludeAttr: Word;
  56. Directories: Boolean;
  57. FileSizeFrom: Int64;
  58. FileSizeTo: Int64;
  59. ModificationFrom: TDateTime;
  60. ModificationTo: TDateTime;
  61. end;
  62. THistoryDirection = (hdBack, hdForward);
  63. THistoryChangeEvent = procedure(Sender: TCustomDirView) of object;
  64. TDVGetFilterEvent = procedure(Sender: TCustomDirView; Select: Boolean;
  65. var Filter: TFileFilter) of object;
  66. TCompareCriteria = (ccTime, ccSize);
  67. TCompareCriterias = set of TCompareCriteria;
  68. TCustomizableDragDropFilesEx = class(TDragDropFilesEx)
  69. public
  70. function Execute(DataObject: TDataObject): TDragResult;
  71. end;
  72. TCustomDirView = class(TIEListView)
  73. private
  74. FAddParentDir: Boolean;
  75. FDimmHiddenFiles: Boolean;
  76. FShowDirectories: Boolean;
  77. FDirsOnTop: Boolean;
  78. FShowSubDirSize: Boolean;
  79. FSortByExtension: Boolean;
  80. FWantUseDragImages: Boolean;
  81. FCanUseDragImages: Boolean;
  82. FDragDropFilesEx: TCustomizableDragDropFilesEx;
  83. FInvalidNameChars: string;
  84. FSingleClickToExec: Boolean;
  85. FUseSystemContextMenu: Boolean;
  86. FOnGetSelectFilter: TDVGetFilterEvent;
  87. FOnStartLoading: TNotifyEvent;
  88. FOnLoaded: TNotifyEvent;
  89. FOnDirUpdated: TNotifyEvent;
  90. FReloadTime: TSystemTime;
  91. FDragDrive: TDrive;
  92. FExeDrag: Boolean;
  93. FDDLinkOnExeDrag: Boolean;
  94. FOnDDDragEnter: TDDOnDragEnter;
  95. FOnDDDragLeave: TDDOnDragLeave;
  96. FOnDDDragOver: TDDOnDragOver;
  97. FOnDDDrop: TDDOnDrop;
  98. FOnDDQueryContinueDrag: TDDOnQueryContinueDrag;
  99. FOnDDGiveFeedback: TDDOnGiveFeedback;
  100. FOnDDDragDetect: TDDOnDragDetect;
  101. FOnDDCreateDragFileList: TDDOnCreateDragFileList;
  102. FOnDDProcessDropped: TOnProcessDropped;
  103. FOnDDError: TDDErrorEvent;
  104. FOnDDExecuted: TDDExecutedEvent;
  105. FOnDDFileOperation: TDDFileOperationEvent;
  106. FOnDDFileOperationExecuted: TDDFileOperationExecutedEvent;
  107. FOnDDEnd: TNotifyEvent;
  108. FOnDDCreateDataObject: TDDOnCreateDataObject;
  109. FOnDDTargetHasDropHandler: TDDOnTargetHasDropHandler;
  110. FOnDDMenuPopup: TOnMenuPopup;
  111. FOnExecFile: TDirViewExecFileEvent;
  112. FForceRename: Boolean;
  113. FLastDDResult: TDragResult;
  114. FLastRenameName: string;
  115. FLastVScrollTime: TFileTime;
  116. FVScrollCount: Integer;
  117. FContextMenu: Boolean;
  118. FDragEnabled: Boolean;
  119. FDragPos: TPoint;
  120. FStartPos: TPoint;
  121. FDDOwnerIsSource: Boolean;
  122. FAbortLoading: Boolean;
  123. FAnimation: TAnimate;
  124. FBackCount: Integer;
  125. FBackMenu: TPopupMenu;
  126. FDontRecordPath: Boolean;
  127. FDragOnDriveIsMove: Boolean;
  128. FNotifyEnabled: Boolean;
  129. FDragStartTime: TFileTime;
  130. FForwardMenu: TPopupMenu;
  131. FHistoryPaths: TStrings;
  132. FImageList16: TImageList;
  133. FImageList32: TImageList;
  134. FLoadAnimation: Boolean;
  135. FMaxHistoryCount: Integer;
  136. FMaxHistoryMenuLen: Integer;
  137. FMaxHistoryMenuWidth: Integer;
  138. FNeverPainted: Boolean;
  139. FPathComboBox: TCustomPathComboBox;
  140. FPathLabel: TCustomPathLabel;
  141. FStatusBar: TAssociatedStatusBar;
  142. FOnBeginRename: TRenameEvent;
  143. FOnEndRename: TRenameEvent;
  144. FOnHistoryChange: THistoryChangeEvent;
  145. FShowHiddenFiles: Boolean;
  146. FSavedSelection: Boolean;
  147. FSavedSelectionFile: string;
  148. FSavedSelectionLastFile: string;
  149. FPendingFocusSomething: Boolean;
  150. procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  151. procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  152. procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  153. procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  154. procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  155. procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  156. procedure DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem;
  157. State: TCustomDrawState; var DefaultDraw: Boolean);
  158. procedure DumbCustomDrawSubItem(Sender: TCustomListView;
  159. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  160. var DefaultDraw: Boolean);
  161. function GetBackMenu: TPopupMenu;
  162. function GetFilesMarkedSize: Int64;
  163. function GetForwardCount: Integer;
  164. function GetForwardMenu: TPopupMenu;
  165. function GetHistoryPath(Index: Integer): string;
  166. function GetTargetPopupMenu: Boolean;
  167. function GetUseDragImages: Boolean;
  168. procedure SetMaxHistoryCount(Value: Integer);
  169. procedure SetMaxHistoryMenuLen(Value: Integer);
  170. procedure SetMaxHistoryMenuWidth(Value: Integer);
  171. procedure SetPathComboBox(Value: TCustomPathComboBox);
  172. procedure SetPathLabel(Value: TCustomPathLabel);
  173. procedure SetStatusBar(Value: TAssociatedStatusBar);
  174. procedure SetTargetPopupMenu(Value: Boolean);
  175. procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  176. procedure WMUserRename(var Message: TMessage); message WM_User_Rename;
  177. protected
  178. FCaseSensitive: Boolean;
  179. FDirty: Boolean;
  180. FFilesSize: Int64;
  181. FFilesSelSize: Int64;
  182. FHasParentDir: Boolean;
  183. FIsRecycleBin: Boolean;
  184. FLastPath: string;
  185. FLoadEnabled: Boolean;
  186. FLoading: Boolean;
  187. FSelectFile: string;
  188. FWatchForChanges: Boolean;
  189. procedure AddToDragFileList(FileList: TFileList; Item: TListItem); virtual;
  190. function CanEdit(Item: TListItem): Boolean; override;
  191. function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; override;
  192. procedure ClearItems; override;
  193. function GetDirOK: Boolean; virtual; abstract;
  194. procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus); virtual;
  195. procedure DDDragEnter(DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  196. procedure DDDragLeave;
  197. procedure DDDragOver(grfKeyState: Longint; Point: TPoint; var dwEffect: Longint);
  198. procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); virtual; abstract;
  199. procedure DDDrop(DataObj: IDataObject; grfKeyState: LongInt; Point: TPoint; var dwEffect: Longint);
  200. procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint; Point: TPoint; dwEffect: Longint); virtual;
  201. procedure DDGiveFeedback(dwEffect: Longint; var Result: HResult); virtual;
  202. procedure DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  203. AMinCustCmd:integer; grfKeyState: Longint; pt: TPoint);
  204. procedure DDMenuDone(Sender: TObject; AMenu: HMenu); virtual;
  205. procedure DDProcessDropped(Sender: TObject; grfKeyState: Longint;
  206. Point: TPoint; dwEffect: Longint);
  207. procedure DDQueryContinueDrag(FEscapePressed: LongBool;
  208. grfKeyState: Longint; var Result: HResult); virtual;
  209. procedure DDSpecifyDropTarget(Sender: TObject; DragDropHandler: Boolean;
  210. Point: TPoint; var pidlFQ : PItemIDList; var Filename: string); virtual;
  211. procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItemA); virtual;
  212. function GetDragSourceEffects: TDropEffectSet; virtual;
  213. function GetPathName: string; virtual; abstract;
  214. function GetFilesCount: Integer; virtual;
  215. procedure ColClick(Column: TListColumn); override;
  216. procedure CreateWnd; override;
  217. function CustomCreateFileList(Focused, OnlyFocused: Boolean;
  218. FullPath: Boolean; FileList: TStrings = nil): TStrings;
  219. function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  220. Stage: TCustomDrawStage): Boolean; override;
  221. function CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  222. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; override;
  223. procedure CustomSortItems(SortProc: Pointer);
  224. procedure Delete(Item: TListItem); override;
  225. procedure DisplayContextMenu(Where: TPoint); virtual; abstract;
  226. procedure DoAnimation(Start: Boolean);
  227. procedure DoHistoryChange; dynamic;
  228. function DragCompleteFileList: Boolean; virtual;
  229. procedure Edit(const HItem: TLVItem); override;
  230. procedure EndSelectionUpdate; override;
  231. procedure Execute(Item: TListItem); virtual;
  232. procedure ExecuteFile(Item: TListItem); virtual; abstract;
  233. procedure FocusSomething; override;
  234. function GetIsRoot: Boolean; virtual; abstract;
  235. procedure IconsSetImageList; virtual;
  236. function ItemCanDrag(Item: TListItem): Boolean; virtual;
  237. function ItemColor(Item: TListItem): TColor; virtual;
  238. function ItemDragFileName(Item: TListItem): string; virtual;
  239. function ItemFileSize(Item: TListItem): Int64; virtual; abstract;
  240. function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; virtual; abstract;
  241. function ItemFileTime(Item: TListItem; var Precision: TDateTimePrecision): TDateTime; virtual; abstract;
  242. // ItemIsDirectory and ItemFullFileName is in public block
  243. function ItemIsRecycleBin(Item: TListItem): Boolean; virtual;
  244. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  245. procedure KeyPress(var Key: Char); override;
  246. procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  247. procedure LoadFiles; virtual; abstract;
  248. procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer); virtual; abstract;
  249. procedure ProcessChangedFiles(DirView: TCustomDirView;
  250. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  251. Criterias: TCompareCriterias);
  252. procedure ReloadForce(CacheIcons : Boolean);
  253. procedure RetryRename(NewName: string);
  254. procedure SelectFiles(Filter: TFileFilter; Select: Boolean);
  255. procedure SetAddParentDir(Value: Boolean); virtual;
  256. procedure SetDimmHiddenFiles(Value: Boolean); virtual;
  257. procedure SetShowDirectories(Value: Boolean); virtual;
  258. procedure SetDirsOnTop(Value: Boolean);
  259. procedure SetItemImageIndex(Item: TListItem; Index: Integer); virtual; abstract;
  260. procedure SetLoadEnabled(Enabled : Boolean); virtual;
  261. procedure SetMultiSelect(Value: Boolean); override; //CLEAN virtual
  262. function GetPath: string; virtual; abstract;
  263. function GetValid: Boolean; override;
  264. procedure HistoryItemClick(Sender: TObject);
  265. procedure InternalEdit(const HItem: TLVItem); virtual; abstract;
  266. function ItemIsFile(Item: TListItem): Boolean; virtual; abstract;
  267. function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; virtual; abstract;
  268. function ItemOverlayIndexes(Item: TListItem): Word; virtual;
  269. procedure LimitHistorySize;
  270. function MinimizePath(Path: string; Len: Integer): string; virtual; abstract;
  271. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  272. procedure PathChanged;
  273. procedure SetPath(Value: string); virtual; abstract;
  274. procedure SetSortByExtension(Value: Boolean);
  275. procedure SetShowHiddenFiles(Value: Boolean); virtual;
  276. procedure SetShowSubDirSize(Value: Boolean); virtual;
  277. procedure SetViewStyle(Value: TViewStyle); override;
  278. procedure SetWatchForChanges(Value: Boolean); virtual;
  279. function TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean; virtual;
  280. procedure UpdateHistoryMenu(Direction: THistoryDirection);
  281. procedure UpdatePathComboBox; dynamic;
  282. procedure UpdatePathLabel; dynamic;
  283. procedure UpdateStatusBar; dynamic;
  284. procedure WndProc(var Message: TMessage); override;
  285. property ImageList16: TImageList read FImageList16;
  286. property ImageList32: TImageList read FImageList32;
  287. public
  288. function AnyFileSelected(OnlyFocused: Boolean): Boolean;
  289. constructor Create(AOwner: TComponent); override;
  290. procedure CreateDirectory(DirName: string); virtual; abstract;
  291. destructor Destroy; override;
  292. procedure Load; virtual;
  293. procedure Reload(CacheIcons: Boolean); virtual;
  294. function CreateFocusedFileList(FullPath: Boolean; FileList: TStrings = nil): TStrings;
  295. function CreateFileList(Focused: Boolean; FullPath: Boolean; FileList: TStrings = nil): TStrings;
  296. function DoSelectByMask(Select: Boolean): Boolean; override;
  297. procedure ExecuteHomeDirectory; virtual; abstract;
  298. procedure ExecuteParentDirectory; virtual; abstract;
  299. procedure ExecuteRootDirectory; virtual; abstract;
  300. procedure ExecuteCurrentFile();
  301. function FindFileItem(FileName: string): TListItem;
  302. procedure HistoryGo(Index: Integer);
  303. function ItemIsDirectory(Item: TListItem): Boolean; virtual; abstract;
  304. function ItemIsParentDirectory(Item: TListItem): Boolean; virtual; abstract;
  305. function ItemFullFileName(Item: TListItem): string; virtual; abstract;
  306. function ItemFileName(Item: TListItem): string; virtual; abstract;
  307. procedure ReloadDirectory; virtual; abstract;
  308. procedure DisplayPropertiesMenu; virtual; abstract;
  309. function CreateChangedFileList(DirView: TCustomDirView; FullPath: Boolean;
  310. ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  311. procedure CompareFiles(DirView: TCustomDirView; ExistingOnly: Boolean;
  312. Criterias: TCompareCriterias); virtual;
  313. procedure SaveSelection;
  314. procedure RestoreSelection;
  315. procedure DiscardSavedSelection;
  316. property AddParentDir: Boolean read FAddParentDir write SetAddParentDir default False;
  317. property DimmHiddenFiles: Boolean read FDimmHiddenFiles write SetDimmHiddenFiles default True;
  318. property ShowDirectories: Boolean read FShowDirectories write SetShowDirectories default True;
  319. property DirsOnTop: Boolean read FDirsOnTop write SetDirsOnTop default True;
  320. property DragDropFilesEx: TCustomizableDragDropFilesEx read FDragDropFilesEx;
  321. property ShowSubDirSize: Boolean read FShowSubDirSize write SetShowSubDirSize default False;
  322. property SortByExtension: Boolean read FSortByExtension write SetSortByExtension default False;
  323. property WantUseDragImages: Boolean read FWantUseDragImages write FWantUseDragImages default True;
  324. property UseDragImages: Boolean read GetUseDragImages stored False;
  325. property FullDrag default True;
  326. property TargetPopupMenu: Boolean read GetTargetPopupMenu write SetTargetPopupMenu default True;
  327. property DDOwnerIsSource: Boolean read FDDOwnerIsSource;
  328. property FilesSize: Int64 read FFilesSize;
  329. property FilesSelSize: Int64 read FFilesSelSize;
  330. property FilesCount: Integer read GetFilesCount;
  331. property FilesMarkedSize: Int64 read GetFilesMarkedSize;
  332. property HasParentDir: Boolean read FHasParentDir;
  333. //CLEANproperty MultiSelect write SetMultiSelect;
  334. property Path: string read GetPath write SetPath;
  335. property PathName: string read GetPathName;
  336. property ReloadTime: TSystemTime read FReloadTime;
  337. property SingleClickToExec: Boolean read FSingleClickToExec write FSingleClickToExec default False;
  338. property UseSystemContextMenu: Boolean read FUseSystemContextMenu
  339. write FUseSystemContextMenu default True;
  340. property Loading: Boolean read FLoading;
  341. property AbortLoading: Boolean read FAbortLoading write FAbortLoading stored False;
  342. property BackCount: Integer read FBackCount;
  343. property BackMenu: TPopupMenu read GetBackMenu;
  344. {Enable or disable populating the item list:}
  345. property LoadAnimation: Boolean read FLoadAnimation write FLoadAnimation default True;
  346. property LoadEnabled: Boolean read FLoadEnabled write SetLoadEnabled default True;
  347. {Displayed data is not valid => reload required}
  348. property Dirty: Boolean read FDirty;
  349. property DirOK: Boolean read GetDirOK;
  350. property LastPath: string read FLastPath;
  351. property IsRecycleBin: Boolean read FIsRecycleBin;
  352. property DDLinkOnExeDrag: Boolean read FDDLinkOnExeDrag
  353. write FDDLinkOnExeDrag default False;
  354. property DragDrive: TDrive read FDragDrive;
  355. property DragOnDriveIsMove: Boolean read FDragOnDriveIsMove write FDragOnDriveIsMove;
  356. property DragSourceEffects: TDropEffectSet read GetDragSourceEffects{ write FDragSourceEffects};
  357. property ExeDrag: Boolean read FExeDrag;
  358. property ForwardCount: Integer read GetForwardCount;
  359. property ForwardMenu: TPopupMenu read GetForwardMenu;
  360. property HistoryPath[Index: Integer]: string read GetHistoryPath;
  361. property IsRoot: Boolean read GetIsRoot;
  362. property LastDDResult: TDragResult read FLastDDResult;
  363. property SmallImages;
  364. property LargeImages;
  365. property MaxHistoryCount: Integer read FMaxHistoryCount write SetMaxHistoryCount default DefaultHistoryCount;
  366. property MaxHistoryMenuLen: Integer read FMaxHistoryMenuLen write SetMaxHistoryMenuLen default DefaultHistoryMenuLen;
  367. property MaxHistoryMenuWidth: Integer read FMaxHistoryMenuWidth write SetMaxHistoryMenuWidth default DefaultHistoryMenuWidth;
  368. property OnContextPopup;
  369. property OnBeginRename: TRenameEvent read FOnBeginRename write FOnBeginRename;
  370. property OnEndRename: TRenameEvent read FOnEndRename write FOnEndRename;
  371. property OnGetSelectFilter: TDVGetFilterEvent read FOnGetSelectFilter write FOnGetSelectFilter;
  372. property OnStartLoading: TNotifyEvent read FOnStartLoading write FOnStartLoading;
  373. property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
  374. {This event is fired, when any update has made to the listview}
  375. property OnDirUpdated: TNotifyEvent read FOnDirUpdated write FOnDirUpdated;
  376. {The mouse has entered the component window as a target of a drag&drop operation:}
  377. property OnDDDragEnter: TDDOnDragEnter read FOnDDDragEnter write FOnDDDragEnter;
  378. {The mouse has leaved the component window as a target of a drag&drop operation:}
  379. property OnDDDragLeave: TDDOnDragLeave read FOnDDDragLeave write FOnDDDragLeave;
  380. {The mouse is dragging in the component window as a target of a drag&drop operation:}
  381. property OnDDDragOver: TDDOnDragOver read FOnDDDragOver write FOnDDDragOver;
  382. {The Drag&drop operation is about to be executed:}
  383. property OnDDDrop: TDDOnDrop read FOnDDDrop write FOnDDDrop;
  384. property OnDDQueryContinueDrag: TDDOnQueryContinueDrag
  385. read FOnDDQueryContinueDrag write FOnDDQueryContinueDrag;
  386. property OnDDGiveFeedback: TDDOnGiveFeedback
  387. read FOnDDGiveFeedback write FOnDDGiveFeedback;
  388. {A drag&drop operation is about to be initiated whith
  389. the components window as the source:}
  390. property OnDDDragDetect: TDDOnDragDetect
  391. read FOnDDDragDetect write FOnDDDragDetect;
  392. property OnDDCreateDragFileList: TDDOnCreateDragFileList
  393. read FOnDDCreateDragFileList write FOnDDCreateDragFileList;
  394. property OnDDEnd: TNotifyEvent
  395. read FOnDDEnd write FOnDDEnd;
  396. property OnDDCreateDataObject: TDDOnCreateDataObject
  397. read FOnDDCreateDataObject write FOnDDCreateDataObject;
  398. property OnDDTargetHasDropHandler: TDDOnTargetHasDropHandler
  399. read FOnDDTargetHasDropHandler write FOnDDTargetHasDropHandler;
  400. {The component window is the target of a drag&drop operation:}
  401. property OnDDProcessDropped: TOnProcessDropped
  402. read FOnDDProcessDropped write FOnDDProcessDropped;
  403. {An error has occured during a drag&drop operation:}
  404. property OnDDError: TDDErrorEvent read FOnDDError write FOnDDError;
  405. {The drag&drop operation has been executed:}
  406. property OnDDExecuted: TDDExecutedEvent
  407. read FOnDDExecuted write FOnDDExecuted;
  408. {Event is fired just before executing the fileoperation. This event is also fired when
  409. files are pasted from the clipboard:}
  410. property OnDDFileOperation: TDDFileOperationEvent
  411. read FOnDDFileOperation write FOnDDFileOperation;
  412. {Event is fired after executing the fileoperation. This event is also fired when
  413. files are pasted from the clipboard:}
  414. property OnDDFileOperationExecuted: TDDFileOperationExecutedEvent
  415. read FOnDDFileOperationExecuted write FOnDDFileOperationExecuted;
  416. {Set AllowExec to false, if actual file should not be executed:}
  417. property OnDDMenuPopup: TOnMenuPopup read FOnDDMenuPopup write FOnDDMenuPopup;
  418. property OnExecFile: TDirViewExecFileEvent
  419. read FOnExecFile write FOnExecFile;
  420. property OnHistoryChange: THistoryChangeEvent read FOnHistoryChange write FOnHistoryChange;
  421. property PathComboBox: TCustomPathComboBox read FPathComboBox write SetPathComboBox;
  422. property PathLabel: TCustomPathLabel read FPathLabel write SetPathLabel;
  423. property ShowHiddenFiles: Boolean read FShowHiddenFiles write SetShowHiddenFiles default True;
  424. property StatusBar: TAssociatedStatusBar read FStatusBar write SetStatusBar;
  425. {Watch current directory for filename changes (create, rename, delete files)}
  426. property WatchForChanges: Boolean read FWatchForChanges write SetWatchForChanges default False;
  427. end;
  428. resourcestring
  429. SErrorOpenFile = 'Can''t open file: ';
  430. SErrorRenameFile = 'Can''t rename file or directory: ';
  431. SErrorRenameFileExists = 'File already exists: ';
  432. SErrorInvalidName= 'Filename contains invalid characters:';
  433. STextFileExt = 'File %s';
  434. STextFiles = '%u Files';
  435. STextDirectories = '%u Directories';
  436. SParentDir = 'Parent directory';
  437. SIconUpdateThreadTerminationError = 'Can''t terminate icon update thread.';
  438. SDragDropError = 'DragDrop Error: %d';
  439. SDirNotExists = 'Directory ''%s'' doesn''t exist.';
  440. {Additional non-component specific functions:}
  441. {Create and resolve a shell link (file shortcut):}
  442. function CreateFileShortCut(SourceFile, Target, DisplayName: string;
  443. UpdateIfExists: Boolean = False): Boolean;
  444. function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
  445. {Gets the shell's display icon for registered file extensions:}
  446. function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
  447. {Gets the shell's inforecord for registered fileextensions:}
  448. function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
  449. {Returns the displayname as used by the shell:}
  450. function GetShellDisplayName(const ShellFolder: IShellFolder; IDList: PItemIDList;
  451. Flags: DWORD; var Name: string): Boolean;
  452. function IsExecutable(FileName: string): Boolean;
  453. function GetNextMask(var Mask: string): string;
  454. function FileNameMatchesMasks(FileName: string; Masks: string): Boolean;
  455. procedure DefaultFileFilter(var Filter: TFileFilter);
  456. var
  457. StdDirIcon: Integer;
  458. StdDirSelIcon: Integer;
  459. DropSourceControl: TObject;
  460. UnknownFileIcon: Integer;
  461. HasExtendedCOMCTL32: Boolean;
  462. StdDirTypeName: string;
  463. DefaultExeIcon: Integer;
  464. UserDocumentDirectory: string;
  465. implementation
  466. uses
  467. {DriveView, }Math, Masks;
  468. const
  469. Space = ' ';
  470. ResDirUp = 'DIRUP%2.2d';
  471. ResLink = 'LINK%2.2d';
  472. ResBrokenLink = 'BROKEN%2.2d';
  473. var
  474. WinDir: string;
  475. TempDir: string;
  476. COMCTL32Version: DWORD;
  477. function IsExecutable(FileName: string): Boolean;
  478. var
  479. FileExt: string;
  480. begin
  481. FileExt := UpperCase(ExtractFileExt(FileName));
  482. Result := (FileExt = '.EXE') or (FileExt = '.COM');
  483. end;
  484. function GetNextMask(var Mask: string): string;
  485. var
  486. NextPos: Integer;
  487. begin
  488. NextPos := Pos(';', Mask);
  489. if NextPos = 0 then
  490. begin
  491. Result := Mask;
  492. SetLength(Mask, 0);
  493. end
  494. else
  495. begin
  496. Result := Copy(Mask, 1, NextPos - 1);
  497. Delete(Mask, 1, NextPos);
  498. end;
  499. end;
  500. function FileNameMatchesMasks(FileName: string; Masks: string): Boolean;
  501. begin
  502. Result := False;
  503. // there needs to be atleast one dot,
  504. // otherwise '*.*' mask would not select this file
  505. if Pos('.', FileName) = 0 then FileName := FileName + '.';
  506. while (not Result) and (Length(Masks) > 0) do
  507. Result := MatchesMask(FileName, GetNextMask(Masks));
  508. end;
  509. procedure DefaultFileFilter(var Filter: TFileFilter);
  510. begin
  511. with Filter do
  512. begin
  513. SetLength(Masks, 0);
  514. IncludeAttr := 0;
  515. ExcludeAttr := 0;
  516. Directories := False;
  517. FileSizeFrom := 0;
  518. FileSizeTo := 0;
  519. ModificationFrom := 0;
  520. ModificationTo := 0;
  521. end;
  522. end;
  523. { Shortcut-handling }
  524. function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
  525. var
  526. IUnk: IUnknown;
  527. HRes: HRESULT; // OLE-Operation Result
  528. SL: IShellLink; // Interface for ShellLink
  529. PF: IPersistFile; // Interface for PersistentFile
  530. SRec: TWIN32FINDDATA; // SearchRec of targetfile
  531. TargetDir: array[1..Max_Path] of Char; // Working directory of targetfile
  532. PSource: WideString; // Widestring(Source)
  533. Flags: DWORD;
  534. begin
  535. Result := '';
  536. IUnk := CreateComObject(CLSID_ShellLink);
  537. SL := IUnk as IShellLink;
  538. PF := IUnk as IPersistFile;
  539. PSource := SourceFile;
  540. HRes := PF.Load(PWideChar(PSource), STGM_READ);
  541. if Succeeded(Hres) then
  542. begin
  543. if not ShowDialog then Flags := SLR_NOUPDATE or (1500 shl 8) or SLR_NO_UI
  544. else Flags := SLR_NOUPDATE;
  545. HRes := SL.Resolve(Application.Handle, Flags);
  546. if Succeeded(HRes) then
  547. begin
  548. HRes := SL.GetPath(@TargetDir, MAX_PATH, SRec, {SLGP_UNCPRIORITY}{SLGP_SHORTPATH} 0);
  549. if Succeeded(HRes) then
  550. Result := string(PChar(@TargetDir));
  551. end;
  552. end;
  553. end; {ResolveShortCut}
  554. function CreateFileShortCut(SourceFile, Target, DisplayName: string;
  555. UpdateIfExists: Boolean): Boolean;
  556. var
  557. IUnk: IUnknown;
  558. Hres: HRESULT;
  559. ShellLink: IShellLink; // Interface to ShellLink
  560. IPFile: IPersistFile; // Interface to PersistentFile
  561. WideStr: WideString;
  562. TargetFile: string;
  563. begin
  564. Result := False;
  565. if Target = '' then TargetFile := SourceFile + '.lnk'
  566. else TargetFile := Target;
  567. WideStr := TargetFile;
  568. IUnk := CreateComObject(CLSID_ShellLink);
  569. ShellLink := IUnk as IShellLink;
  570. IPFile := IUnk as IPersistFile;
  571. if FileExists(TargetFile) and UpdateIfExists then
  572. begin
  573. HRes := IPFile.Load(PWChar(WideStr), 0);
  574. if not Succeeded(HRes) then Exit;
  575. end;
  576. with ShellLink do
  577. begin
  578. HRes := SetPath(PChar(SourceFile));
  579. if Succeeded(HRes) then
  580. HRes := SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
  581. if Succeeded(HRes) and (DisplayName <> '') then
  582. HRes := SetDescription(PChar(DisplayName));
  583. end;
  584. if Succeeded(Hres) then
  585. begin
  586. HRes := IPFile.Save(PWChar(WideStr),False);
  587. if Succeeded(HRes) then Result := True;
  588. end;
  589. end; {CreateShortCut}
  590. function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
  591. var
  592. FileInfo: TSHFileInfo;
  593. begin
  594. try
  595. SHGetFileInfo(PChar(AFile), Attrs, FileInfo, SizeOf(TSHFileInfo),
  596. Flags or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  597. Result := FileInfo.iIcon;
  598. except
  599. Result := -1;
  600. end;
  601. end; {GetIconIndex}
  602. function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
  603. begin
  604. try
  605. SHGetFileInfo(PChar(AFile), Attrs, Result, SizeOf(TSHFileInfo), Flags);
  606. except
  607. FillChar(Result, SizeOf(Result), 0);
  608. end;
  609. end; {GetshFileInfo}
  610. function GetShellDisplayName(const ShellFolder: IShellFolder; IDList: PItemIDList;
  611. Flags: DWORD; var Name: string): Boolean;
  612. var
  613. Str: TStrRet;
  614. begin
  615. Result := True;
  616. Name := '';
  617. if ShellFolder.GetDisplayNameOf(IDList, Flags, Str) = NOERROR then
  618. begin
  619. case Str.uType of
  620. STRRET_WSTR: Name := WideCharToString(Str.pOleStr);
  621. STRRET_OFFSET: Name := PChar(UINT(IDList) + Str.uOffset);
  622. STRRET_CSTR: Name := Str.cStr;
  623. else Result := False;
  624. end;
  625. end
  626. else Result := False;
  627. end; {GetShellDisplayName}
  628. function COMCTL32OK: Boolean;
  629. {Returs, wether COMCTL32 supports the extended display properties:
  630. COMCTL32.DLL version 4.70 or higher ist required. Version 4.70 is
  631. included in Internet Explorer 4 with Active Desktop.
  632. Updates of COMCTL32.DLL are available at:
  633. http://msdn.microsoft.com/developer/downloads/files/40Comupd.htm }
  634. var
  635. VerInfoSize: DWORD;
  636. Dummy: DWORD;
  637. VerInfo: Pointer;
  638. FileInfo: PVSFixedFileInfo;
  639. FileInfoSize: UINT;
  640. begin
  641. Result := False;
  642. VerInfoSize := GetFileVersionInfoSize('COMCTL32.DLL', Dummy);
  643. if VerInfoSize > 0 then
  644. begin
  645. GetMem(VerInfo, VerInfoSize);
  646. try
  647. if GetFileVersionInfo(PChar('COMCTL32.DLL'), 0, VerInfoSize, VerInfo) then
  648. begin
  649. if VerQueryValue(VerInfo, '\', Pointer(FileInfo), FileInfoSize) then
  650. begin
  651. ComCTL32Version := FileInfo.dwFileVersionMS;
  652. Result := (ComCTL32Version >= $40046); { COMCTL32 Version >= 4.70 required }
  653. end
  654. else ComCTL32Version := 0;
  655. end;
  656. finally
  657. FreeMem(VerInfo, VerInfoSize);
  658. end;
  659. end;
  660. end; {COMCTL32OK}
  661. { TLoadAnimationStartThread }
  662. {constructor TLoadAnimationStartThread.Create(AInterval: Integer; AAnimation: TAnimate);
  663. begin
  664. inherited Create(True);
  665. FInterval := AInterval;
  666. FAnimation := AAnimation;
  667. Resume;
  668. end;
  669. procedure TLoadAnimationStartThread.Execute;
  670. var
  671. XInterval: Integer;
  672. begin
  673. XInterval := FInterval;
  674. while (not Terminated) and (XInterval > 0) do
  675. begin
  676. Sleep(10);
  677. Dec(XInterval, 10);
  678. end;
  679. if (not Terminated) and Assigned(FAnimation) then
  680. Synchronize(StartAnimation);
  681. end;
  682. procedure TLoadAnimationStartThread.StartAnimation;
  683. begin
  684. FAnimation.Visible := True;
  685. FAnimation.Active := True;
  686. end; }
  687. { TCustomizableDragDropFilesEx }
  688. function TCustomizableDragDropFilesEx.Execute(DataObject: TDataObject): TDragResult;
  689. begin
  690. if not Assigned(DataObject) then
  691. begin
  692. DataObject := CreateDataObject;
  693. end;
  694. Result := ExecuteOperation(DataObject);
  695. end;
  696. { TCustomDirView }
  697. constructor TCustomDirView.Create(AOwner: TComponent);
  698. var
  699. WinVer: TOSVersionInfo;
  700. begin
  701. inherited;
  702. WinVer.dwOSVersionInfoSize := SizeOf(WinVer);
  703. GetVersionEx(WinVer);
  704. FWatchForChanges := False;
  705. FNeverPainted := True;
  706. FFilesSize := 0;
  707. FFilesSelSize := 0;
  708. FDimmHiddenFiles := True;
  709. FShowHiddenFiles := True;
  710. FShowDirectories := True;
  711. FDirsOnTop := True;
  712. FShowSubDirSize := False;
  713. FWantUseDragImages := True;
  714. FCanUseDragImages := (Win32PlatForm = VER_PLATFORM_WIN32_NT) or (WinVer.dwMinorVersion > 0);
  715. FAddParentDir := False;
  716. FullDrag := True;
  717. FSingleClickToExec := False;
  718. FInvalidNameChars := '\/:*?"<>|';
  719. FHasParentDir := False;
  720. FDragOnDriveIsMove := False;
  721. FCaseSensitive := False;
  722. FLoadAnimation := True;
  723. FAnimation := nil;
  724. FIsRecycleBin := False;
  725. FLoading := False;
  726. FLoadEnabled := True;
  727. FAbortLoading := False;
  728. FDirty := False;
  729. FLastPath := '';
  730. FNotifyEnabled := True;
  731. FForceRename := False;
  732. FLastRenameName := '';
  733. FSavedSelection := False;
  734. FPendingFocusSomething := False;
  735. FContextMenu := False;
  736. FUseSystemContextMenu := True;
  737. FStartPos.X := -1;
  738. FStartPos.Y := -1;
  739. FDragPos := FStartPos;
  740. FDragEnabled := False;
  741. FDDOwnerIsSource := False;
  742. FDDLinkOnExeDrag := False;
  743. FDragDrive := #0;
  744. FExeDrag := False;
  745. FOnHistoryChange := nil;
  746. FHistoryPaths := TStringList.Create;
  747. FBackCount := 0;
  748. FDontRecordPath := False;
  749. FBackMenu := nil;
  750. FForwardMenu := nil;
  751. FMaxHistoryMenuLen := DefaultHistoryMenuLen;
  752. FMaxHistoryMenuWidth := DefaultHistoryMenuWidth;
  753. FMaxHistoryCount := DefaultHistoryCount;
  754. OnCustomDrawItem := DumbCustomDrawItem;
  755. OnCustomDrawSubItem := DumbCustomDrawSubItem;
  756. FDragDropFilesEx := TCustomizableDragDropFilesEx.Create(Self);
  757. with FDragDropFilesEx do
  758. begin
  759. {$IFDEF OLD_DND}
  760. AutoDetectDnD := False;
  761. DragDetectDelta := 4;
  762. {$ELSE}
  763. DragDetect.Automatic := False;
  764. DragDetect.DeltaX := 4;
  765. DragDetect.DeltaY := 4;
  766. {$ENDIF}
  767. AcceptOwnDnD := True;
  768. BringToFront := True;
  769. CompleteFileList := True;
  770. NeedValid := [nvFileName];
  771. RenderDataOn := rdoEnterAndDropSync;
  772. TargetPopUpMenu := True;
  773. SourceEffects := DragSourceEffects;
  774. TargetEffects := [deCopy, deMove];
  775. OnDragEnter := DDDragEnter;
  776. OnDragLeave := DDDragLeave;
  777. OnDragOver := DDDragOver;
  778. OnDrop := DDDrop;
  779. OnQueryContinueDrag := DDQueryContinueDrag;
  780. OnSpecifyDropTarget := DDSpecifyDropTarget;
  781. OnMenuPopup := DDMenuPopup;
  782. OnMenuDestroy := DDMenuDone;
  783. OnDropHandlerSucceeded := DDDropHandlerSucceeded;
  784. OnGiveFeedback := DDGiveFeedback;
  785. OnProcessDropped := DDProcessDropped;
  786. OnDragDetect := DDDragDetect;
  787. end;
  788. end;
  789. procedure TCustomDirView.ClearItems;
  790. begin
  791. if Assigned(DropTarget) then DropTarget := nil;
  792. try
  793. inherited;
  794. finally
  795. FFilesSelSize := 0;
  796. FFilesSize := 0;
  797. UpdateStatusBar;
  798. end;
  799. end;
  800. procedure TCustomDirView.CNNotify(var Message: TWMNotify);
  801. procedure DrawOverlayImage(Image: Integer);
  802. var
  803. ImageList: TCustomImageList;
  804. Point: TPoint;
  805. Index: Integer;
  806. begin
  807. Point := Items[PNMCustomDraw(Message.NMHdr)^.dwItemSpec].
  808. DisplayRect(drIcon).TopLeft;
  809. if ViewStyle = vsIcon then
  810. begin
  811. ImageList := ImageList32;
  812. Inc(Point.X, 8);
  813. Inc(Point.Y, 2);
  814. end
  815. else ImageList := ImageList16;
  816. Index := 0;
  817. while Image > 1 do
  818. begin
  819. Inc(Index);
  820. Image := Image shr 1;
  821. end;
  822. if 8 + ImageList.Width <= Columns[0].Width then
  823. ImageList_Draw(ImageList.Handle, Index, Self.Canvas.Handle,
  824. Point.X, Point.Y, ILD_TRANSPARENT);
  825. end;
  826. var
  827. FileSize: Int64;
  828. Item: TListItem;
  829. InfoMask: LongWord;
  830. OverlayIndex: Word;
  831. OverlayIndexes: Word;
  832. UpdateStatusBarPending: Boolean;
  833. begin
  834. UpdateStatusBarPending := False;
  835. case Message.NMHdr^.code of
  836. LVN_ITEMCHANGED:
  837. with PNMListView(Message.NMHdr)^ do
  838. if (uChanged = LVIF_STATE) and Valid and (not FClearingItems) then
  839. begin
  840. if ((uOldState and (LVIS_SELECTED or LVIS_FOCUSED)) <>
  841. (uNewState and (LVIS_SELECTED or LVIS_FOCUSED))) then
  842. UpdateStatusBarPending := True;
  843. if ((uOldState and LVIS_SELECTED) <> (uNewState and LVIS_SELECTED)) then
  844. begin
  845. FileSize := ItemFileSize(Items[iItem]);
  846. if (uOldState and LVIS_SELECTED) <> 0 then Dec(FFilesSelSize, FileSize)
  847. else Inc(FFilesSelSize, FileSize);
  848. end;
  849. end;
  850. LVN_ENDLABELEDIT:
  851. LoadEnabled := True;
  852. LVN_BEGINDRAG:
  853. if FDragEnabled and (not Loading) then
  854. DDDragDetect(MK_LBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
  855. LVN_BEGINRDRAG:
  856. if FDragEnabled and (not Loading) then
  857. DDDragDetect(MK_RBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
  858. end;
  859. inherited;
  860. if (Message.NMHdr.code = LVN_GETDISPINFO) and
  861. FNotifyEnabled and Valid and (not Loading) then
  862. with PLVDispInfo(Pointer(Message.NMHdr))^.Item do
  863. try
  864. InfoMask := PLVDispInfo(Pointer(Message.NMHdr))^.item.Mask;
  865. if (InfoMask and LVIF_PARAM) <> 0 then Item := TListItem(lParam)
  866. else
  867. if iItem < Items.Count then Item := Items[iItem]
  868. else Item := nil;
  869. if Assigned(Item) and Assigned(Item.Data) then
  870. GetDisplayInfo(Item, PLVDispInfo(Pointer(Message.NMHdr))^.item);
  871. except
  872. end;
  873. if (Message.NMHdr.code = NM_CUSTOMDRAW) and
  874. HasExtendedCOMCTL32 and Valid and (not Loading) then
  875. with PNMCustomDraw(Message.NMHdr)^ do
  876. try
  877. Message.Result := Message.Result or CDRF_NOTIFYPOSTPAINT;
  878. if (dwDrawStage = CDDS_ITEMPOSTPAINT) and
  879. ((dwDrawStage and CDDS_SUBITEM) = 0) and
  880. Assigned(Columns[0]) and (Columns[0].Width > 0) then
  881. begin
  882. Assert(Assigned(Items[dwItemSpec]));
  883. OverlayIndexes := ItemOverlayIndexes(Items[dwItemSpec]);
  884. OverlayIndex := 1;
  885. while OverlayIndexes > 0 do
  886. begin
  887. if (OverlayIndex and OverlayIndexes) <> 0 then
  888. begin
  889. DrawOverlayImage(OverlayIndex);
  890. Dec(OverlayIndexes, OverlayIndex);
  891. end;
  892. OverlayIndex := OverlayIndex shl 1;
  893. end;
  894. end;
  895. except
  896. end;
  897. if UpdateStatusBarPending then UpdateStatusBar;
  898. end;
  899. procedure TCustomDirView.SetAddParentDir(Value: Boolean);
  900. begin
  901. if FAddParentDir <> Value then
  902. begin
  903. FAddParentDir := Value;
  904. if DirOK then Reload(True);
  905. end;
  906. end;
  907. procedure TCustomDirView.SetDimmHiddenFiles(Value: Boolean);
  908. begin
  909. if Value <> FDimmHiddenFiles then
  910. begin
  911. FDimmHiddenFiles := Value;
  912. Self.Repaint;
  913. end;
  914. end; {SetDimmHiddenFiles}
  915. procedure TCustomDirView.SetPathComboBox(Value: TCustomPathComboBox);
  916. begin
  917. if FPathComboBox <> Value then
  918. begin
  919. if Assigned(FPathComboBox) and (FPathComboBox.DirView = Self) then
  920. FPathComboBox.DirView := nil;
  921. FPathComboBox := Value;
  922. if Assigned(Value) then
  923. begin
  924. Value.FreeNotification(Self);
  925. if not Assigned(Value.DirView) then
  926. Value.DirView := Self;
  927. UpdatePathComboBox;
  928. end;
  929. end;
  930. end; { SetPathComboBox }
  931. procedure TCustomDirView.SetPathLabel(Value: TCustomPathLabel);
  932. begin
  933. if FPathLabel <> Value then
  934. begin
  935. if Assigned(FPathLabel) and (FPathLabel.FocusControl = Self) then
  936. FPathLabel.FocusControl := nil;
  937. FPathLabel := Value;
  938. if Assigned(Value) then
  939. begin
  940. Value.FreeNotification(Self);
  941. if not Assigned(Value.FocusControl) then
  942. Value.FocusControl := Self;
  943. UpdatePathLabel;
  944. end;
  945. end;
  946. end; { SetPathLabel }
  947. procedure TCustomDirView.SetShowDirectories(Value: Boolean);
  948. begin
  949. if Value <> FShowDirectories then
  950. begin
  951. FShowDirectories := Value;
  952. if DirOK then Reload(True);
  953. Self.Repaint;
  954. end;
  955. end; {SetShowDirectories}
  956. procedure TCustomDirView.SetDirsOnTop(Value: Boolean);
  957. begin
  958. if Value <> FDirsOnTop then
  959. begin
  960. FDirsOnTop := Value;
  961. if ShowDirectories then
  962. SortItems;
  963. end;
  964. end; {SetDirsOnTop}
  965. procedure TCustomDirView.SetShowHiddenFiles(Value: Boolean);
  966. begin
  967. if ShowHiddenFiles <> Value then
  968. begin
  969. FShowHiddenFiles := Value;
  970. if DirOK then Reload(False);
  971. end;
  972. end;
  973. procedure TCustomDirView.SetShowSubDirSize(Value: Boolean);
  974. begin
  975. if Value <> FShowSubDirSize then
  976. FShowSubDirSize := Value;
  977. end; {SetShowSubDirSize}
  978. procedure TCustomDirView.SetSortByExtension(Value: Boolean);
  979. Begin
  980. if Value <> FSortByExtension then
  981. begin
  982. FSortByExtension := Value;
  983. SortItems;
  984. end;
  985. end; {SetSortByExtension}
  986. function TCustomDirView.GetDragSourceEffects: TDropEffectSet;
  987. begin
  988. Result := [deCopy, deMove, deLink];
  989. end;
  990. function TCustomDirView.GetUseDragImages: Boolean;
  991. begin
  992. Result := FWantUseDragImages and FCanUseDragImages;
  993. end;
  994. procedure TCustomDirView.SetStatusBar(Value: TAssociatedStatusBar);
  995. begin
  996. if FStatusBar <> Value then
  997. begin
  998. if Assigned(FStatusBar) and
  999. (FStatusBar.FocusControl = Self) then
  1000. FStatusBar.FocusControl := nil;
  1001. FStatusBar := Value;
  1002. if Assigned(FStatusBar) and
  1003. (FStatusBar.FocusControl = nil) then
  1004. FStatusBar.FocusControl := Self;
  1005. UpdateStatusBar;
  1006. end;
  1007. end; { SetStatusBar }
  1008. procedure TCustomDirView.SetTargetPopupMenu(Value: Boolean);
  1009. begin
  1010. if Assigned(FDragDropFilesEx) then FDragDropFilesEx.TargetPopupMenu := Value;
  1011. end;
  1012. procedure TCustomDirView.CreateWnd;
  1013. procedure GetOverlayBitmap(ImageList: TImageList; BitmapName: string);
  1014. var
  1015. Bitmap: TBitmap;
  1016. begin
  1017. Bitmap := TBitmap.Create;
  1018. try
  1019. Bitmap.LoadFromResourceName(hInstance, BitmapName);
  1020. ImageList.AddMasked(Bitmap, Bitmap.Canvas.Pixels[0, 0]);
  1021. finally
  1022. Bitmap.Free;
  1023. end;
  1024. end; {GetOverlayBitmap}
  1025. function OverlayImageList(Size: Integer): TImageList;
  1026. begin
  1027. Result := TImageList.CreateSize(Size, Size);
  1028. Result.DrawingStyle := dsTransparent;
  1029. Result.BkColor := clNone;
  1030. GetOverlayBitmap(Result, Format(ResDirUp, [Size]));
  1031. GetOverlayBitmap(Result, Format(ResLink, [Size]));
  1032. GetOverlayBitmap(Result, Format(ResBrokenLink, [Size]));
  1033. end;
  1034. begin
  1035. inherited;
  1036. if Assigned(PopupMenu) then
  1037. PopupMenu.Autopopup := False;
  1038. FDragDropFilesEx.DragDropControl := Self;
  1039. FImageList16 := OverlayImageList(16);
  1040. FImageList32 := OverlayImageList(32);
  1041. IconsSetImageList;
  1042. end;
  1043. function TCustomDirView.CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  1044. Stage: TCustomDrawStage): Boolean;
  1045. var
  1046. FItemColor: TColor;
  1047. begin
  1048. if (Item <> nil) and (Stage = cdPrePaint) then
  1049. begin
  1050. FItemColor := ItemColor(Item);
  1051. if (FItemColor <> clDefaultItemColor) and
  1052. (Canvas.Font.Color <> FItemColor) then
  1053. Canvas.Font.Color := FItemColor;
  1054. end;
  1055. Result := inherited CustomDrawItem(Item, State, Stage);
  1056. end;
  1057. function TCustomDirView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  1058. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
  1059. var
  1060. FColor: TColor;
  1061. begin
  1062. if (Stage = cdPrePaint) and (SubItem > 0) and
  1063. (ItemColor(Item) <> clDefaultItemColor) then
  1064. begin
  1065. FColor := GetSysColor(COLOR_WINDOWTEXT);
  1066. if Canvas.Font.Color <> FColor then
  1067. Canvas.Font.Color := FColor;
  1068. end;
  1069. Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
  1070. end;
  1071. procedure TCustomDirView.Delete(Item: TListItem);
  1072. begin
  1073. Assert(Assigned(Item));
  1074. // This causes access violation when size is stored in structure
  1075. // pointed by TListItem->Data and this structure is not valid any more
  1076. if Valid then Dec(FFilesSize, ItemFileSize(Item));
  1077. inherited Delete(Item);
  1078. end;
  1079. destructor TCustomDirView.Destroy;
  1080. begin
  1081. Assert(not FSavedSelection);
  1082. FreeAndNil(FHistoryPaths);
  1083. FreeAndNil(FBackMenu);
  1084. FreeAndNil(FForwardMenu);
  1085. FreeAndNil(FDragDropFilesEx);
  1086. FreeAndNil(FImageList16);
  1087. FreeAndNil(FImageList32);
  1088. if Assigned(SmallImages) then
  1089. begin
  1090. SmallImages.Free;
  1091. SmallImages := nil;
  1092. end;
  1093. if Assigned(LargeImages) then
  1094. begin
  1095. LargeImages.Free;
  1096. LargeImages := nil;
  1097. end;
  1098. FreeAndNil(FAnimation);
  1099. inherited;
  1100. end;
  1101. procedure TCustomDirView.SelectFiles(Filter: TFileFilter; Select: Boolean);
  1102. var
  1103. Item: TListItem;
  1104. Index: Integer;
  1105. OldCursor: TCursor;
  1106. begin
  1107. Assert(Valid);
  1108. OldCursor := Screen.Cursor;
  1109. Items.BeginUpdate;
  1110. BeginSelectionUpdate;
  1111. try
  1112. Screen.Cursor := crHourGlass;
  1113. for Index := 0 to Items.Count-1 do
  1114. begin
  1115. Item := Items[Index];
  1116. Assert(Assigned(Item));
  1117. if (Item.Selected <> Select) and
  1118. ItemMatchesFilter(Item, Filter) then
  1119. Item.Selected := Select;
  1120. end;
  1121. finally
  1122. Screen.Cursor := OldCursor;
  1123. Items.EndUpdate;
  1124. EndSelectionUpdate;
  1125. end;
  1126. end;
  1127. function TCustomDirView.DoSelectByMask(Select: Boolean): Boolean;
  1128. var
  1129. Filter: TFileFilter;
  1130. begin
  1131. Result := inherited DoSelectByMask(Select);
  1132. if Assigned(FOnGetSelectFilter) then
  1133. begin
  1134. DefaultFileFilter(Filter);
  1135. FOnGetSelectFilter(Self, Select, Filter);
  1136. SelectFiles(Filter, Select);
  1137. Result := True;
  1138. end;
  1139. end;
  1140. function TCustomDirView.DragCompleteFileList: Boolean;
  1141. begin
  1142. Result := (MarkedCount <= 100) and (not IsRecycleBin);
  1143. end;
  1144. procedure TCustomDirView.DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  1145. begin
  1146. end;
  1147. procedure TCustomDirView.DumbCustomDrawSubItem(Sender: TCustomListView;
  1148. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  1149. var DefaultDraw: Boolean);
  1150. begin
  1151. end;
  1152. function TCustomDirView.GetTargetPopupMenu: Boolean;
  1153. begin
  1154. if Assigned(FDragDropFilesEx) then Result := FDragDropFilesEx.TargetPopupMenu
  1155. else Result := True;
  1156. end;
  1157. procedure TCustomDirView.SetMultiSelect(Value: Boolean);
  1158. begin
  1159. if Value <> MultiSelect then
  1160. begin
  1161. inherited SetMultiSelect(Value);
  1162. if not (csLoading in ComponentState) and Assigned(ColProperties) then
  1163. begin
  1164. ColProperties.RecreateColumns;
  1165. SetColumnImages;
  1166. if DirOK then Reload(True);
  1167. end;
  1168. end;
  1169. end;
  1170. function TCustomDirView.GetValid: Boolean;
  1171. begin
  1172. Result := (not (csDestroying in ComponentState)) and
  1173. (not Loading) and (not FClearingItems);
  1174. end;
  1175. function TCustomDirView.ItemCanDrag(Item: TListItem): Boolean;
  1176. begin
  1177. Result := (not ItemIsParentDirectory(Item));
  1178. end;
  1179. function TCustomDirView.ItemColor(Item: TListItem): TColor;
  1180. begin
  1181. Result := clDefaultItemColor;
  1182. end;
  1183. function TCustomDirView.GetFilesMarkedSize: Int64;
  1184. begin
  1185. if SelCount > 0 then Result := FilesSelSize
  1186. else
  1187. if Assigned(ItemFocused) then Result := ItemFileSize(ItemFocused)
  1188. else Result := 0;
  1189. end;
  1190. procedure TCustomDirView.IconsSetImageList;
  1191. function ShellImageList(Flags: UINT): TImageList;
  1192. var
  1193. FileInfo: TShFileInfo;
  1194. begin
  1195. Result := TImageList.Create(Self);
  1196. Result.Handle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo),
  1197. SHGFI_SYSICONINDEX or Flags);
  1198. Result.ShareImages := True;
  1199. end;
  1200. begin
  1201. if not Assigned(SmallImages) then
  1202. SmallImages := ShellImageList(SHGFI_SMALLICON);
  1203. if not Assigned(LargeImages) then
  1204. LargeImages := ShellImageList(SHGFI_LARGEICON);
  1205. end; {IconsSetImageList}
  1206. function TCustomDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1207. begin
  1208. Result := False;
  1209. end;
  1210. function TCustomDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1211. begin
  1212. Result := oiNoOverlay;
  1213. end;
  1214. procedure TCustomDirView.KeyDown(var Key: Word; Shift: TShiftState);
  1215. begin
  1216. if Valid and (not IsEditing) then
  1217. begin
  1218. if (Key = VK_RETURN) or
  1219. ((Key = VK_NEXT) and (ssCtrl in Shift)) then
  1220. begin
  1221. if Assigned(ItemFocused) and (not Loading) then
  1222. begin
  1223. Key := 0;
  1224. if (Key = VK_RETURN) and (Shift = [ssAlt]) then DisplayPropertiesMenu
  1225. else
  1226. if (Key <> VK_RETURN) or (Shift = []) then Execute(ItemFocused);
  1227. end;
  1228. end
  1229. else
  1230. if ((Key = VK_BACK) or ((Key = VK_PRIOR) and (ssCtrl in Shift))) and
  1231. (not Loading) and (not IsRoot) then
  1232. begin
  1233. Key := 0;
  1234. ExecuteParentDirectory;
  1235. end
  1236. else
  1237. if (Key = 220 { backslash }) and (ssCtrl in Shift) and (not Loading) and
  1238. (not IsRoot) then
  1239. begin
  1240. Key := 0;
  1241. ExecuteRootDirectory;
  1242. end
  1243. else
  1244. begin
  1245. inherited;
  1246. end;
  1247. end
  1248. else
  1249. begin
  1250. inherited;
  1251. end;
  1252. end;
  1253. procedure TCustomDirView.KeyPress(var Key: Char);
  1254. begin
  1255. if IsEditing and (Pos(Key, FInvalidNameChars) <> 0) Then
  1256. Begin
  1257. Beep;
  1258. Key := #0;
  1259. End;
  1260. inherited;
  1261. end;
  1262. procedure TCustomDirView.KeyUp(var Key: Word; Shift: TShiftState);
  1263. var
  1264. P: TPoint;
  1265. R: TRect;
  1266. begin
  1267. if Key = VK_APPS then
  1268. begin
  1269. if not Loading then
  1270. begin
  1271. if MarkedCount > 0 then
  1272. begin
  1273. if Assigned(ItemFocused) then
  1274. Begin
  1275. R := ItemFocused.DisplayRect(drIcon);
  1276. P.X := (R.Left + R.Right) div 2;
  1277. P.Y := (R.Top + R.Bottom) div 2;
  1278. end
  1279. else
  1280. begin
  1281. P.X := 0;
  1282. P.Y := 0;
  1283. end;
  1284. P := ClientToScreen(P);
  1285. DisplayContextMenu(P);
  1286. end
  1287. else
  1288. if Assigned(PopupMenu) then
  1289. begin
  1290. P.X := 0;
  1291. P.Y := 0;
  1292. P := ClientToScreen(P);
  1293. PopupMenu.Popup(P.X, P.Y);
  1294. end;
  1295. end;
  1296. end
  1297. else
  1298. inherited KeyUp(Key, Shift);
  1299. end;
  1300. procedure TCustomDirView.SetWatchForChanges(Value: Boolean);
  1301. begin
  1302. if FWatchForChanges <> Value then
  1303. FWatchForChanges := Value;
  1304. end;
  1305. function TCustomDirView.TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean;
  1306. begin
  1307. Assert(Assigned(DragDropFilesEx) and Assigned(Item));
  1308. Result :=
  1309. DragDropFilesEx.TargetHasDropHandler(nil, ItemFullFileName(Item), Effect);
  1310. if Assigned(OnDDTargetHasDropHandler) then
  1311. begin
  1312. OnDDTargetHasDropHandler(Self, Item, Effect, Result);
  1313. end;
  1314. end;
  1315. procedure TCustomDirView.UpdatePathComboBox;
  1316. begin
  1317. if Assigned(PathComboBox) then
  1318. PathComboBox.Path := Path;
  1319. end; { UpdatePathComboBox }
  1320. procedure TCustomDirView.UpdatePathLabel;
  1321. begin
  1322. if Assigned(PathLabel) then
  1323. begin
  1324. if csDesigning in ComponentState then
  1325. PathLabel.Caption := PathLabel.Name
  1326. else
  1327. PathLabel.Caption := PathName;
  1328. PathLabel.UpdateStatus;
  1329. end;
  1330. end; { UpdatePathLabel }
  1331. procedure TCustomDirView.UpdateStatusBar;
  1332. var
  1333. StatusFileInfo: TStatusFileInfo;
  1334. begin
  1335. if (FUpdatingSelection = 0) and Assigned(StatusBar) then
  1336. begin
  1337. with StatusFileInfo do
  1338. begin
  1339. SelectedSize := FilesSelSize;
  1340. FilesSize := Self.FilesSize;
  1341. SelectedCount := SelCount;
  1342. FilesCount := Self.FilesCount;
  1343. end;
  1344. StatusBar.FileInfo := StatusFileInfo;
  1345. end;
  1346. end; { UpdateStatusBar }
  1347. procedure TCustomDirView.WMContextMenu(var Message: TWMContextMenu);
  1348. var
  1349. Point: TPoint;
  1350. begin
  1351. FDragEnabled := False;
  1352. if Assigned(PopupMenu) then
  1353. PopupMenu.AutoPopup := False;
  1354. //inherited;
  1355. if FContextMenu and (not Loading) then
  1356. begin
  1357. Point.X := Message.XPos;
  1358. Point.Y := Message.YPos;
  1359. Point := ScreenToClient(Point);
  1360. if Assigned(OnMouseDown) then
  1361. OnMouseDown(Self, mbRight, [], Point.X, Point.Y);
  1362. if FUseSystemContextMenu and Assigned(ItemFocused) and
  1363. (GetItemAt(Point.X, Point.Y) = ItemFocused) then
  1364. begin
  1365. Point.X := Message.XPos;
  1366. Point.Y := Message.YPos;
  1367. DisplayContextMenu(Point);
  1368. end
  1369. else
  1370. if Assigned(PopupMenu) and (not PopupMenu.AutoPopup) then
  1371. PopupMenu.Popup(Message.XPos, Message.YPos);
  1372. end;
  1373. FContextMenu := False;
  1374. //inherited;
  1375. end;
  1376. procedure TCustomDirView.WMLButtonDown(var Message: TWMLButtonDown);
  1377. Begin
  1378. GetCursorPos(FStartPos);
  1379. FDragEnabled := (not Loading);
  1380. inherited;
  1381. end;
  1382. procedure TCustomDirView.WMPaint(var Message: TWMPaint);
  1383. begin
  1384. inherited;
  1385. if FNeverPainted then
  1386. begin
  1387. FNeverPainted := False;
  1388. Invalidate;
  1389. end;
  1390. end;
  1391. procedure TCustomDirView.WMRButtonDown(var Message: TWMRButtonDown);
  1392. begin
  1393. GetCursorPos(FStartPos);
  1394. if FDragDropFilesEx.DragDetectStatus <> ddsDrag then
  1395. FDragEnabled := (not Loading);
  1396. FContextMenu := True;
  1397. inherited;
  1398. end;
  1399. procedure TCustomDirView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1400. begin
  1401. inherited;
  1402. if (not SingleClickToExec) and Assigned(ItemFocused) and (not Loading) and
  1403. (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) then
  1404. begin
  1405. if GetKeyState(VK_MENU) < 0 then DisplayPropertiesMenu
  1406. else Execute(ItemFocused);
  1407. end;
  1408. end;
  1409. procedure TCustomDirView.WMLButtonUp(var Message: TWMLButtonUp);
  1410. begin
  1411. if SingleClickToExec and FDragEnabled and Assigned(ItemFocused) and (not Loading) and
  1412. (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) and
  1413. (GetKeyState(VK_SHIFT) >= 0) and (GetKeyState(VK_CONTROL) >= 0) then
  1414. begin
  1415. if GetKeyState(VK_MENU) < 0 then DisplayPropertiesMenu
  1416. else Execute(ItemFocused);
  1417. end;
  1418. FDragEnabled := False;
  1419. inherited;
  1420. end;
  1421. procedure TCustomDirView.Reload(CacheIcons: Boolean);
  1422. var
  1423. OldSelection: TStrings;
  1424. OldItemFocused: string;
  1425. Index: Integer;
  1426. FoundIndex: Integer;
  1427. IconCache: TStringList;
  1428. Item: TListItem;
  1429. FileName: string;
  1430. function FindInOldSelection(FileName: string): Boolean;
  1431. var
  1432. Index: Integer;
  1433. begin
  1434. Result := True;
  1435. for Index := 0 to OldSelection.Count - 1 do
  1436. if AnsiCompareStr(OldSelection[Index], FileName) = 0 then Exit;
  1437. Result := False;
  1438. end;
  1439. begin
  1440. if Path <> '' then
  1441. begin
  1442. OldSelection := nil;
  1443. IconCache := nil;
  1444. Items.BeginUpdate;
  1445. try
  1446. OldSelection := TStringList.Create;
  1447. if CacheIcons then
  1448. IconCache := TStringList.Create;
  1449. for Index := 0 to Items.Count-1 do
  1450. begin
  1451. Item := Items[Index];
  1452. FileName := Item.Caption;
  1453. if Item.Selected then
  1454. OldSelection.Add(FileName);
  1455. if CacheIcons and (ItemImageIndex(Item, True) >= 0) then
  1456. IconCache.AddObject(FileName, TObject(ItemImageIndex(Item, True)));
  1457. end;
  1458. if FSelectFile <> '' then
  1459. begin
  1460. OldItemFocused := FSelectFile;
  1461. FSelectFile := '';
  1462. end
  1463. else
  1464. if Assigned(ItemFocused) then OldItemFocused := ItemFocused.Caption
  1465. else OldItemFocused := '';
  1466. Load;
  1467. TStringList(OldSelection).Sort;
  1468. if CacheIcons then IconCache.Sort;
  1469. for Index := 0 to Items.Count - 1 do
  1470. begin
  1471. Item := Items[Index];
  1472. FileName := ItemFileName(Item);
  1473. if FileName = OldItemFocused then
  1474. ItemFocused := Item;
  1475. if ((not FCaseSensitive) and TStringList(OldSelection).Find(FileName, FoundIndex)) or
  1476. (FCaseSensitive and FindInOldSelection(FileName)) then
  1477. Item.Selected := True;
  1478. if CacheIcons and (ItemImageIndex(Item, True) < 0) then
  1479. begin
  1480. FoundIndex := IconCache.IndexOf(FileName);
  1481. if FoundIndex >= 0 then
  1482. SetItemImageIndex(Item, Integer(IconCache.Objects[FoundIndex]));
  1483. end;
  1484. end;
  1485. FocusSomething;
  1486. finally
  1487. Items.EndUpdate;
  1488. OldSelection.Free;
  1489. if CacheIcons then IconCache.Free;
  1490. end;
  1491. end;
  1492. end;
  1493. procedure TCustomDirView.Load;
  1494. var
  1495. SaveCursor: TCursor;
  1496. LastDirName: string;
  1497. begin
  1498. if not FLoadEnabled or Loading then
  1499. begin
  1500. FDirty := True;
  1501. FAbortLoading := True;
  1502. end
  1503. else
  1504. begin
  1505. FLoading := True;
  1506. try
  1507. FHasParentDir := False;
  1508. if Assigned(FOnStartLoading) then FOnStartLoading(Self);
  1509. SaveCursor := Screen.Cursor;
  1510. Screen.Cursor := crHourGlass;
  1511. try
  1512. FNotifyEnabled := False;
  1513. ClearItems;
  1514. GetSystemTime(FReloadTime);
  1515. FFilesSize := 0;
  1516. FFilesSelSize := 0;
  1517. SortType := stNone;
  1518. Items.BeginUpdate;
  1519. try
  1520. try
  1521. DoAnimation(True);
  1522. LoadFiles;
  1523. finally
  1524. DoAnimation(False);
  1525. end;
  1526. finally
  1527. Items.EndUpdate;
  1528. end;
  1529. finally
  1530. Screen.Cursor := SaveCursor;
  1531. end;
  1532. finally
  1533. FLoading := False;
  1534. try
  1535. if FAbortLoading then
  1536. begin
  1537. FAbortLoading := False;
  1538. Reload(False);
  1539. end
  1540. else
  1541. begin
  1542. if DirOK then SortItems;
  1543. FAbortLoading := False;
  1544. FDirty := False;
  1545. if (Length(LastPath) > Length(PathName)) and
  1546. (Copy(LastPath, 1, Length(PathName)) = PathName) and
  1547. (Items.Count > 0) then
  1548. begin
  1549. LastDirName := Copy(LastPath, LastDelimiter('\:/', LastPath) + 1, MaxInt);
  1550. ItemFocused := FindFileItem(LastDirName);
  1551. end;
  1552. end;
  1553. finally
  1554. // nested try .. finally block is included
  1555. // because we really want these to be executed
  1556. FNotifyEnabled := True;
  1557. if DirOK and not FAbortLoading and Assigned(FOnDirUpdated) then
  1558. FOnDirUpdated(Self);
  1559. FocusSomething;
  1560. if Assigned(FOnLoaded) then FOnLoaded(Self);
  1561. UpdatePathLabel;
  1562. UpdateStatusBar;
  1563. end;
  1564. end;
  1565. end;
  1566. end;
  1567. procedure TCustomDirView.SetLoadEnabled(Enabled: Boolean);
  1568. begin
  1569. if Enabled <> LoadEnabled then
  1570. begin
  1571. FLoadEnabled := Enabled;
  1572. if Enabled and Dirty then Reload(True);
  1573. end;
  1574. end;
  1575. function TCustomDirView.ItemDragFileName(Item: TListItem): string;
  1576. begin
  1577. Result := ItemFullFileName(Item);
  1578. end;
  1579. function TCustomDirView.GetFilesCount: Integer;
  1580. begin
  1581. Result := Items.Count;
  1582. if (Result > 0) and HasParentDir then Dec(Result);
  1583. end;
  1584. procedure TCustomDirView.SetViewStyle(Value: TViewStyle);
  1585. begin
  1586. if (Value <> ViewStyle) and (not FLoading) then
  1587. begin
  1588. FNotifyEnabled := False;
  1589. inherited;
  1590. FNotifyEnabled := True;
  1591. end;
  1592. end;
  1593. procedure TCustomDirView.ColClick(Column: TListColumn);
  1594. var
  1595. ScrollToFocused: Boolean;
  1596. begin
  1597. ScrollToFocused := Assigned(ItemFocused);
  1598. inherited;
  1599. if ScrollToFocused and Assigned(ItemFocused) then
  1600. ItemFocused.MakeVisible(False);
  1601. end;
  1602. procedure TCustomDirView.CustomSortItems(SortProc: Pointer);
  1603. var
  1604. SavedCursor: TCursor;
  1605. SavedNotifyEnabled: Boolean;
  1606. begin
  1607. if HandleAllocated then
  1608. begin
  1609. SavedNotifyEnabled := FNotifyEnabled;
  1610. SavedCursor := Screen.Cursor;
  1611. Items.BeginUpdate;
  1612. try
  1613. Screen.Cursor := crHourglass;
  1614. FNotifyEnabled := False;
  1615. CustomSort(TLVCompare(SortProc), Integer(Pointer(Self)));
  1616. finally
  1617. Screen.Cursor := SavedCursor;
  1618. FNotifyEnabled := SavedNotifyEnabled;
  1619. Items.EndUpdate;
  1620. end;
  1621. end;
  1622. end;
  1623. procedure TCustomDirView.ReloadForce(CacheIcons: Boolean);
  1624. begin
  1625. FLoadEnabled := True;
  1626. FDirty := False;
  1627. Reload(CacheIcons);
  1628. end;
  1629. procedure TCustomDirView.DDDragEnter(DataObj: IDataObject; grfKeyState: Longint;
  1630. Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  1631. var
  1632. Index: Integer;
  1633. begin
  1634. Accept := Accept and DirOK and (not Loading);
  1635. if Accept and (DragDropFilesEx.FileList.Count > 0) and
  1636. (Length(TFDDListItem(DragDropFilesEx.FileList[0]^).Name) > 2) and
  1637. ((TFDDListItem(DragDropFilesEx.FileList[0]^).Name[2] = ':') or
  1638. (TFDDListItem(DragDropFilesEx.FileList[0]^).Name[2] = '\')) and
  1639. (not IsRecycleBin or not DragDropFilesEx.FileNamesAreMapped) then
  1640. begin
  1641. FDragDrive := Upcase(TFDDListItem(DragDropFilesEx.FileList[0]^).Name[1]);
  1642. FExeDrag := FDDLinkOnExeDrag and
  1643. (deLink in DragDropFilesEx.TargetEffects) and
  1644. ((DragDropFilesEx.AvailableDropEffects and DropEffect_Link) <> 0);
  1645. if FExeDrag then
  1646. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  1647. if not IsExecutable(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  1648. begin
  1649. FExeDrag := False;
  1650. Break;
  1651. end;
  1652. end
  1653. else
  1654. begin
  1655. FDragDrive := #0;
  1656. Accept := False;
  1657. end;
  1658. GetSystemTimeAsFileTime(FLastVScrollTime);
  1659. FVScrollCount := 0;
  1660. if Assigned(FOnDDDragEnter) then
  1661. FOnDDDragEnter(Self, DataObj, grfKeyState, Point, dwEffect, Accept);
  1662. end;
  1663. procedure TCustomDirView.DDDragLeave;
  1664. begin
  1665. if Assigned(DropTarget) and GlobalDragImageList.Dragging then
  1666. begin
  1667. GlobalDragImageList.HideDragImage;
  1668. DropTarget := nil;
  1669. Update; {ie30}
  1670. end
  1671. else DropTarget := nil;
  1672. if Assigned(FOnDDDragLeave) then
  1673. FOnDDDragLeave(Self);
  1674. end;
  1675. procedure TCustomDirView.DDDragOver(grfKeyState: Integer; Point: TPoint;
  1676. var dwEffect: Integer);
  1677. var
  1678. DropItem: TListItem;
  1679. KnowTime: TFileTime;
  1680. NbPixels: Integer;
  1681. CanDrop: Boolean;
  1682. HasDropHandler: Boolean;
  1683. WParam: LongInt;
  1684. begin
  1685. FDDOwnerIsSource := DragDropFilesEx.OwnerIsSource;
  1686. {Set droptarget if target is directory:}
  1687. if not Loading then DropItem := GetItemAt(Point.X, Point.Y)
  1688. else DropItem := nil;
  1689. HasDropHandler := (Assigned(DropItem) and (not IsRecycleBin) and
  1690. TargetHasDropHandler(DropItem, dwEffect));
  1691. CanDrop := Assigned(DropItem) and (not IsRecycleBin) and
  1692. (ItemIsDirectory(DropItem) or HasDropHandler);
  1693. if (CanDrop and (DropTarget <> DropItem)) or
  1694. (not CanDrop and Assigned(DropTarget)) then
  1695. begin
  1696. if GlobalDragImageList.Dragging then
  1697. begin
  1698. GlobalDragImageList.HideDragImage;
  1699. DropTarget := nil;
  1700. Update;
  1701. if CanDrop then
  1702. begin
  1703. DropTarget := DropItem;
  1704. Update;
  1705. end;
  1706. GlobalDragImageList.ShowDragImage;
  1707. end
  1708. else
  1709. begin
  1710. DropTarget := nil;
  1711. if CanDrop then DropTarget := DropItem;
  1712. end;
  1713. end;
  1714. GetSystemTimeAsFileTime(KnowTime);
  1715. NbPixels := Abs((Font.Height));
  1716. {Vertical scrolling, if viewstyle = vsReport:}
  1717. if (ViewStyle = vsReport) and (not Loading) and Assigned(TopItem) and
  1718. (((Int64(KnowTime) - Int64(FLastVScrollTime)) > DDVScrollDelay) or
  1719. ((FVScrollCount > DDMaxSlowCount) and
  1720. ((Int64(KnowTime) - Int64(FLastVScrollTime)) > (DDVScrollDelay div 4)))) then
  1721. begin
  1722. if ((DropItem = TopItem) or (Point.Y - 3 * nbPixels <= 0)) and
  1723. (TopItem.Index > 0) then WParam := SB_LINEUP
  1724. else
  1725. if (Point.Y + 3 * nbPixels > Height) then WParam := SB_LINEDOWN
  1726. else WParam := -1;
  1727. if WParam >= 0 then
  1728. begin
  1729. if GlobalDragImageList.Dragging then
  1730. GlobalDragImageList.HideDragImage;
  1731. Perform(WM_VSCROLL, WParam, 0);
  1732. if FVScrollCount > DDMaxSlowCount then
  1733. Perform(WM_VSCROLL, WParam, 0);
  1734. if FVScrollCount > DDMaxSlowCount * 3 then
  1735. Perform(WM_VSCROLL, WParam, 0);
  1736. Update;
  1737. if GlobalDragImageList.Dragging then
  1738. GlobalDragImageList.ShowDragImage;
  1739. GetSystemTimeAsFileTime(FLastVScrollTime);
  1740. Inc(FVScrollCount);
  1741. end
  1742. else FVScrollCount := 0;
  1743. end; {VScrollDelay}
  1744. {Set dropeffect:}
  1745. if (not HasDropHandler) and (not Loading) then
  1746. begin
  1747. DDChooseEffect(grfKeyState, dwEffect);
  1748. if Assigned(FOnDDDragOver) then
  1749. FOnDDDragOver(Self, grfKeyState, Point, dwEffect);
  1750. if DragDropFilesEx.OwnerIsSource and (dwEffect = DropEffect_Move) and
  1751. (not Assigned(DropTarget)) then dwEffect := DropEffect_None
  1752. else
  1753. if Assigned(DropTarget) and ItemIsRecycleBin(DropTarget) Then
  1754. dwEffect := DropEffect_Move;
  1755. end;
  1756. end;
  1757. function TCustomDirView.CustomCreateFileList(Focused, OnlyFocused: Boolean;
  1758. FullPath: Boolean; FileList: TStrings): TStrings;
  1759. procedure AddItem(Item: TListItem);
  1760. begin
  1761. Assert(Assigned(Item));
  1762. if FullPath then Result.AddObject(ItemFullFileName(Item), Item.Data)
  1763. else Result.AddObject(ItemFileName(Item), Item.Data);
  1764. end;
  1765. var
  1766. Item: TListItem;
  1767. begin
  1768. if Assigned(FileList) then Result := FileList
  1769. else Result := TStringList.Create;
  1770. try
  1771. if Assigned(ItemFocused) and
  1772. ((Focused and (not ItemFocused.Selected)) or (SelCount = 0) or OnlyFocused) then
  1773. begin
  1774. AddItem(ItemFocused)
  1775. end
  1776. else
  1777. begin
  1778. Item := GetNextItem(nil, sdAll, [isSelected]);
  1779. while Assigned(Item) do
  1780. begin
  1781. AddItem(Item);
  1782. Item := GetNextItem(Item, sdAll, [isSelected]);
  1783. end;
  1784. end;
  1785. except
  1786. if not Assigned(FileList) then FreeAndNil(Result);
  1787. raise;
  1788. end;
  1789. end;
  1790. function TCustomDirView.CreateFocusedFileList(FullPath: Boolean; FileList: TStrings): TStrings;
  1791. begin
  1792. Result := CustomCreateFileList(False, True, FullPath, FileList);
  1793. end;
  1794. function TCustomDirView.CreateFileList(Focused: Boolean; FullPath: Boolean;
  1795. FileList: TStrings): TStrings;
  1796. begin
  1797. Result := CustomCreateFileList(Focused, False, FullPath, FileList);
  1798. end;
  1799. procedure TCustomDirView.DDDrop(DataObj: IDataObject; grfKeyState: Integer;
  1800. Point: TPoint; var dwEffect: Integer);
  1801. begin
  1802. if GlobalDragImageList.Dragging then
  1803. GlobalDragImageList.HideDragImage;
  1804. if dwEffect = DropEffect_None then
  1805. DropTarget := nil;
  1806. if Assigned(OnDDDrop) then
  1807. OnDDDrop(Self, DataObj, grfKeyState, Point, dwEffect);
  1808. end;
  1809. procedure TCustomDirView.DDQueryContinueDrag(FEscapePressed: LongBool;
  1810. grfKeyState: Integer; var Result: HResult);
  1811. var
  1812. MousePos: TPoint;
  1813. KnowTime: TFileTime;
  1814. begin
  1815. if Result = DRAGDROP_S_DROP then
  1816. begin
  1817. GetSystemTimeAsFileTime(KnowTime);
  1818. if ((Int64(KnowTime) - INT64(FDragStartTime)) <= DDDragStartDelay) then
  1819. Result := DRAGDROP_S_CANCEL;
  1820. end;
  1821. if Assigned(OnDDQueryContinueDrag) then
  1822. OnDDQueryContinueDrag(Self, FEscapePressed, grfKeyState, Result);
  1823. if FEscapePressed then
  1824. begin
  1825. if GlobalDragImageList.Dragging then
  1826. GlobalDragImageList.HideDragImage;
  1827. end
  1828. else
  1829. begin
  1830. if GlobalDragImageList.Dragging Then
  1831. begin
  1832. MousePos := ParentForm.ScreenToClient(Mouse.CursorPos);
  1833. {Move the drag image to the new position and show it:}
  1834. if (MousePos.X <> FDragPos.X) or (MousePos.Y <> FDragPos.Y) then
  1835. begin
  1836. FDragPos := MousePos;
  1837. if PtInRect(ParentForm.BoundsRect, Mouse.CursorPos) then
  1838. begin
  1839. GlobalDragImageList.DragMove(MousePos.X, MousePos.Y);
  1840. GlobalDragImageList.ShowDragImage;
  1841. end
  1842. else GlobalDragImageList.HideDragImage;
  1843. end;
  1844. end;
  1845. end;
  1846. end;
  1847. procedure TCustomDirView.DDSpecifyDropTarget(Sender: TObject;
  1848. DragDropHandler: Boolean; Point: TPoint; var pidlFQ: PItemIDList;
  1849. var Filename: string);
  1850. var
  1851. Item: TListItem;
  1852. begin
  1853. pidlFQ := nil;
  1854. if DirOK and (not Loading) then
  1855. begin
  1856. if DragDropHandler then
  1857. begin
  1858. if Assigned(DropTarget) and ItemIsDirectory(DropTarget) then
  1859. FileName := ItemFullFileName(DropTarget)
  1860. else
  1861. FileName := PathName;
  1862. end
  1863. else
  1864. begin
  1865. Item := GetItemAt(Point.X, Point.Y);
  1866. if Assigned(Item) and (not ItemIsDirectory(Item)) and
  1867. (not IsRecycleBin) then
  1868. FileName := ItemFullFileName(Item)
  1869. else
  1870. FileName := '';
  1871. end;
  1872. end
  1873. else FileName := '';
  1874. end;
  1875. procedure TCustomDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu;
  1876. DataObj: IDataObject; AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  1877. begin
  1878. if Assigned(OnDDMenuPopup) then
  1879. begin
  1880. OnDDMenuPopup(Self, AMenu, DataObj, AMinCustCmd, grfKeyState, pt);
  1881. end;
  1882. end;
  1883. procedure TCustomDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  1884. begin
  1885. end;
  1886. procedure TCustomDirView.DDDropHandlerSucceeded(Sender: TObject;
  1887. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  1888. begin
  1889. DropTarget := nil;
  1890. end;
  1891. procedure TCustomDirView.DDGiveFeedback(dwEffect: Integer;
  1892. var Result: HResult);
  1893. begin
  1894. if Assigned(FOnDDGiveFeedback) then
  1895. FOnDDGiveFeedback(Self, dwEffect, Result);
  1896. end;
  1897. procedure TCustomDirView.DDProcessDropped(Sender: TObject;
  1898. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  1899. begin
  1900. if DirOK and (not Loading) then
  1901. try
  1902. try
  1903. if Assigned(FOnDDProcessDropped) then
  1904. FOnDDProcessDropped(Self, grfKeyState, Point, dwEffect);
  1905. if dwEffect <> DropEffect_None then
  1906. begin
  1907. PerformItemDragDropOperation(DropTarget, dwEffect);
  1908. if Assigned(FOnDDExecuted) then
  1909. FOnDDExecuted(Self, dwEffect);
  1910. end;
  1911. finally
  1912. DragDropFilesEx.FileList.Clear;
  1913. DropTarget := nil;
  1914. end;
  1915. except
  1916. Application.HandleException(Self);
  1917. end;
  1918. end;
  1919. function TCustomDirView.AnyFileSelected(OnlyFocused: Boolean): Boolean;
  1920. var
  1921. Item: TListItem;
  1922. begin
  1923. if OnlyFocused or (SelCount = 0) then
  1924. Result := Assigned(ItemFocused) and ItemIsFile(ItemFocused)
  1925. else
  1926. begin
  1927. Result := True;
  1928. Item := GetNextItem(nil, sdAll, [isSelected]);
  1929. while Assigned(Item) do
  1930. begin
  1931. if ItemIsFile(Item) then Exit;
  1932. Item := GetNextItem(Item, sdAll, [isSelected]);
  1933. end;
  1934. Result := False;
  1935. end;
  1936. end;
  1937. function TCustomDirView.CanEdit(Item: TListItem): Boolean;
  1938. begin
  1939. Result :=
  1940. (inherited CanEdit(Item) or FForceRename) and (not Loading) and
  1941. Assigned(Item) and (not ReadOnly) and (not IsRecycleBin) and
  1942. (not ItemIsParentDirectory(Item));
  1943. if Result then FLoadEnabled := False;
  1944. FForceRename := False;
  1945. end;
  1946. function TCustomDirView.CanChangeSelection(Item: TListItem;
  1947. Select: Boolean): Boolean;
  1948. begin
  1949. Result :=
  1950. (not Loading) and
  1951. not (Assigned(Item) and Assigned(Item.Data) and
  1952. ItemIsParentDirectory(Item));
  1953. end;
  1954. procedure TCustomDirView.Edit(const HItem: TLVItem);
  1955. var
  1956. Item: TListItem;
  1957. Info: string;
  1958. Index: Integer;
  1959. begin
  1960. if Length(HItem.pszText) = 0 then LoadEnabled := True
  1961. else
  1962. begin
  1963. Item := GetItemFromHItem(HItem);
  1964. {Does the changed filename contains invalid characters?}
  1965. if StrContains(FInvalidNameChars, HItem.pszText) then
  1966. begin
  1967. Info := FInvalidNameChars;
  1968. for Index := Length(Info) downto 1 do
  1969. System.Insert(Space, Info, Index);
  1970. MessageBeep(MB_ICONHAND);
  1971. if MessageDlg(SErrorInvalidName + Space + Info, mtError,
  1972. [mbOK, mbAbort], 0) = mrOK then RetryRename(HItem.pszText);
  1973. LoadEnabled := True;
  1974. end
  1975. else
  1976. begin
  1977. if Assigned(FOnBeginRename) then
  1978. FOnBeginRename(Self, Item, string(HItem.pszText));
  1979. InternalEdit(HItem);
  1980. if Assigned(FOnEndRename) then
  1981. FOnEndRename(Self, Item, string(HItem.pszText));
  1982. end;
  1983. end;
  1984. end; {Edit}
  1985. procedure TCustomDirView.EndSelectionUpdate;
  1986. begin
  1987. inherited;
  1988. if FUpdatingSelection = 0 then
  1989. UpdateStatusBar;
  1990. end; { EndUpdatingSelection }
  1991. procedure TCustomDirView.ExecuteCurrentFile();
  1992. begin
  1993. Assert(Assigned(ItemFocused));
  1994. Execute(ItemFocused);
  1995. end;
  1996. procedure TCustomDirView.Execute(Item: TListItem);
  1997. var
  1998. AllowExec: Boolean;
  1999. begin
  2000. Assert(Assigned(Item));
  2001. if Assigned(Item) and Assigned(Item.Data) and (not Loading) then
  2002. begin
  2003. if IsRecycleBin then DisplayPropertiesMenu
  2004. else
  2005. begin
  2006. AllowExec := True;
  2007. if Assigned(FOnExecFile) then FOnExecFile(Self, Item, AllowExec);
  2008. if AllowExec then
  2009. begin
  2010. if ItemIsParentDirectory(Item) then ExecuteParentDirectory
  2011. else ExecuteFile(Item);
  2012. end;
  2013. end;
  2014. end;
  2015. end;
  2016. procedure TCustomDirView.GetDisplayInfo(ListItem: TListItem;
  2017. var DispInfo: TLVItemA);
  2018. begin
  2019. // Nothing
  2020. end;
  2021. procedure TCustomDirView.WMUserRename(var Message: TMessage);
  2022. begin
  2023. if Assigned(ItemFocused) then
  2024. begin
  2025. FForceRename := True;
  2026. ListView_EditLabel(Handle, ItemFocused.Index);
  2027. SetWindowText(ListView_GetEditControl(Self.Handle),
  2028. PChar(FLastRenameName));
  2029. end;
  2030. end;
  2031. procedure TCustomDirView.RetryRename(NewName: string);
  2032. begin
  2033. FLastRenameName := NewName;
  2034. PostMessage(Self.Handle, WM_USER_RENAME, Longint(PChar(NewName)), 0);
  2035. end;
  2036. procedure TCustomDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2037. begin
  2038. FileList.AddItem(nil, ItemDragFileName(Item));
  2039. end;
  2040. procedure TCustomDirView.DDDragDetect(grfKeyState: Integer; DetectStart,
  2041. Point: TPoint; DragStatus: TDragDetectStatus);
  2042. var
  2043. FilesCount: Integer;
  2044. DirsCount: Integer;
  2045. Item: TListItem;
  2046. FirstItem : TListItem;
  2047. Bitmap: TBitmap;
  2048. ImageListHandle: HImageList;
  2049. Spot: TPoint;
  2050. ItemPos: TPoint;
  2051. DragText: string;
  2052. ClientPoint: TPoint;
  2053. OldCursor: TCursor;
  2054. FileListCreated: Boolean;
  2055. AvoidDragImage: Boolean;
  2056. DataObject: TDataObject;
  2057. begin
  2058. if Assigned(FOnDDDragDetect) then
  2059. FOnDDDragDetect(Self, grfKeyState, DetectStart, Point, DragStatus);
  2060. if (DragStatus = ddsDrag) and (not Loading) and (MarkedCount > 0) then
  2061. begin
  2062. DragDropFilesEx.CompleteFileList := DragCompleteFileList;
  2063. DragDropFilesEx.FileList.Clear;
  2064. FirstItem := nil;
  2065. FilesCount := 0;
  2066. DirsCount := 0;
  2067. FileListCreated := False;
  2068. if Assigned(OnDDCreateDragFileList) then
  2069. begin
  2070. OnDDCreateDragFileList(Self, DragDropFilesEx.FileList, FileListCreated);
  2071. if FileListCreated then
  2072. begin
  2073. AvoidDragImage := True;
  2074. end;
  2075. end;
  2076. if not FileListCreated then
  2077. begin
  2078. if Assigned(ItemFocused) and (not ItemFocused.Selected) and
  2079. ItemCanDrag(ItemFocused) then
  2080. begin
  2081. FirstItem := ItemFocused;
  2082. AddToDragFileList(DragDropFilesEx.FileList, ItemFocused);
  2083. if ItemIsDirectory(ItemFocused) then Inc(DirsCount)
  2084. else Inc(FilesCount);
  2085. end
  2086. else
  2087. if SelCount > 0 then
  2088. begin
  2089. Item := GetNextItem(nil, sdAll, [isSelected]);
  2090. while Assigned(Item) do
  2091. begin
  2092. if ItemCanDrag(Item) then
  2093. begin
  2094. if not Assigned(FirstItem) then FirstItem := Item;
  2095. AddToDragFileList(DragDropFilesEx.FileList, Item);
  2096. if ItemIsDirectory(Item) then Inc(DirsCount)
  2097. else Inc(FilesCount);
  2098. end;
  2099. Item := GetNextItem(Item, sdAll, [isSelected]);
  2100. end;
  2101. end;
  2102. end;
  2103. if DragDropFilesEx.FileList.Count > 0 then
  2104. begin
  2105. OldCursor := Screen.Cursor;
  2106. Screen.Cursor := crHourGlass;
  2107. try
  2108. FDragEnabled := False;
  2109. {Create the dragimage:}
  2110. GlobalDragImageList := DragImageList;
  2111. if UseDragImages and (not AvoidDragImage) then
  2112. begin
  2113. ImageListHandle := ListView_CreateDragImage(Handle, FirstItem.Index, Spot);
  2114. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2115. if ImageListHandle <> Invalid_Handle_Value then
  2116. begin
  2117. GlobalDragImageList.Handle := ImageListHandle;
  2118. if FilesCount + DirsCount = 1 then
  2119. begin
  2120. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2121. GlobalDragImageList.SetDragImage(0,
  2122. DetectStart.X - ItemPos.X, DetectStart.Y - ItemPos.Y);
  2123. end
  2124. else
  2125. begin
  2126. GlobalDragImageList.Clear;
  2127. GlobalDragImageList.Width := 32;
  2128. GlobalDragImageList.Height := 32;
  2129. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES', 0,
  2130. [lrTransparent], $FFFFFF) Then
  2131. begin
  2132. Bitmap := TBitmap.Create;
  2133. try
  2134. try
  2135. GlobalDragImageList.GetBitmap(0, Bitmap);
  2136. Bitmap.Canvas.Font.Assign(Self.Font);
  2137. DragText := '';
  2138. if FilesCount > 0 then
  2139. DragText := Format(STextFiles, [FilesCount]);
  2140. if DirsCount > 0 then
  2141. begin
  2142. if FilesCount > 0 then
  2143. DragText := DragText + ', ';
  2144. DragText := DragText + Format(STextDirectories, [DirsCount]);
  2145. end;
  2146. Bitmap.Width := 33 + Bitmap.Canvas.TextWidth(DragText);
  2147. Bitmap.TransparentMode := tmAuto;
  2148. Bitmap.Canvas.TextOut(33,
  2149. Max(24 - Abs(Canvas.Font.Height), 0), DragText);
  2150. GlobalDragImageList.Clear;
  2151. GlobalDragImageList.Width := Bitmap.Width;
  2152. GlobalDragImageList.AddMasked(Bitmap,
  2153. Bitmap.Canvas.Pixels[0, 0]);
  2154. GlobalDragImageList.SetDragImage(0, 25, 20);
  2155. except
  2156. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES',
  2157. 0, [lrTransparent], $FFFFFF) then
  2158. GlobalDragImageList.SetDragImage(0, 25, 20);
  2159. end;
  2160. finally
  2161. Bitmap.Free;
  2162. end;
  2163. end;
  2164. end;
  2165. ClientPoint := ParentForm.ScreenToClient(Point);
  2166. GlobalDragImageList.BeginDrag(ParentForm.Handle,
  2167. ClientPoint.X, ClientPoint.Y);
  2168. GlobalDragImageList.HideDragImage;
  2169. ShowCursor(True);
  2170. end;
  2171. end;
  2172. finally
  2173. Screen.Cursor := OldCursor;
  2174. end;
  2175. FContextMenu := False;
  2176. if IsRecycleBin then DragDropFilesEx.SourceEffects := [deMove]
  2177. else DragDropFilesEx.SourceEffects := DragSourceEffects;
  2178. DropSourceControl := Self;
  2179. try
  2180. GetSystemTimeAsFileTime(FDragStartTime);
  2181. DataObject := nil;
  2182. if Assigned(OnDDCreateDataObject) then
  2183. begin
  2184. OnDDCreateDataObject(Self, DataObject);
  2185. end;
  2186. {Execute the drag&drop-Operation:}
  2187. FLastDDResult := DragDropFilesEx.Execute(DataObject);
  2188. {the drag&drop operation is finished, so clean up the used drag image:}
  2189. GlobalDragImageList.EndDrag;
  2190. GlobalDragImageList.Clear;
  2191. Application.ProcessMessages;
  2192. finally
  2193. DropSourceControl := nil;
  2194. DragDropFilesEx.FileList.Clear;
  2195. FContextMenu := False;
  2196. DropTarget := nil;
  2197. if Assigned(OnDDEnd) then
  2198. begin
  2199. OnDDEnd(Self);
  2200. end;
  2201. end;
  2202. end;
  2203. end;
  2204. end;
  2205. procedure TCustomDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2206. begin
  2207. inherited;
  2208. if Operation = opRemove then
  2209. begin
  2210. if AComponent = PathLabel then FPathLabel := nil;
  2211. if AComponent = StatusBar then FStatusBar := nil;
  2212. if AComponent = PathComboBox then FPathComboBox := nil;
  2213. end;
  2214. end; { Notification }
  2215. procedure TCustomDirView.WndProc(var Message: TMessage);
  2216. begin
  2217. case Message.Msg of
  2218. WM_SETFOCUS, WM_KILLFOCUS:
  2219. UpdatePathLabel;
  2220. end;
  2221. inherited;
  2222. end; { WndProc }
  2223. function TCustomDirView.FindFileItem(FileName: string): TListItem;
  2224. type
  2225. TFileNameCompare = function(const S1, S2: string): Integer;
  2226. var
  2227. Index: Integer;
  2228. CompareFunc: TFileNameCompare;
  2229. begin
  2230. if FCaseSensitive then CompareFunc := CompareStr
  2231. else CompareFunc := CompareText;
  2232. begin
  2233. for Index := 0 to Items.Count - 1 do
  2234. if CompareFunc(FileName, ItemFileName(Items[Index])) = 0 then
  2235. begin
  2236. Result := Items[Index];
  2237. Exit;
  2238. end;
  2239. Result := nil;
  2240. end;
  2241. end;
  2242. procedure TCustomDirView.DoAnimation(Start: Boolean);
  2243. begin
  2244. if Start and LoadAnimation then
  2245. begin
  2246. if not Assigned(FAnimation) then
  2247. begin
  2248. FAnimation := TAnimate.Create(Self);
  2249. try
  2250. FAnimation.Top := (Height - FAnimation.Height) div 2;
  2251. FAnimation.Left := (Width - FAnimation.Width) div 2;
  2252. FAnimation.Parent := Self;
  2253. FAnimation.CommonAVI := aviFindFolder;
  2254. FAnimation.Transparent := True;
  2255. FAnimation.Active := True;
  2256. except
  2257. FreeAndNil(FAnimation);
  2258. end;
  2259. end;
  2260. end
  2261. else
  2262. if not Start then
  2263. FreeAndNil(FAnimation);
  2264. end; { DoAnimation }
  2265. function TCustomDirView.GetForwardCount: Integer;
  2266. begin
  2267. Result := FHistoryPaths.Count - BackCount;
  2268. end; { GetForwardCount }
  2269. function TCustomDirView.GetBackMenu: TPopupMenu;
  2270. begin
  2271. if not Assigned(FBackMenu) then
  2272. begin
  2273. FBackMenu := TPopupMenu.Create(Self);
  2274. UpdateHistoryMenu(hdBack);
  2275. end;
  2276. Result := FBackMenu;
  2277. end; { GetBackMenu }
  2278. function TCustomDirView.GetForwardMenu: TPopupMenu;
  2279. begin
  2280. if not Assigned(FForwardMenu) then
  2281. begin
  2282. FForwardMenu := TPopupMenu.Create(Self);
  2283. UpdateHistoryMenu(hdForward);
  2284. end;
  2285. Result := FForwardMenu;
  2286. end; { GetForwardMenu }
  2287. procedure TCustomDirView.HistoryItemClick(Sender: TObject);
  2288. begin
  2289. HistoryGo((Sender as TMenuItem).Tag);
  2290. end; { HistoryItemClick }
  2291. procedure TCustomDirView.LimitHistorySize;
  2292. begin
  2293. while FHistoryPaths.Count > MaxHistoryCount do
  2294. begin
  2295. if BackCount > 0 then
  2296. begin
  2297. FHistoryPaths.Delete(0);
  2298. Dec(FBackCount);
  2299. end
  2300. else
  2301. FHistoryPaths.Delete(FHistoryPaths.Count-1);
  2302. end;
  2303. end; { LimitHistorySize }
  2304. procedure TCustomDirView.UpdateHistoryMenu(Direction: THistoryDirection);
  2305. var
  2306. Menu: TPopupMenu;
  2307. ICount: Integer;
  2308. Index: Integer;
  2309. Factor: Integer;
  2310. Item: TMenuItem;
  2311. begin
  2312. if Direction = hdBack then
  2313. begin
  2314. Menu := BackMenu;
  2315. ICount := BackCount;
  2316. Factor := -1;
  2317. end
  2318. else
  2319. begin
  2320. Menu := ForwardMenu;
  2321. ICount := ForwardCount;
  2322. Factor := 1;
  2323. end;
  2324. if ICount > MaxHistoryMenuLen then ICount := MaxHistoryMenuLen;
  2325. if Assigned(Menu) then
  2326. with Menu.Items do
  2327. begin
  2328. Clear;
  2329. for Index := 1 to ICount do
  2330. begin
  2331. Item := TMenuItem.Create(Menu);
  2332. with Item do
  2333. begin
  2334. Caption := MinimizePath(HistoryPath[Index * Factor],
  2335. MaxHistoryMenuWidth);
  2336. Hint := HistoryPath[Index * Factor];
  2337. Tag := Index * Factor;
  2338. OnClick := HistoryItemClick;
  2339. end;
  2340. Add(Item);
  2341. end;
  2342. end;
  2343. end; { UpdateHistoryMenu }
  2344. function TCustomDirView.GetHistoryPath(Index: Integer): string;
  2345. begin
  2346. Assert(Assigned(FHistoryPaths));
  2347. if Index = 0 then Result := PathName
  2348. else
  2349. if Index < 0 then Result := FHistoryPaths[Index + BackCount]
  2350. else
  2351. if Index > 0 then Result := FHistoryPaths[Index + BackCount - 1];
  2352. end; { GetHistoryPath }
  2353. procedure TCustomDirView.SetMaxHistoryCount(Value: Integer);
  2354. begin
  2355. if FMaxHistoryCount <> Value then
  2356. begin
  2357. FMaxHistoryCount := Value;
  2358. DoHistoryChange;
  2359. end;
  2360. end; { SetMaxHistoryCount }
  2361. procedure TCustomDirView.SetMaxHistoryMenuLen(Value: Integer);
  2362. begin
  2363. if FMaxHistoryMenuLen <> Value then
  2364. begin
  2365. FMaxHistoryMenuLen := Value;
  2366. DoHistoryChange;
  2367. end;
  2368. end; { SetMaxHistoryMenuLen }
  2369. procedure TCustomDirView.SetMaxHistoryMenuWidth(Value: Integer);
  2370. begin
  2371. if FMaxHistoryMenuWidth <> Value then
  2372. begin
  2373. FMaxHistoryMenuWidth := Value;
  2374. DoHistoryChange;
  2375. end;
  2376. end; { SetMaxHistoryMenuWidth }
  2377. procedure TCustomDirView.DoHistoryChange;
  2378. begin
  2379. LimitHistorySize;
  2380. UpdateHistoryMenu(hdBack);
  2381. UpdateHistoryMenu(hdForward);
  2382. if Assigned(OnHistoryChange) then
  2383. OnHistoryChange(Self);
  2384. end; { DoHistoryChange }
  2385. procedure TCustomDirView.HistoryGo(Index: Integer);
  2386. begin
  2387. if Index <> 0 then
  2388. begin
  2389. FDontRecordPath := True;
  2390. try
  2391. Path := HistoryPath[Index];
  2392. finally
  2393. FDontRecordPath := False;
  2394. end;
  2395. FHistoryPaths.Insert(FBackCount, LastPath);
  2396. FHistoryPaths.Delete(Index + BackCount);
  2397. Inc(FBackCount, Index);
  2398. DoHistoryChange;
  2399. end;
  2400. end; { HistoryGo }
  2401. procedure TCustomDirView.PathChanged;
  2402. var
  2403. Index: Integer;
  2404. begin
  2405. UpdatePathComboBox;
  2406. if (not FDontRecordPath) and (LastPath <> '') and (LastPath <> PathName) then
  2407. begin
  2408. Assert(Assigned(FHistoryPaths));
  2409. for Index := FHistoryPaths.Count - 1 downto BackCount do
  2410. FHistoryPaths.Delete(Index);
  2411. FHistoryPaths.Add(LastPath);
  2412. Inc(FBackCount);
  2413. DoHistoryChange;
  2414. end;
  2415. end; { PathChanged }
  2416. procedure TCustomDirView.ProcessChangedFiles(DirView: TCustomDirView;
  2417. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  2418. Criterias: TCompareCriterias);
  2419. var
  2420. Item, MirrorItem: TListItem;
  2421. FileTime, MirrorFileTime: TDateTime;
  2422. OldCursor: TCursor;
  2423. Index: Integer;
  2424. Changed: Boolean;
  2425. SameTime: Boolean;
  2426. Precision, MirrorPrecision: TDateTimePrecision;
  2427. begin
  2428. Assert(Valid);
  2429. OldCursor := Screen.Cursor;
  2430. if not Assigned(FileList) then
  2431. begin
  2432. Items.BeginUpdate;
  2433. BeginSelectionUpdate;
  2434. end;
  2435. try
  2436. Screen.Cursor := crHourGlass;
  2437. for Index := 0 to Items.Count-1 do
  2438. begin
  2439. Item := Items[Index];
  2440. Changed := False;
  2441. if not ItemIsDirectory(Item) then
  2442. begin
  2443. MirrorItem := DirView.FindFileItem(ItemFileName(Item));
  2444. if MirrorItem = nil then
  2445. begin
  2446. Changed := not ExistingOnly;
  2447. end
  2448. else
  2449. begin
  2450. if ccTime in Criterias then
  2451. begin
  2452. FileTime := ItemFileTime(Item, Precision);
  2453. MirrorFileTime := DirView.ItemFileTime(MirrorItem, MirrorPrecision);
  2454. if MirrorPrecision < Precision then Precision := MirrorPrecision;
  2455. if Precision <> tpMillisecond then
  2456. begin
  2457. ReduceDateTimePrecision(FileTime, Precision);
  2458. ReduceDateTimePrecision(MirrorFileTime, Precision);
  2459. end;
  2460. Changed :=
  2461. (FileTime > MirrorFileTime) { or
  2462. ((FileTime = MirrorFileTime) and
  2463. (ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem))) };
  2464. SameTime := (FileTime = MirrorFileTime);
  2465. end
  2466. else
  2467. begin
  2468. SameTime := True;
  2469. end;
  2470. if (not Changed) and SameTime and (ccSize in Criterias) then
  2471. begin
  2472. Changed := ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem);
  2473. end
  2474. end;
  2475. end;
  2476. if Assigned(FileList) then
  2477. begin
  2478. if Changed then
  2479. begin
  2480. if FullPath then
  2481. begin
  2482. FileList.AddObject(ItemFullFileName(Item), Item.Data)
  2483. end
  2484. else
  2485. begin
  2486. FileList.AddObject(ItemFileName(Item), Item.Data);
  2487. end;
  2488. end;
  2489. end
  2490. else
  2491. begin
  2492. Item.Selected := Changed;
  2493. end;
  2494. end;
  2495. finally
  2496. Screen.Cursor := OldCursor;
  2497. if not Assigned(FileList) then
  2498. begin
  2499. Items.EndUpdate;
  2500. EndSelectionUpdate;
  2501. end;
  2502. end;
  2503. end;
  2504. function TCustomDirView.CreateChangedFileList(DirView: TCustomDirView;
  2505. FullPath: Boolean; ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  2506. begin
  2507. Result := TStringList.Create;
  2508. try
  2509. ProcessChangedFiles(DirView, Result, FullPath, ExistingOnly, Criterias);
  2510. except
  2511. FreeAndNil(Result);
  2512. raise;
  2513. end;
  2514. end;
  2515. procedure TCustomDirView.CompareFiles(DirView: TCustomDirView;
  2516. ExistingOnly: Boolean; Criterias: TCompareCriterias);
  2517. begin
  2518. ProcessChangedFiles(DirView, nil, True, ExistingOnly, Criterias);
  2519. end;
  2520. procedure TCustomDirView.FocusSomething;
  2521. begin
  2522. if FSavedSelection then FPendingFocusSomething := True
  2523. else inherited;
  2524. end;
  2525. procedure TCustomDirView.SaveSelection;
  2526. var
  2527. Closest: TListItem;
  2528. begin
  2529. Assert(not FSavedSelection);
  2530. FSavedSelectionFile := '';
  2531. FSavedSelectionLastFile := '';
  2532. if Assigned(ItemFocused) then
  2533. begin
  2534. FSavedSelectionLastFile := ItemFocused.Caption;
  2535. end;
  2536. Closest := ClosestUnselected(ItemFocused);
  2537. if Assigned(Closest) then
  2538. begin
  2539. FSavedSelectionFile := Closest.Caption;
  2540. end;
  2541. FSavedSelection := True;
  2542. end;
  2543. procedure TCustomDirView.RestoreSelection;
  2544. var
  2545. ItemToSelect: TListItem;
  2546. begin
  2547. Assert(FSavedSelection);
  2548. FSavedSelection := False;
  2549. if (FSavedSelectionLastFile <> '') and
  2550. ((not Assigned(ItemFocused)) or
  2551. (ItemFocused.Caption <> FSavedSelectionLastFile)) then
  2552. begin
  2553. ItemToSelect := FindFileItem(FSavedSelectionFile);
  2554. if Assigned(ItemToSelect) then
  2555. begin
  2556. ItemFocused := ItemToSelect;
  2557. end;
  2558. end;
  2559. if not Assigned(ItemFocused) then FocusSomething
  2560. else ItemFocused.MakeVisible(False);
  2561. end;
  2562. procedure TCustomDirView.DiscardSavedSelection;
  2563. begin
  2564. Assert(FSavedSelection);
  2565. FSavedSelection := False;
  2566. if FPendingFocusSomething then
  2567. begin
  2568. FPendingFocusSomething := False;
  2569. FocusSomething;
  2570. end;
  2571. end;
  2572. var
  2573. DocPIDL: PItemIDList;
  2574. initialization
  2575. HasExtendedCOMCTL32 := COMCTL32OK;
  2576. DropSourceControl := nil;
  2577. SetLength(WinDir, MAX_PATH);
  2578. SetLength(WinDir, GetWindowsDirectory(PChar(WinDir), MAX_PATH));
  2579. SetLength(TempDir, MAX_PATH);
  2580. SetLength(TempDir, GetTempPath(MAX_PATH, PChar(TempDir)));
  2581. SetLength(UserDocumentDirectory, MAX_PATH);
  2582. SHGetSpecialFolderLocation(Application.Handle, CSIDL_PERSONAL, DocPIDL);
  2583. SHGetPathFromIDList(DocPIDL, PChar(UserDocumentDirectory));
  2584. SetLength(UserDocumentDirectory, StrLen(PChar(UserDocumentDirectory)));
  2585. UnknownFileIcon := GetshFileInfo('$#)(.#$)', FILE_ATTRIBUTE_NORMAL,
  2586. SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
  2587. DefaultExeIcon := GetshFileInfo('.COM',
  2588. FILE_ATTRIBUTE_NORMAL, SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
  2589. with GetshFileInfo(WinDir, FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY,
  2590. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES) do
  2591. begin
  2592. StdDirTypeName := szTypeName;
  2593. StdDirIcon := iIcon;
  2594. end;
  2595. StdDirSelIcon := GetIconIndex(WinDir,
  2596. FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY, SHGFI_OPENICON);
  2597. WinDir := IncludeTrailingPathDelimiter(WinDir);
  2598. TempDir := IncludeTrailingPathDelimiter(TempDir);
  2599. finalization
  2600. SetLength(StdDirTypeName, 0);
  2601. SetLength(WinDir, 0);
  2602. SetLength(TempDir, 0);
  2603. end.