1
0

CustomDirView.pas 117 KB

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