CustomDirView.pas 102 KB

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