1
0

CustomDirView.pas 101 KB

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