CustomDirView.pas 99 KB

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