CustomDirView.pas 101 KB

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