CustomDirView.pas 100 KB

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