CustomDirView.pas 102 KB

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