CustomDirView.pas 106 KB

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