CustomDirView.pas 101 KB

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