CustomDirView.pas 106 KB

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