CustomDirView.pas 116 KB

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