CustomDirView.pas 105 KB

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