CustomDirView.pas 108 KB

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