CustomDirView.pas 101 KB

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