CustomDirView.pas 99 KB

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