CustomDirView.pas 109 KB

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