CustomDirView.pas 105 KB

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