CustomDirView.pas 103 KB

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