CustomDirView.pas 105 KB

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