CustomDirView.pas 103 KB

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