CustomDirView.pas 102 KB

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