CustomDirView.pas 99 KB

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