CustomDirView.pas 107 KB

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