CustomDirView.pas 100 KB

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