1
0

CustomDirView.pas 100 KB

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