CustomDirView.pas 105 KB

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