CustomDirView.pas 86 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810
  1. unit CustomDirView;
  2. interface
  3. {$R DirImg.res}
  4. {$WARN UNIT_PLATFORM OFF}
  5. uses
  6. Windows, Messages, Classes, Graphics, Controls,
  7. Forms, ComCtrls, ShellAPI, ComObj, ShlObj, Dialogs,
  8. ActiveX, CommCtrl, Extctrls, ImgList, Menus,
  9. PIDL, BaseUtils, DragDrop, DragDropFilesEx, IEDriveInfo,
  10. IEListView, PathLabel, AssociatedStatusBar, CustomPathComboBox, SysUtils;
  11. const
  12. clDefaultItemColor = -(COLOR_ENDCOLORS + 1);
  13. WM_USER_RENAME = WM_USER + 57;
  14. oiNoOverlay = $00;
  15. oiDirUp = $01;
  16. oiLink = $02;
  17. oiBrokenLink = $04;
  18. oiShared = $08;
  19. DefaultHistoryMenuWidth = 300;
  20. DefaultHistoryMenuLen = 9;
  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. type
  29. {Drag&Drop events:}
  30. TDDError = (DDCreateShortCutError, DDPathNotFoundError);
  31. TDDOnDragEnter = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint; var Accept: Boolean) of object;
  32. TDDOnDragLeave = procedure(Sender: TObject) of object;
  33. TDDOnDragOver = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  34. TDDOnDrop = procedure(Sender: TObject; DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  35. TDDOnQueryContinueDrag = procedure(Sender: TObject; FEscapePressed: BOOL; grfKeyState: Longint; var Result: HResult) of object;
  36. TDDOnGiveFeedback = procedure(Sender: TObject; dwEffect: Longint; var Result: HResult) of object;
  37. TDDOnDragDetect = procedure(Sender: TObject; grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus) of object;
  38. TOnProcessDropped = procedure(Sender: TObject; grfKeyState: Longint; Point: TPoint; var dwEffect: Longint) of object;
  39. TDDErrorEvent = procedure(Sender: TObject; ErrorNo: TDDError) of object;
  40. TDDExecutedEvent = procedure(Sender: TObject; dwEffect: Longint) of object;
  41. TDDFileOperationEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string;
  42. var DoOperation: Boolean) of object;
  43. TDDFileOperationExecutedEvent = procedure(Sender: TObject; dwEffect: LongInt; SourcePath, TargetPath: string) of object;
  44. TDirViewExecFileEvent = procedure(Sender: TObject; Item: TListItem; var AllowExec: Boolean) of object;
  45. TRenameEvent = procedure(Sender: TObject; Item: TListItem; NewName: string) of object;
  46. type
  47. TCustomDirView = class;
  48. TSelAttr = (selDontCare, selYes, selNo);
  49. TFileFilter = record
  50. Masks: string;
  51. IncludeAttr: Word; { see TSearchRec.Attr }
  52. ExcludeAttr: Word;
  53. Directories: Boolean;
  54. FileSizeFrom: Int64;
  55. FileSizeTo: Int64;
  56. ModificationFrom: TDateTime;
  57. ModificationTo: TDateTime;
  58. end;
  59. THistoryDirection = (hdBack, hdForward);
  60. THistoryChangeEvent = procedure(Sender: TCustomDirView) of object;
  61. TDVGetFilterEvent = procedure(Sender: TCustomDirView; Select: Boolean;
  62. var Filter: TFileFilter) of object;
  63. TCompareCriteria = (ccTime, ccSize);
  64. TCompareCriterias = set of TCompareCriteria;
  65. TCustomDirView = class(TIEListView)
  66. private
  67. FAddParentDir: Boolean;
  68. FDimmHiddenFiles: Boolean;
  69. FShowDirectories: Boolean;
  70. FDirsOnTop: Boolean;
  71. FShowSubDirSize: Boolean;
  72. FSortByExtension: Boolean;
  73. FWantUseDragImages: Boolean;
  74. FCanUseDragImages: Boolean;
  75. FDragDropFilesEx: TDragDropFilesEx;
  76. FInvalidNameChars: string;
  77. FSingleClickToExec: Boolean;
  78. FUseSystemContextMenu: Boolean;
  79. FOnGetSelectFilter: TDVGetFilterEvent;
  80. FOnStartLoading: TNotifyEvent;
  81. FOnLoaded: TNotifyEvent;
  82. FOnDirUpdated: TNotifyEvent;
  83. FReloadTime: TSystemTime;
  84. FDragDrive: TDrive;
  85. FExeDrag: Boolean;
  86. FDDLinkOnExeDrag: Boolean;
  87. FOnDDDragEnter: TDDOnDragEnter;
  88. FOnDDDragLeave: TDDOnDragLeave;
  89. FOnDDDragOver: TDDOnDragOver;
  90. FOnDDDrop: TDDOnDrop;
  91. FOnDDQueryContinueDrag: TDDOnQueryContinueDrag;
  92. FOnDDGiveFeedback: TDDOnGiveFeedback;
  93. FOnDDDragDetect: TDDOnDragDetect;
  94. FOnDDProcessDropped: TOnProcessDropped;
  95. FOnDDError: TDDErrorEvent;
  96. FOnDDExecuted: TDDExecutedEvent;
  97. FOnDDFileOperation: TDDFileOperationEvent;
  98. FOnDDFileOperationExecuted: TDDFileOperationExecutedEvent;
  99. FOnExecFile: TDirViewExecFileEvent;
  100. FForceRename: Boolean;
  101. FLastDDResult: TDragResult;
  102. FLastRenameName: string;
  103. FLastVScrollTime: TFileTime;
  104. FVScrollCount: Integer;
  105. FContextMenu: Boolean;
  106. FDragEnabled: Boolean;
  107. FDragPos: TPoint;
  108. FStartPos: TPoint;
  109. FDDOwnerIsSource: Boolean;
  110. FAbortLoading: Boolean;
  111. FAnimation: TAnimate;
  112. FBackCount: Integer;
  113. FBackMenu: TPopupMenu;
  114. FDontRecordPath: Boolean;
  115. FDragOnDriveIsMove: Boolean;
  116. FNotifyEnabled: Boolean;
  117. FDragStartTime: TFileTime;
  118. FForwardMenu: TPopupMenu;
  119. FHistoryPaths: TStrings;
  120. FImageList16: TImageList;
  121. FImageList32: TImageList;
  122. FLoadAnimation: Boolean;
  123. FMaxHistoryCount: Integer;
  124. FMaxHistoryMenuLen: Integer;
  125. FMaxHistoryMenuWidth: Integer;
  126. FNeverPainted: Boolean;
  127. FPathComboBox: TCustomPathComboBox;
  128. FPathLabel: TCustomPathLabel;
  129. FStatusBar: TAssociatedStatusBar;
  130. FOnBeginRename: TRenameEvent;
  131. FOnEndRename: TRenameEvent;
  132. FOnHistoryChange: THistoryChangeEvent;
  133. FShowHiddenFiles: Boolean;
  134. FSavedSelection: Boolean;
  135. FSavedSelectionFile: string;
  136. FSavedSelectionLastFile: string;
  137. FPendingFocusSomething: Boolean;
  138. procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  139. procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  140. procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  141. procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  142. procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  143. procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  144. procedure DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem;
  145. State: TCustomDrawState; var DefaultDraw: Boolean);
  146. procedure DumbCustomDrawSubItem(Sender: TCustomListView;
  147. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  148. var DefaultDraw: Boolean);
  149. function GetBackMenu: TPopupMenu;
  150. function GetFilesMarkedSize: Int64;
  151. function GetForwardCount: Integer;
  152. function GetForwardMenu: TPopupMenu;
  153. function GetHistoryPath(Index: Integer): string;
  154. function GetTargetPopupMenu: Boolean;
  155. function GetUseDragImages: Boolean;
  156. procedure SetMaxHistoryCount(Value: Integer);
  157. procedure SetMaxHistoryMenuLen(Value: Integer);
  158. procedure SetMaxHistoryMenuWidth(Value: Integer);
  159. procedure SetPathComboBox(Value: TCustomPathComboBox);
  160. procedure SetPathLabel(Value: TCustomPathLabel);
  161. procedure SetStatusBar(Value: TAssociatedStatusBar);
  162. procedure SetTargetPopupMenu(Value: Boolean);
  163. procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  164. procedure WMUserRename(var Message: TMessage); message WM_User_Rename;
  165. protected
  166. FCaseSensitive: Boolean;
  167. FDirty: Boolean;
  168. FFilesSize: Int64;
  169. FFilesSelSize: Int64;
  170. FHasParentDir: Boolean;
  171. FIsRecycleBin: Boolean;
  172. FLastPath: string;
  173. FLoadEnabled: Boolean;
  174. FLoading: Boolean;
  175. FSelectFile: string;
  176. FWatchForChanges: Boolean;
  177. procedure AddToDragFileList(FileList: TFileList; Item: TListItem); virtual;
  178. function CanEdit(Item: TListItem): Boolean; override;
  179. function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; override;
  180. procedure ClearItems; override;
  181. function GetDirOK: Boolean; virtual; abstract;
  182. procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus); virtual;
  183. procedure DDDragEnter(DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  184. procedure DDDragLeave;
  185. procedure DDDragOver(grfKeyState: Longint; Point: TPoint; var dwEffect: Longint);
  186. procedure DDDrop(DataObj: IDataObject; grfKeyState: LongInt; Point: TPoint; var dwEffect: Longint);
  187. procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint; Point: TPoint; dwEffect: Longint); virtual;
  188. procedure DDGiveFeedback(dwEffect: Longint; var Result: HResult); virtual;
  189. procedure DDMenuDone(Sender: TObject; AMenu: HMenu); virtual;
  190. procedure DDProcessDropped(Sender: TObject; grfKeyState: Longint;
  191. Point: TPoint; dwEffect: Longint);
  192. procedure DDQueryContinueDrag(FEscapePressed: LongBool;
  193. grfKeyState: Longint; var Result: HResult); virtual;
  194. procedure DDSpecifyDropTarget(Sender: TObject; DragDropHandler: Boolean;
  195. Point: TPoint; var pidlFQ : PItemIDList; var Filename: string); virtual;
  196. procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItemA); virtual;
  197. function GetDragSourceEffects: TDropEffectSet; virtual;
  198. function GetPathName: string; virtual; abstract;
  199. function GetFilesCount: Integer; virtual;
  200. procedure ColClick(Column: TListColumn); override;
  201. procedure CreateWnd; override;
  202. function CustomCreateFileList(Focused, OnlyFocused: Boolean;
  203. FullPath: Boolean; FileList: TStrings = nil): TStrings;
  204. function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  205. Stage: TCustomDrawStage): Boolean; override;
  206. function CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  207. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; override;
  208. procedure CustomSortItems(SortProc: Pointer);
  209. procedure Delete(Item: TListItem); override;
  210. procedure DisplayContextMenu(Where: TPoint); virtual; abstract;
  211. procedure DoAnimation(Start: Boolean);
  212. procedure DoHistoryChange; dynamic;
  213. function DragCompleteFileList: Boolean; virtual;
  214. procedure Edit(const HItem: TLVItem); override;
  215. procedure EndSelectionUpdate; override;
  216. procedure Execute(Item: TListItem); virtual;
  217. procedure ExecuteFile(Item: TListItem); virtual; abstract;
  218. procedure FocusSomething; override;
  219. function GetIsRoot: Boolean; virtual; abstract;
  220. procedure IconsSetImageList; virtual;
  221. function ItemCanDrag(Item: TListItem): Boolean; virtual;
  222. function ItemColor(Item: TListItem): TColor; virtual;
  223. function ItemDragFileName(Item: TListItem): string; virtual;
  224. function ItemFileSize(Item: TListItem): Int64; virtual; abstract;
  225. function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; virtual; abstract;
  226. function ItemFileTime(Item: TListItem): TDateTime; virtual; abstract;
  227. // ItemIsDirectory and ItemFullFileName is in public block
  228. function ItemIsRecycleBin(Item: TListItem): Boolean; virtual;
  229. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  230. procedure KeyPress(var Key: Char); override;
  231. procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  232. procedure LoadFiles; virtual; abstract;
  233. procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer); virtual; abstract;
  234. procedure ProcessChangedFiles(DirView: TCustomDirView;
  235. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  236. Criterias: TCompareCriterias);
  237. procedure ReloadForce(CacheIcons : Boolean);
  238. procedure RetryRename(NewName: string);
  239. procedure SelectFiles(Filter: TFileFilter; Select: Boolean);
  240. procedure SetAddParentDir(Value: Boolean); virtual;
  241. procedure SetDimmHiddenFiles(Value: Boolean); virtual;
  242. procedure SetShowDirectories(Value: Boolean); virtual;
  243. procedure SetDirsOnTop(Value: Boolean);
  244. procedure SetItemImageIndex(Item: TListItem; Index: Integer); virtual; abstract;
  245. procedure SetLoadEnabled(Enabled : Boolean); virtual;
  246. procedure SetMultiSelect(Value: Boolean); override; //CLEAN virtual
  247. function GetPath: string; virtual; abstract;
  248. function GetValid: Boolean; override;
  249. procedure HistoryItemClick(Sender: TObject);
  250. procedure InternalEdit(const HItem: TLVItem); virtual; abstract;
  251. function ItemIsFile(Item: TListItem): Boolean; virtual; abstract;
  252. function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; virtual; abstract;
  253. function ItemOverlayIndexes(Item: TListItem): Word; virtual;
  254. procedure LimitHistorySize;
  255. function MinimizePath(Path: string; Len: Integer): string; virtual; abstract;
  256. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  257. procedure PathChanged;
  258. procedure SetPath(Value: string); virtual; abstract;
  259. procedure SetSortByExtension(Value: Boolean);
  260. procedure SetShowHiddenFiles(Value: Boolean); virtual;
  261. procedure SetShowSubDirSize(Value: Boolean); virtual;
  262. procedure SetViewStyle(Value: TViewStyle); override;
  263. procedure SetWatchForChanges(Value: Boolean); virtual;
  264. function TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean; virtual;
  265. procedure UpdateHistoryMenu(Direction: THistoryDirection);
  266. procedure UpdatePathComboBox; dynamic;
  267. procedure UpdatePathLabel; dynamic;
  268. procedure UpdateStatusBar; dynamic;
  269. procedure WndProc(var Message: TMessage); override;
  270. property ImageList16: TImageList read FImageList16;
  271. property ImageList32: TImageList read FImageList32;
  272. public
  273. function AnyFileSelected(OnlyFocused: Boolean): Boolean;
  274. constructor Create(AOwner: TComponent); override;
  275. procedure CreateDirectory(DirName: string); virtual; abstract;
  276. destructor Destroy; override;
  277. procedure Load; virtual;
  278. procedure Reload(CacheIcons: Boolean); virtual;
  279. function CreateFocusedFileList(FullPath: Boolean; FileList: TStrings = nil): TStrings;
  280. function CreateFileList(Focused: Boolean; FullPath: Boolean; FileList: TStrings = nil): TStrings;
  281. function DoSelectByMask(Select: Boolean): Boolean; override;
  282. procedure ExecuteHomeDirectory; virtual; abstract;
  283. procedure ExecuteParentDirectory; virtual; abstract;
  284. procedure ExecuteRootDirectory; virtual; abstract;
  285. procedure ExecuteCurrentFile();
  286. function FindFileItem(FileName: string): TListItem;
  287. procedure HistoryGo(Index: Integer);
  288. function ItemIsDirectory(Item: TListItem): Boolean; virtual; abstract;
  289. function ItemIsParentDirectory(Item: TListItem): Boolean; virtual; abstract;
  290. function ItemFullFileName(Item: TListItem): string; virtual; abstract;
  291. function ItemFileName(Item: TListItem): string; virtual; abstract;
  292. procedure ReloadDirectory; virtual; abstract;
  293. procedure DisplayPropertiesMenu; virtual; abstract;
  294. function CreateChangedFileList(DirView: TCustomDirView; FullPath: Boolean;
  295. ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  296. procedure CompareFiles(DirView: TCustomDirView; ExistingOnly: Boolean;
  297. Criterias: TCompareCriterias); virtual;
  298. procedure SaveSelection;
  299. procedure RestoreSelection;
  300. procedure DiscardSavedSelection;
  301. property AddParentDir: Boolean read FAddParentDir write SetAddParentDir default False;
  302. property DimmHiddenFiles: Boolean read FDimmHiddenFiles write SetDimmHiddenFiles default True;
  303. property ShowDirectories: Boolean read FShowDirectories write SetShowDirectories default True;
  304. property DirsOnTop: Boolean read FDirsOnTop write SetDirsOnTop default True;
  305. property DragDropFilesEx: TDragDropFilesEx read FDragDropFilesEx;
  306. property ShowSubDirSize: Boolean read FShowSubDirSize write SetShowSubDirSize default False;
  307. property SortByExtension: Boolean read FSortByExtension write SetSortByExtension default False;
  308. property WantUseDragImages: Boolean read FWantUseDragImages write FWantUseDragImages default True;
  309. property UseDragImages: Boolean read GetUseDragImages stored False;
  310. property FullDrag default True;
  311. property TargetPopupMenu: Boolean read GetTargetPopupMenu write SetTargetPopupMenu default True;
  312. property DDOwnerIsSource: Boolean read FDDOwnerIsSource;
  313. property FilesSize: Int64 read FFilesSize;
  314. property FilesSelSize: Int64 read FFilesSelSize;
  315. property FilesCount: Integer read GetFilesCount;
  316. property FilesMarkedSize: Int64 read GetFilesMarkedSize;
  317. property HasParentDir: Boolean read FHasParentDir;
  318. //CLEANproperty MultiSelect write SetMultiSelect;
  319. property Path: string read GetPath write SetPath;
  320. property PathName: string read GetPathName;
  321. property ReloadTime: TSystemTime read FReloadTime;
  322. property SingleClickToExec: Boolean read FSingleClickToExec write FSingleClickToExec default False;
  323. property UseSystemContextMenu: Boolean read FUseSystemContextMenu
  324. write FUseSystemContextMenu default True;
  325. property Loading: Boolean read FLoading;
  326. property AbortLoading: Boolean read FAbortLoading write FAbortLoading stored False;
  327. property BackCount: Integer read FBackCount;
  328. property BackMenu: TPopupMenu read GetBackMenu;
  329. {Enable or disable populating the item list:}
  330. property LoadAnimation: Boolean read FLoadAnimation write FLoadAnimation default True;
  331. property LoadEnabled: Boolean read FLoadEnabled write SetLoadEnabled default True;
  332. {Displayed data is not valid => reload required}
  333. property Dirty: Boolean read FDirty;
  334. property DirOK: Boolean read GetDirOK;
  335. property LastPath: string read FLastPath;
  336. property IsRecycleBin: Boolean read FIsRecycleBin;
  337. property DDLinkOnExeDrag: Boolean read FDDLinkOnExeDrag
  338. write FDDLinkOnExeDrag default False;
  339. property DragDrive: TDrive read FDragDrive;
  340. property DragOnDriveIsMove: Boolean read FDragOnDriveIsMove write FDragOnDriveIsMove;
  341. property DragSourceEffects: TDropEffectSet read GetDragSourceEffects{ write FDragSourceEffects};
  342. property ExeDrag: Boolean read FExeDrag;
  343. property ForwardCount: Integer read GetForwardCount;
  344. property ForwardMenu: TPopupMenu read GetForwardMenu;
  345. property HistoryPath[Index: Integer]: string read GetHistoryPath;
  346. property IsRoot: Boolean read GetIsRoot;
  347. property LastDDResult: TDragResult read FLastDDResult;
  348. property SmallImages;
  349. property LargeImages;
  350. property MaxHistoryCount: Integer read FMaxHistoryCount write SetMaxHistoryCount default DefaultHistoryCount;
  351. property MaxHistoryMenuLen: Integer read FMaxHistoryMenuLen write SetMaxHistoryMenuLen default DefaultHistoryMenuLen;
  352. property MaxHistoryMenuWidth: Integer read FMaxHistoryMenuWidth write SetMaxHistoryMenuWidth default DefaultHistoryMenuWidth;
  353. property OnContextPopup;
  354. property OnBeginRename: TRenameEvent read FOnBeginRename write FOnBeginRename;
  355. property OnEndRename: TRenameEvent read FOnEndRename write FOnEndRename;
  356. property OnGetSelectFilter: TDVGetFilterEvent read FOnGetSelectFilter write FOnGetSelectFilter;
  357. property OnStartLoading: TNotifyEvent read FOnStartLoading write FOnStartLoading;
  358. property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
  359. {This event is fired, when any update has made to the listview}
  360. property OnDirUpdated: TNotifyEvent read FOnDirUpdated write FOnDirUpdated;
  361. {The mouse has entered the component window as a target of a drag&drop operation:}
  362. property OnDDDragEnter: TDDOnDragEnter read FOnDDDragEnter write FOnDDDragEnter;
  363. {The mouse has leaved the component window as a target of a drag&drop operation:}
  364. property OnDDDragLeave: TDDOnDragLeave read FOnDDDragLeave write FOnDDDragLeave;
  365. {The mouse is dragging in the component window as a target of a drag&drop operation:}
  366. property OnDDDragOver: TDDOnDragOver read FOnDDDragOver write FOnDDDragOver;
  367. {The Drag&drop operation is about to be executed:}
  368. property OnDDDrop: TDDOnDrop read FOnDDDrop write FOnDDDrop;
  369. property OnDDQueryContinueDrag: TDDOnQueryContinueDrag
  370. read FOnDDQueryContinueDrag write FOnDDQueryContinueDrag;
  371. property OnDDGiveFeedback: TDDOnGiveFeedback
  372. read FOnDDGiveFeedback write FOnDDGiveFeedback;
  373. {A drag&drop operation is about to be initiated whith
  374. the components window as the source:}
  375. property OnDDDragDetect: TDDOnDragDetect
  376. read FOnDDDragDetect write FOnDDDragDetect;
  377. {The component window is the target of a drag&drop operation:}
  378. property OnDDProcessDropped: TOnProcessDropped
  379. read FOnDDProcessDropped write FOnDDProcessDropped;
  380. {An error has occured during a drag&drop operation:}
  381. property OnDDError: TDDErrorEvent read FOnDDError write FOnDDError;
  382. {The drag&drop operation has been executed:}
  383. property OnDDExecuted: TDDExecutedEvent
  384. read FOnDDExecuted write FOnDDExecuted;
  385. {Event is fired just before executing the fileoperation. This event is also fired when
  386. files are pasted from the clipboard:}
  387. property OnDDFileOperation: TDDFileOperationEvent
  388. read FOnDDFileOperation write FOnDDFileOperation;
  389. {Event is fired after executing the fileoperation. This event is also fired when
  390. files are pasted from the clipboard:}
  391. property OnDDFileOperationExecuted: TDDFileOperationExecutedEvent
  392. read FOnDDFileOperationExecuted write FOnDDFileOperationExecuted;
  393. {Set AllowExec to false, if actual file should not be executed:}
  394. property OnExecFile: TDirViewExecFileEvent
  395. read FOnExecFile write FOnExecFile;
  396. property OnHistoryChange: THistoryChangeEvent read FOnHistoryChange write FOnHistoryChange;
  397. property PathComboBox: TCustomPathComboBox read FPathComboBox write SetPathComboBox;
  398. property PathLabel: TCustomPathLabel read FPathLabel write SetPathLabel;
  399. property ShowHiddenFiles: Boolean read FShowHiddenFiles write SetShowHiddenFiles default True;
  400. property StatusBar: TAssociatedStatusBar read FStatusBar write SetStatusBar;
  401. {Watch current directory for filename changes (create, rename, delete files)}
  402. property WatchForChanges: Boolean read FWatchForChanges write SetWatchForChanges default False;
  403. end;
  404. resourcestring
  405. SErrorOpenFile = 'Can''t open file: ';
  406. SErrorRenameFile = 'Can''t rename file or directory: ';
  407. SErrorRenameFileExists = 'File already exists: ';
  408. SErrorInvalidName= 'Filename contains invalid characters:';
  409. STextFileExt = 'File %s';
  410. STextFiles = '%u Files';
  411. STextDirectories = '%u Directories';
  412. SParentDir = 'Parent directory';
  413. SIconUpdateThreadTerminationError = 'Can''t terminate icon update thread.';
  414. SDragDropError = 'DragDrop Error: %d';
  415. SDirNotExists = 'Directory ''%s'' doesn''t exist.';
  416. {Additional non-component specific functions:}
  417. {Create and resolve a shell link (file shortcut):}
  418. function CreateFileShortCut(SourceFile, Target, DisplayName: string;
  419. UpdateIfExists: Boolean = False): Boolean;
  420. function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
  421. {Gets the shell's display icon for registered file extensions:}
  422. function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
  423. {Gets the shell's inforecord for registered fileextensions:}
  424. function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
  425. {Returns the displayname as used by the shell:}
  426. function GetShellDisplayName(const ShellFolder: IShellFolder; IDList: PItemIDList;
  427. Flags: DWORD; var Name: string): Boolean;
  428. function IsExecutable(FileName: string): Boolean;
  429. function GetNextMask(var Mask: string): string;
  430. function FileNameMatchesMasks(FileName: string; Masks: string): Boolean;
  431. procedure DefaultFileFilter(var Filter: TFileFilter);
  432. var
  433. StdDirIcon: Integer;
  434. StdDirSelIcon: Integer;
  435. DropSourceControl: TObject;
  436. UnknownFileIcon: Integer;
  437. HasExtendedCOMCTL32: Boolean;
  438. StdDirTypeName: string;
  439. DefaultExeIcon: Integer;
  440. UserDocumentDirectory: string;
  441. implementation
  442. uses
  443. {DriveView, }Math, Masks;
  444. const
  445. Space = ' ';
  446. ResDirUp = 'DIRUP%2.2d';
  447. ResLink = 'LINK%2.2d';
  448. ResBrokenLink = 'BROKEN%2.2d';
  449. var
  450. WinDir: string;
  451. TempDir: string;
  452. COMCTL32Version: DWORD;
  453. function IsExecutable(FileName: string): Boolean;
  454. var
  455. FileExt: string;
  456. begin
  457. FileExt := UpperCase(ExtractFileExt(FileName));
  458. Result := (FileExt = '.EXE') or (FileExt = '.COM');
  459. end;
  460. function GetNextMask(var Mask: string): string;
  461. var
  462. NextPos: Integer;
  463. begin
  464. NextPos := Pos(';', Mask);
  465. if NextPos = 0 then
  466. begin
  467. Result := Mask;
  468. SetLength(Mask, 0);
  469. end
  470. else
  471. begin
  472. Result := Copy(Mask, 1, NextPos - 1);
  473. Delete(Mask, 1, NextPos);
  474. end;
  475. end;
  476. function FileNameMatchesMasks(FileName: string; Masks: string): Boolean;
  477. begin
  478. Result := False;
  479. // there needs to be atleast one dot,
  480. // otherwise '*.*' mask would not select this file
  481. if Pos('.', FileName) = 0 then FileName := FileName + '.';
  482. while (not Result) and (Length(Masks) > 0) do
  483. Result := MatchesMask(FileName, GetNextMask(Masks));
  484. end;
  485. procedure DefaultFileFilter(var Filter: TFileFilter);
  486. begin
  487. with Filter do
  488. begin
  489. SetLength(Masks, 0);
  490. IncludeAttr := 0;
  491. ExcludeAttr := 0;
  492. Directories := False;
  493. FileSizeFrom := 0;
  494. FileSizeTo := 0;
  495. ModificationFrom := 0;
  496. ModificationTo := 0;
  497. end;
  498. end;
  499. { Shortcut-handling }
  500. function ResolveFileShortCut(SourceFile: string; ShowDialog: Boolean = False): string;
  501. var
  502. IUnk: IUnknown;
  503. HRes: HRESULT; // OLE-Operation Result
  504. SL: IShellLink; // Interface for ShellLink
  505. PF: IPersistFile; // Interface for PersistentFile
  506. SRec: TWIN32FINDDATA; // SearchRec of targetfile
  507. TargetDir: array[1..Max_Path] of Char; // Working directory of targetfile
  508. PSource: WideString; // Widestring(Source)
  509. Flags: DWORD;
  510. begin
  511. Result := '';
  512. IUnk := CreateComObject(CLSID_ShellLink);
  513. SL := IUnk as IShellLink;
  514. PF := IUnk as IPersistFile;
  515. PSource := SourceFile;
  516. HRes := PF.Load(PWideChar(PSource), STGM_READ);
  517. if Succeeded(Hres) then
  518. begin
  519. if not ShowDialog then Flags := SLR_NOUPDATE or (1500 shl 8) or SLR_NO_UI
  520. else Flags := SLR_NOUPDATE;
  521. HRes := SL.Resolve(Application.Handle, Flags);
  522. if Succeeded(HRes) then
  523. begin
  524. HRes := SL.GetPath(@TargetDir, MAX_PATH, SRec, {SLGP_UNCPRIORITY}{SLGP_SHORTPATH} 0);
  525. if Succeeded(HRes) then
  526. Result := string(PChar(@TargetDir));
  527. end;
  528. end;
  529. end; {ResolveShortCut}
  530. function CreateFileShortCut(SourceFile, Target, DisplayName: string;
  531. UpdateIfExists: Boolean): Boolean;
  532. var
  533. IUnk: IUnknown;
  534. Hres: HRESULT;
  535. ShellLink: IShellLink; // Interface to ShellLink
  536. IPFile: IPersistFile; // Interface to PersistentFile
  537. WideStr: WideString;
  538. TargetFile: string;
  539. begin
  540. Result := False;
  541. if Target = '' then TargetFile := SourceFile + '.lnk'
  542. else TargetFile := Target;
  543. WideStr := TargetFile;
  544. IUnk := CreateComObject(CLSID_ShellLink);
  545. ShellLink := IUnk as IShellLink;
  546. IPFile := IUnk as IPersistFile;
  547. if FileExists(TargetFile) and UpdateIfExists then
  548. begin
  549. HRes := IPFile.Load(PWChar(WideStr), 0);
  550. if not Succeeded(HRes) then Exit;
  551. end;
  552. with ShellLink do
  553. begin
  554. HRes := SetPath(PChar(SourceFile));
  555. if Succeeded(HRes) then
  556. HRes := SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
  557. if Succeeded(HRes) and (DisplayName <> '') then
  558. HRes := SetDescription(PChar(DisplayName));
  559. end;
  560. if Succeeded(Hres) then
  561. begin
  562. HRes := IPFile.Save(PWChar(WideStr),False);
  563. if Succeeded(HRes) then Result := True;
  564. end;
  565. end; {CreateShortCut}
  566. function GetIconIndex(const AFile: string; Attrs: DWORD; Flags: UINT): Integer;
  567. var
  568. FileInfo: TSHFileInfo;
  569. begin
  570. try
  571. SHGetFileInfo(PChar(AFile), Attrs, FileInfo, SizeOf(TSHFileInfo),
  572. Flags or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  573. Result := FileInfo.iIcon;
  574. except
  575. Result := -1;
  576. end;
  577. end; {GetIconIndex}
  578. function GetshFileInfo(const AFile: string; Attrs: DWORD; Flags: UINT): TSHFileInfo;
  579. begin
  580. try
  581. SHGetFileInfo(PChar(AFile), Attrs, Result, SizeOf(TSHFileInfo), Flags);
  582. except
  583. FillChar(Result, SizeOf(Result), 0);
  584. end;
  585. end; {GetshFileInfo}
  586. function GetShellDisplayName(const ShellFolder: IShellFolder; IDList: PItemIDList;
  587. Flags: DWORD; var Name: string): Boolean;
  588. var
  589. Str: TStrRet;
  590. begin
  591. Result := True;
  592. Name := '';
  593. if ShellFolder.GetDisplayNameOf(IDList, Flags, Str) = NOERROR then
  594. begin
  595. case Str.uType of
  596. STRRET_WSTR: Name := WideCharToString(Str.pOleStr);
  597. STRRET_OFFSET: Name := PChar(UINT(IDList) + Str.uOffset);
  598. STRRET_CSTR: Name := Str.cStr;
  599. else Result := False;
  600. end;
  601. end
  602. else Result := False;
  603. end; {GetShellDisplayName}
  604. function COMCTL32OK: Boolean;
  605. {Returs, wether COMCTL32 supports the extended display properties:
  606. COMCTL32.DLL version 4.70 or higher ist required. Version 4.70 is
  607. included in Internet Explorer 4 with Active Desktop.
  608. Updates of COMCTL32.DLL are available at:
  609. http://msdn.microsoft.com/developer/downloads/files/40Comupd.htm }
  610. var
  611. VerInfoSize: DWORD;
  612. Dummy: DWORD;
  613. VerInfo: Pointer;
  614. FileInfo: PVSFixedFileInfo;
  615. FileInfoSize: UINT;
  616. begin
  617. Result := False;
  618. VerInfoSize := GetFileVersionInfoSize('COMCTL32.DLL', Dummy);
  619. if VerInfoSize > 0 then
  620. begin
  621. GetMem(VerInfo, VerInfoSize);
  622. try
  623. if GetFileVersionInfo(PChar('COMCTL32.DLL'), 0, VerInfoSize, VerInfo) then
  624. begin
  625. if VerQueryValue(VerInfo, '\', Pointer(FileInfo), FileInfoSize) then
  626. begin
  627. ComCTL32Version := FileInfo.dwFileVersionMS;
  628. Result := (ComCTL32Version >= $40046); { COMCTL32 Version >= 4.70 required }
  629. end
  630. else ComCTL32Version := 0;
  631. end;
  632. finally
  633. FreeMem(VerInfo, VerInfoSize);
  634. end;
  635. end;
  636. end; {COMCTL32OK}
  637. { TLoadAnimationStartThread }
  638. {constructor TLoadAnimationStartThread.Create(AInterval: Integer; AAnimation: TAnimate);
  639. begin
  640. inherited Create(True);
  641. FInterval := AInterval;
  642. FAnimation := AAnimation;
  643. Resume;
  644. end;
  645. procedure TLoadAnimationStartThread.Execute;
  646. var
  647. XInterval: Integer;
  648. begin
  649. XInterval := FInterval;
  650. while (not Terminated) and (XInterval > 0) do
  651. begin
  652. Sleep(10);
  653. Dec(XInterval, 10);
  654. end;
  655. if (not Terminated) and Assigned(FAnimation) then
  656. Synchronize(StartAnimation);
  657. end;
  658. procedure TLoadAnimationStartThread.StartAnimation;
  659. begin
  660. FAnimation.Visible := True;
  661. FAnimation.Active := True;
  662. end; }
  663. { TCustomDirView }
  664. constructor TCustomDirView.Create(AOwner: TComponent);
  665. var
  666. WinVer: TOSVersionInfo;
  667. begin
  668. inherited;
  669. WinVer.dwOSVersionInfoSize := SizeOf(WinVer);
  670. GetVersionEx(WinVer);
  671. FWatchForChanges := False;
  672. FNeverPainted := True;
  673. FFilesSize := 0;
  674. FFilesSelSize := 0;
  675. FDimmHiddenFiles := True;
  676. FShowHiddenFiles := True;
  677. FShowDirectories := True;
  678. FDirsOnTop := True;
  679. FShowSubDirSize := False;
  680. FWantUseDragImages := True;
  681. FCanUseDragImages := (Win32PlatForm = VER_PLATFORM_WIN32_NT) or (WinVer.dwMinorVersion > 0);
  682. FAddParentDir := False;
  683. FullDrag := True;
  684. FSingleClickToExec := False;
  685. FInvalidNameChars := '\/:*?"<>|';
  686. FHasParentDir := False;
  687. FDragOnDriveIsMove := False;
  688. FCaseSensitive := False;
  689. FLoadAnimation := True;
  690. FAnimation := nil;
  691. FIsRecycleBin := False;
  692. FLoading := False;
  693. FLoadEnabled := True;
  694. FAbortLoading := False;
  695. FDirty := False;
  696. FLastPath := '';
  697. FNotifyEnabled := True;
  698. FForceRename := False;
  699. FLastRenameName := '';
  700. FSavedSelection := False;
  701. FPendingFocusSomething := False;
  702. FContextMenu := False;
  703. FUseSystemContextMenu := True;
  704. FStartPos.X := -1;
  705. FStartPos.Y := -1;
  706. FDragPos := FStartPos;
  707. FDragEnabled := False;
  708. FDDOwnerIsSource := False;
  709. FDDLinkOnExeDrag := False;
  710. FDragDrive := #0;
  711. FExeDrag := False;
  712. FOnHistoryChange := nil;
  713. FHistoryPaths := TStringList.Create;
  714. FBackCount := 0;
  715. FDontRecordPath := False;
  716. FBackMenu := nil;
  717. FForwardMenu := nil;
  718. FMaxHistoryMenuLen := DefaultHistoryMenuLen;
  719. FMaxHistoryMenuWidth := DefaultHistoryMenuWidth;
  720. FMaxHistoryCount := DefaultHistoryCount;
  721. OnCustomDrawItem := DumbCustomDrawItem;
  722. OnCustomDrawSubItem := DumbCustomDrawSubItem;
  723. FDragDropFilesEx := TDragDropFilesEx.Create(Self);
  724. with FDragDropFilesEx do
  725. begin
  726. {$IFDEF OLD_DND}
  727. AutoDetectDnD := False;
  728. DragDetectDelta := 4;
  729. {$ELSE}
  730. DragDetect.Automatic := False;
  731. DragDetect.DeltaX := 4;
  732. DragDetect.DeltaY := 4;
  733. {$ENDIF}
  734. AcceptOwnDnD := True;
  735. BringToFront := True;
  736. CompleteFileList := True;
  737. NeedValid := [nvFileName];
  738. RenderDataOn := rdoEnterAndDropSync;
  739. TargetPopUpMenu := True;
  740. SourceEffects := DragSourceEffects;
  741. TargetEffects := [deCopy, deMove];
  742. OnDragEnter := DDDragEnter;
  743. OnDragLeave := DDDragLeave;
  744. OnDragOver := DDDragOver;
  745. OnDrop := DDDrop;
  746. OnQueryContinueDrag := DDQueryContinueDrag;
  747. OnSpecifyDropTarget := DDSpecifyDropTarget;
  748. OnMenuDestroy := DDMenuDone;
  749. OnDropHandlerSucceeded := DDDropHandlerSucceeded;
  750. OnGiveFeedback := DDGiveFeedback;
  751. OnProcessDropped := DDProcessDropped;
  752. OnDragDetect := DDDragDetect;
  753. ShellExtensions.DragDropHandler := True;
  754. ShellExtensions.DropHandler := True;
  755. end;
  756. end;
  757. procedure TCustomDirView.ClearItems;
  758. begin
  759. if Assigned(DropTarget) then DropTarget := nil;
  760. try
  761. inherited;
  762. finally
  763. FFilesSelSize := 0;
  764. FFilesSize := 0;
  765. UpdateStatusBar;
  766. end;
  767. end;
  768. procedure TCustomDirView.CNNotify(var Message: TWMNotify);
  769. procedure DrawOverlayImage(Image: Integer);
  770. var
  771. ImageList: TCustomImageList;
  772. Point: TPoint;
  773. Index: Integer;
  774. begin
  775. Point := Items[PNMCustomDraw(Message.NMHdr)^.dwItemSpec].
  776. DisplayRect(drIcon).TopLeft;
  777. if ViewStyle = vsIcon then
  778. begin
  779. ImageList := ImageList32;
  780. Inc(Point.X, 8);
  781. Inc(Point.Y, 2);
  782. end
  783. else ImageList := ImageList16;
  784. Index := 0;
  785. while Image > 1 do
  786. begin
  787. Inc(Index);
  788. Image := Image shr 1;
  789. end;
  790. if 8 + ImageList.Width <= Columns[0].Width then
  791. ImageList_Draw(ImageList.Handle, Index, Self.Canvas.Handle,
  792. Point.X, Point.Y, ILD_TRANSPARENT);
  793. end;
  794. var
  795. FileSize: Int64;
  796. Item: TListItem;
  797. InfoMask: LongWord;
  798. OverlayIndex: Word;
  799. OverlayIndexes: Word;
  800. UpdateStatusBarPending: Boolean;
  801. begin
  802. UpdateStatusBarPending := False;
  803. case Message.NMHdr^.code of
  804. LVN_ITEMCHANGED:
  805. with PNMListView(Message.NMHdr)^ do
  806. if (uChanged = LVIF_STATE) and Valid and (not FClearingItems) then
  807. begin
  808. if ((uOldState and (LVIS_SELECTED or LVIS_FOCUSED)) <>
  809. (uNewState and (LVIS_SELECTED or LVIS_FOCUSED))) then
  810. UpdateStatusBarPending := True;
  811. if ((uOldState and LVIS_SELECTED) <> (uNewState and LVIS_SELECTED)) then
  812. begin
  813. FileSize := ItemFileSize(Items[iItem]);
  814. if (uOldState and LVIS_SELECTED) <> 0 then Dec(FFilesSelSize, FileSize)
  815. else Inc(FFilesSelSize, FileSize);
  816. end;
  817. end;
  818. LVN_ENDLABELEDIT:
  819. LoadEnabled := True;
  820. LVN_BEGINDRAG:
  821. if FDragEnabled and (not Loading) then
  822. DDDragDetect(MK_LBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
  823. LVN_BEGINRDRAG:
  824. if FDragEnabled and (not Loading) then
  825. DDDragDetect(MK_RBUTTON, FStartPos, Mouse.CursorPos, ddsDrag);
  826. end;
  827. inherited;
  828. if (Message.NMHdr.code = LVN_GETDISPINFO) and
  829. FNotifyEnabled and Valid and (not Loading) then
  830. with PLVDispInfo(Pointer(Message.NMHdr))^.Item do
  831. try
  832. InfoMask := PLVDispInfo(Pointer(Message.NMHdr))^.item.Mask;
  833. if (InfoMask and LVIF_PARAM) <> 0 then Item := TListItem(lParam)
  834. else
  835. if iItem < Items.Count then Item := Items[iItem]
  836. else Item := nil;
  837. if Assigned(Item) and Assigned(Item.Data) then
  838. GetDisplayInfo(Item, PLVDispInfo(Pointer(Message.NMHdr))^.item);
  839. except
  840. end;
  841. if (Message.NMHdr.code = NM_CUSTOMDRAW) and
  842. HasExtendedCOMCTL32 and Valid and (not Loading) then
  843. with PNMCustomDraw(Message.NMHdr)^ do
  844. try
  845. Message.Result := Message.Result or CDRF_NOTIFYPOSTPAINT;
  846. if (dwDrawStage = CDDS_ITEMPOSTPAINT) and
  847. ((dwDrawStage and CDDS_SUBITEM) = 0) and
  848. Assigned(Columns[0]) and (Columns[0].Width > 0) then
  849. begin
  850. Assert(Assigned(Items[dwItemSpec]));
  851. OverlayIndexes := ItemOverlayIndexes(Items[dwItemSpec]);
  852. OverlayIndex := 1;
  853. while OverlayIndexes > 0 do
  854. begin
  855. if (OverlayIndex and OverlayIndexes) <> 0 then
  856. begin
  857. DrawOverlayImage(OverlayIndex);
  858. Dec(OverlayIndexes, OverlayIndex);
  859. end;
  860. OverlayIndex := OverlayIndex shl 1;
  861. end;
  862. end;
  863. except
  864. end;
  865. if UpdateStatusBarPending then UpdateStatusBar;
  866. end;
  867. procedure TCustomDirView.SetAddParentDir(Value: Boolean);
  868. begin
  869. if FAddParentDir <> Value then
  870. begin
  871. FAddParentDir := Value;
  872. if DirOK then Reload(True);
  873. end;
  874. end;
  875. procedure TCustomDirView.SetDimmHiddenFiles(Value: Boolean);
  876. begin
  877. if Value <> FDimmHiddenFiles then
  878. begin
  879. FDimmHiddenFiles := Value;
  880. Self.Repaint;
  881. end;
  882. end; {SetDimmHiddenFiles}
  883. procedure TCustomDirView.SetPathComboBox(Value: TCustomPathComboBox);
  884. begin
  885. if FPathComboBox <> Value then
  886. begin
  887. if Assigned(FPathComboBox) and (FPathComboBox.DirView = Self) then
  888. FPathComboBox.DirView := nil;
  889. FPathComboBox := Value;
  890. if Assigned(Value) then
  891. begin
  892. Value.FreeNotification(Self);
  893. if not Assigned(Value.DirView) then
  894. Value.DirView := Self;
  895. UpdatePathComboBox;
  896. end;
  897. end;
  898. end; { SetPathComboBox }
  899. procedure TCustomDirView.SetPathLabel(Value: TCustomPathLabel);
  900. begin
  901. if FPathLabel <> Value then
  902. begin
  903. if Assigned(FPathLabel) and (FPathLabel.FocusControl = Self) then
  904. FPathLabel.FocusControl := nil;
  905. FPathLabel := Value;
  906. if Assigned(Value) then
  907. begin
  908. Value.FreeNotification(Self);
  909. if not Assigned(Value.FocusControl) then
  910. Value.FocusControl := Self;
  911. UpdatePathLabel;
  912. end;
  913. end;
  914. end; { SetPathLabel }
  915. procedure TCustomDirView.SetShowDirectories(Value: Boolean);
  916. begin
  917. if Value <> FShowDirectories then
  918. begin
  919. FShowDirectories := Value;
  920. if DirOK then Reload(True);
  921. Self.Repaint;
  922. end;
  923. end; {SetShowDirectories}
  924. procedure TCustomDirView.SetDirsOnTop(Value: Boolean);
  925. begin
  926. if Value <> FDirsOnTop then
  927. begin
  928. FDirsOnTop := Value;
  929. if ShowDirectories then
  930. SortItems;
  931. end;
  932. end; {SetDirsOnTop}
  933. procedure TCustomDirView.SetShowHiddenFiles(Value: Boolean);
  934. begin
  935. if ShowHiddenFiles <> Value then
  936. begin
  937. FShowHiddenFiles := Value;
  938. if DirOK then Reload(False);
  939. end;
  940. end;
  941. procedure TCustomDirView.SetShowSubDirSize(Value: Boolean);
  942. begin
  943. if Value <> FShowSubDirSize then
  944. FShowSubDirSize := Value;
  945. end; {SetShowSubDirSize}
  946. procedure TCustomDirView.SetSortByExtension(Value: Boolean);
  947. Begin
  948. if Value <> FSortByExtension then
  949. begin
  950. FSortByExtension := Value;
  951. SortItems;
  952. end;
  953. end; {SetSortByExtension}
  954. function TCustomDirView.GetDragSourceEffects: TDropEffectSet;
  955. begin
  956. Result := [deCopy, deMove, deLink];
  957. end;
  958. function TCustomDirView.GetUseDragImages: Boolean;
  959. begin
  960. Result := FWantUseDragImages and FCanUseDragImages;
  961. end;
  962. procedure TCustomDirView.SetStatusBar(Value: TAssociatedStatusBar);
  963. begin
  964. if FStatusBar <> Value then
  965. begin
  966. if Assigned(FStatusBar) and
  967. (FStatusBar.FocusControl = Self) then
  968. FStatusBar.FocusControl := nil;
  969. FStatusBar := Value;
  970. if Assigned(FStatusBar) and
  971. (FStatusBar.FocusControl = nil) then
  972. FStatusBar.FocusControl := Self;
  973. UpdateStatusBar;
  974. end;
  975. end; { SetStatusBar }
  976. procedure TCustomDirView.SetTargetPopupMenu(Value: Boolean);
  977. begin
  978. if Assigned(FDragDropFilesEx) then FDragDropFilesEx.TargetPopupMenu := Value;
  979. end;
  980. procedure TCustomDirView.CreateWnd;
  981. procedure GetOverlayBitmap(ImageList: TImageList; BitmapName: string);
  982. var
  983. Bitmap: TBitmap;
  984. begin
  985. Bitmap := TBitmap.Create;
  986. try
  987. Bitmap.LoadFromResourceName(hInstance, BitmapName);
  988. ImageList.AddMasked(Bitmap, Bitmap.Canvas.Pixels[0, 0]);
  989. finally
  990. Bitmap.Free;
  991. end;
  992. end; {GetOverlayBitmap}
  993. function OverlayImageList(Size: Integer): TImageList;
  994. begin
  995. Result := TImageList.CreateSize(Size, Size);
  996. Result.DrawingStyle := dsTransparent;
  997. Result.BkColor := clNone;
  998. GetOverlayBitmap(Result, Format(ResDirUp, [Size]));
  999. GetOverlayBitmap(Result, Format(ResLink, [Size]));
  1000. GetOverlayBitmap(Result, Format(ResBrokenLink, [Size]));
  1001. end;
  1002. begin
  1003. inherited;
  1004. if Assigned(PopupMenu) then
  1005. PopupMenu.Autopopup := False;
  1006. FDragDropFilesEx.DragDropControl := Self;
  1007. FImageList16 := OverlayImageList(16);
  1008. FImageList32 := OverlayImageList(32);
  1009. IconsSetImageList;
  1010. end;
  1011. function TCustomDirView.CustomDrawItem(Item: TListItem; State: TCustomDrawState;
  1012. Stage: TCustomDrawStage): Boolean;
  1013. var
  1014. FItemColor: TColor;
  1015. begin
  1016. if (Item <> nil) and (Stage = cdPrePaint) then
  1017. begin
  1018. FItemColor := ItemColor(Item);
  1019. if (FItemColor <> clDefaultItemColor) and
  1020. (Canvas.Font.Color <> FItemColor) then
  1021. Canvas.Font.Color := FItemColor;
  1022. end;
  1023. Result := inherited CustomDrawItem(Item, State, Stage);
  1024. end;
  1025. function TCustomDirView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  1026. State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
  1027. var
  1028. FColor: TColor;
  1029. begin
  1030. if (Stage = cdPrePaint) and (SubItem > 0) and
  1031. (ItemColor(Item) <> clDefaultItemColor) then
  1032. begin
  1033. FColor := GetSysColor(COLOR_WINDOWTEXT);
  1034. if Canvas.Font.Color <> FColor then
  1035. Canvas.Font.Color := FColor;
  1036. end;
  1037. Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
  1038. end;
  1039. procedure TCustomDirView.Delete(Item: TListItem);
  1040. begin
  1041. Assert(Assigned(Item));
  1042. // This causes access violation when size is stored in structure
  1043. // pointed by TListItem->Data and this structure is not valid any more
  1044. if Valid then Dec(FFilesSize, ItemFileSize(Item));
  1045. inherited Delete(Item);
  1046. end;
  1047. destructor TCustomDirView.Destroy;
  1048. begin
  1049. Assert(not FSavedSelection);
  1050. FreeAndNil(FHistoryPaths);
  1051. FreeAndNil(FBackMenu);
  1052. FreeAndNil(FForwardMenu);
  1053. FreeAndNil(FDragDropFilesEx);
  1054. FreeAndNil(FImageList16);
  1055. FreeAndNil(FImageList32);
  1056. if Assigned(SmallImages) then
  1057. begin
  1058. SmallImages.Free;
  1059. SmallImages := nil;
  1060. end;
  1061. if Assigned(LargeImages) then
  1062. begin
  1063. LargeImages.Free;
  1064. LargeImages := nil;
  1065. end;
  1066. FreeAndNil(FAnimation);
  1067. inherited;
  1068. end;
  1069. procedure TCustomDirView.SelectFiles(Filter: TFileFilter; Select: Boolean);
  1070. var
  1071. Item: TListItem;
  1072. Index: Integer;
  1073. OldCursor: TCursor;
  1074. begin
  1075. Assert(Valid);
  1076. OldCursor := Screen.Cursor;
  1077. Items.BeginUpdate;
  1078. BeginSelectionUpdate;
  1079. try
  1080. Screen.Cursor := crHourGlass;
  1081. for Index := 0 to Items.Count-1 do
  1082. begin
  1083. Item := Items[Index];
  1084. Assert(Assigned(Item));
  1085. if (Item.Selected <> Select) and
  1086. ItemMatchesFilter(Item, Filter) then
  1087. Item.Selected := Select;
  1088. end;
  1089. finally
  1090. Screen.Cursor := OldCursor;
  1091. Items.EndUpdate;
  1092. EndSelectionUpdate;
  1093. end;
  1094. end;
  1095. function TCustomDirView.DoSelectByMask(Select: Boolean): Boolean;
  1096. var
  1097. Filter: TFileFilter;
  1098. begin
  1099. Result := inherited DoSelectByMask(Select);
  1100. if Assigned(FOnGetSelectFilter) then
  1101. begin
  1102. DefaultFileFilter(Filter);
  1103. FOnGetSelectFilter(Self, Select, Filter);
  1104. SelectFiles(Filter, Select);
  1105. Result := True;
  1106. end;
  1107. end;
  1108. function TCustomDirView.DragCompleteFileList: Boolean;
  1109. begin
  1110. Result := (MarkedCount <= 100) and (not IsRecycleBin);
  1111. end;
  1112. procedure TCustomDirView.DumbCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  1113. begin
  1114. end;
  1115. procedure TCustomDirView.DumbCustomDrawSubItem(Sender: TCustomListView;
  1116. Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  1117. var DefaultDraw: Boolean);
  1118. begin
  1119. end;
  1120. function TCustomDirView.GetTargetPopupMenu: Boolean;
  1121. begin
  1122. if Assigned(FDragDropFilesEx) then Result := FDragDropFilesEx.TargetPopupMenu
  1123. else Result := True;
  1124. end;
  1125. procedure TCustomDirView.SetMultiSelect(Value: Boolean);
  1126. begin
  1127. if Value <> MultiSelect then
  1128. begin
  1129. inherited SetMultiSelect(Value);
  1130. if not (csLoading in ComponentState) and Assigned(ColProperties) then
  1131. begin
  1132. ColProperties.RecreateColumns;
  1133. SetColumnImages;
  1134. if DirOK then Reload(True);
  1135. end;
  1136. end;
  1137. end;
  1138. function TCustomDirView.GetValid: Boolean;
  1139. begin
  1140. Result := (not (csDestroying in ComponentState)) and
  1141. (not Loading) and (not FClearingItems);
  1142. end;
  1143. function TCustomDirView.ItemCanDrag(Item: TListItem): Boolean;
  1144. begin
  1145. Result := (not ItemIsParentDirectory(Item));
  1146. end;
  1147. function TCustomDirView.ItemColor(Item: TListItem): TColor;
  1148. begin
  1149. Result := clDefaultItemColor;
  1150. end;
  1151. function TCustomDirView.GetFilesMarkedSize: Int64;
  1152. begin
  1153. if SelCount > 0 then Result := FilesSelSize
  1154. else
  1155. if Assigned(ItemFocused) then Result := ItemFileSize(ItemFocused)
  1156. else Result := 0;
  1157. end;
  1158. procedure TCustomDirView.IconsSetImageList;
  1159. function ShellImageList(Flags: UINT): TImageList;
  1160. var
  1161. FileInfo: TShFileInfo;
  1162. begin
  1163. Result := TImageList.Create(Self);
  1164. Result.Handle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo),
  1165. SHGFI_SYSICONINDEX or Flags);
  1166. Result.ShareImages := True;
  1167. end;
  1168. begin
  1169. if not Assigned(SmallImages) then
  1170. SmallImages := ShellImageList(SHGFI_SMALLICON);
  1171. if not Assigned(LargeImages) then
  1172. LargeImages := ShellImageList(SHGFI_LARGEICON);
  1173. end; {IconsSetImageList}
  1174. function TCustomDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1175. begin
  1176. Result := False;
  1177. end;
  1178. function TCustomDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1179. begin
  1180. Result := oiNoOverlay;
  1181. end;
  1182. procedure TCustomDirView.KeyDown(var Key: Word; Shift: TShiftState);
  1183. begin
  1184. if Valid and (not IsEditing) then
  1185. begin
  1186. if (Key = VK_RETURN) or
  1187. ((Key = VK_NEXT) and (ssCtrl in Shift)) then
  1188. begin
  1189. if Assigned(ItemFocused) and (not Loading) then
  1190. begin
  1191. Key := 0;
  1192. if (Key = VK_RETURN) and (Shift = [ssAlt]) then DisplayPropertiesMenu
  1193. else
  1194. if (Key <> VK_RETURN) or (Shift = []) then Execute(ItemFocused);
  1195. end;
  1196. end
  1197. else
  1198. if ((Key = VK_BACK) or ((Key = VK_PRIOR) and (ssCtrl in Shift))) and
  1199. (not Loading) and (not IsRoot) then
  1200. begin
  1201. Key := 0;
  1202. ExecuteParentDirectory;
  1203. end
  1204. else
  1205. if (Key = 220 { backslash }) and (ssCtrl in Shift) and (not Loading) and
  1206. (not IsRoot) then
  1207. begin
  1208. Key := 0;
  1209. ExecuteRootDirectory;
  1210. end
  1211. else
  1212. begin
  1213. inherited;
  1214. end;
  1215. end
  1216. else
  1217. begin
  1218. inherited;
  1219. end;
  1220. end;
  1221. procedure TCustomDirView.KeyPress(var Key: Char);
  1222. begin
  1223. if IsEditing and (Pos(Key, FInvalidNameChars) <> 0) Then
  1224. Begin
  1225. Beep;
  1226. Key := #0;
  1227. End;
  1228. inherited;
  1229. end;
  1230. procedure TCustomDirView.KeyUp(var Key: Word; Shift: TShiftState);
  1231. var
  1232. P: TPoint;
  1233. R: TRect;
  1234. begin
  1235. if Key = VK_APPS then
  1236. begin
  1237. if not Loading then
  1238. begin
  1239. if MarkedCount > 0 then
  1240. begin
  1241. if Assigned(ItemFocused) then
  1242. Begin
  1243. R := ItemFocused.DisplayRect(drIcon);
  1244. P.X := (R.Left + R.Right) div 2;
  1245. P.Y := (R.Top + R.Bottom) div 2;
  1246. end
  1247. else
  1248. begin
  1249. P.X := 0;
  1250. P.Y := 0;
  1251. end;
  1252. P := ClientToScreen(P);
  1253. DisplayContextMenu(P);
  1254. end
  1255. else
  1256. if Assigned(PopupMenu) then
  1257. begin
  1258. P.X := 0;
  1259. P.Y := 0;
  1260. P := ClientToScreen(P);
  1261. PopupMenu.Popup(P.X, P.Y);
  1262. end;
  1263. end;
  1264. end
  1265. else
  1266. inherited KeyUp(Key, Shift);
  1267. end;
  1268. procedure TCustomDirView.SetWatchForChanges(Value: Boolean);
  1269. begin
  1270. if FWatchForChanges <> Value then
  1271. FWatchForChanges := Value;
  1272. end;
  1273. function TCustomDirView.TargetHasDropHandler(Item: TListItem; Effect: Integer): Boolean;
  1274. begin
  1275. Assert(Assigned(DragDropFilesEx) and Assigned(Item));
  1276. Result :=
  1277. DragDropFilesEx.TargetHasDropHandler(nil, ItemFullFileName(Item), Effect);
  1278. end;
  1279. procedure TCustomDirView.UpdatePathComboBox;
  1280. begin
  1281. if Assigned(PathComboBox) then
  1282. PathComboBox.Path := Path;
  1283. end; { UpdatePathComboBox }
  1284. procedure TCustomDirView.UpdatePathLabel;
  1285. begin
  1286. if Assigned(PathLabel) then
  1287. begin
  1288. if csDesigning in ComponentState then
  1289. PathLabel.Caption := PathLabel.Name
  1290. else
  1291. PathLabel.Caption := PathName;
  1292. PathLabel.UpdateStatus;
  1293. end;
  1294. end; { UpdatePathLabel }
  1295. procedure TCustomDirView.UpdateStatusBar;
  1296. var
  1297. StatusFileInfo: TStatusFileInfo;
  1298. begin
  1299. if (FUpdatingSelection = 0) and Assigned(StatusBar) then
  1300. begin
  1301. with StatusFileInfo do
  1302. begin
  1303. SelectedSize := FilesSelSize;
  1304. FilesSize := Self.FilesSize;
  1305. SelectedCount := SelCount;
  1306. FilesCount := Self.FilesCount;
  1307. end;
  1308. StatusBar.FileInfo := StatusFileInfo;
  1309. end;
  1310. end; { UpdateStatusBar }
  1311. procedure TCustomDirView.WMContextMenu(var Message: TWMContextMenu);
  1312. var
  1313. Point: TPoint;
  1314. begin
  1315. FDragEnabled := False;
  1316. if Assigned(PopupMenu) then
  1317. PopupMenu.AutoPopup := False;
  1318. //inherited;
  1319. if FContextMenu and (not Loading) then
  1320. begin
  1321. Point.X := Message.XPos;
  1322. Point.Y := Message.YPos;
  1323. Point := ScreenToClient(Point);
  1324. if Assigned(OnMouseDown) then
  1325. OnMouseDown(Self, mbRight, [], Point.X, Point.Y);
  1326. if FUseSystemContextMenu and Assigned(ItemFocused) and
  1327. (GetItemAt(Point.X, Point.Y) = ItemFocused) then
  1328. begin
  1329. Point.X := Message.XPos;
  1330. Point.Y := Message.YPos;
  1331. DisplayContextMenu(Point);
  1332. end
  1333. else
  1334. if Assigned(PopupMenu) and (not PopupMenu.AutoPopup) then
  1335. PopupMenu.Popup(Message.XPos, Message.YPos);
  1336. end;
  1337. FContextMenu := False;
  1338. //inherited;
  1339. end;
  1340. procedure TCustomDirView.WMLButtonDown(var Message: TWMLButtonDown);
  1341. Begin
  1342. GetCursorPos(FStartPos);
  1343. FDragEnabled := (not Loading);
  1344. inherited;
  1345. end;
  1346. procedure TCustomDirView.WMPaint(var Message: TWMPaint);
  1347. begin
  1348. inherited;
  1349. if FNeverPainted then
  1350. begin
  1351. FNeverPainted := False;
  1352. Invalidate;
  1353. end;
  1354. end;
  1355. procedure TCustomDirView.WMRButtonDown(var Message: TWMRButtonDown);
  1356. begin
  1357. GetCursorPos(FStartPos);
  1358. if FDragDropFilesEx.DragDetectStatus <> ddsDrag then
  1359. FDragEnabled := (not Loading);
  1360. FContextMenu := True;
  1361. inherited;
  1362. end;
  1363. procedure TCustomDirView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1364. begin
  1365. inherited;
  1366. if (not SingleClickToExec) and Assigned(ItemFocused) and (not Loading) and
  1367. (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) then
  1368. begin
  1369. if GetKeyState(VK_MENU) < 0 then DisplayPropertiesMenu
  1370. else Execute(ItemFocused);
  1371. end;
  1372. end;
  1373. procedure TCustomDirView.WMLButtonUp(var Message: TWMLButtonUp);
  1374. begin
  1375. if SingleClickToExec and FDragEnabled and Assigned(ItemFocused) and (not Loading) and
  1376. (GetItemAt(Message.XPos, Message.YPos) = ItemFocused) and
  1377. (GetKeyState(VK_SHIFT) >= 0) and (GetKeyState(VK_CONTROL) >= 0) then
  1378. begin
  1379. if GetKeyState(VK_MENU) < 0 then DisplayPropertiesMenu
  1380. else Execute(ItemFocused);
  1381. end;
  1382. FDragEnabled := False;
  1383. inherited;
  1384. end;
  1385. procedure TCustomDirView.Reload(CacheIcons: Boolean);
  1386. var
  1387. OldSelection: TStrings;
  1388. OldItemFocused: string;
  1389. Index: Integer;
  1390. FoundIndex: Integer;
  1391. IconCache: TStringList;
  1392. Item: TListItem;
  1393. FileName: string;
  1394. function FindInOldSelection(FileName: string): Boolean;
  1395. var
  1396. Index: Integer;
  1397. begin
  1398. Result := True;
  1399. for Index := 0 to OldSelection.Count - 1 do
  1400. if AnsiCompareStr(OldSelection[Index], FileName) = 0 then Exit;
  1401. Result := False;
  1402. end;
  1403. begin
  1404. if Path <> '' then
  1405. begin
  1406. OldSelection := nil;
  1407. IconCache := nil;
  1408. Items.BeginUpdate;
  1409. try
  1410. OldSelection := TStringList.Create;
  1411. if CacheIcons then
  1412. IconCache := TStringList.Create;
  1413. for Index := 0 to Items.Count-1 do
  1414. begin
  1415. Item := Items[Index];
  1416. FileName := Item.Caption;
  1417. if Item.Selected then
  1418. OldSelection.Add(FileName);
  1419. if CacheIcons and (ItemImageIndex(Item, True) >= 0) then
  1420. IconCache.AddObject(FileName, TObject(ItemImageIndex(Item, True)));
  1421. end;
  1422. if FSelectFile <> '' then
  1423. begin
  1424. OldItemFocused := FSelectFile;
  1425. FSelectFile := '';
  1426. end
  1427. else
  1428. if Assigned(ItemFocused) then OldItemFocused := ItemFocused.Caption
  1429. else OldItemFocused := '';
  1430. Load;
  1431. TStringList(OldSelection).Sort;
  1432. if CacheIcons then IconCache.Sort;
  1433. for Index := 0 to Items.Count - 1 do
  1434. begin
  1435. Item := Items[Index];
  1436. FileName := ItemFileName(Item);
  1437. if FileName = OldItemFocused then
  1438. ItemFocused := Item;
  1439. if ((not FCaseSensitive) and TStringList(OldSelection).Find(FileName, FoundIndex)) or
  1440. (FCaseSensitive and FindInOldSelection(FileName)) then
  1441. Item.Selected := True;
  1442. if CacheIcons and (ItemImageIndex(Item, True) < 0) then
  1443. begin
  1444. FoundIndex := IconCache.IndexOf(FileName);
  1445. if FoundIndex >= 0 then
  1446. SetItemImageIndex(Item, Integer(IconCache.Objects[FoundIndex]));
  1447. end;
  1448. end;
  1449. FocusSomething;
  1450. finally
  1451. Items.EndUpdate;
  1452. OldSelection.Free;
  1453. if CacheIcons then IconCache.Free;
  1454. end;
  1455. end;
  1456. end;
  1457. procedure TCustomDirView.Load;
  1458. var
  1459. SaveCursor: TCursor;
  1460. LastDirName: string;
  1461. begin
  1462. if not FLoadEnabled or Loading then
  1463. begin
  1464. FDirty := True;
  1465. FAbortLoading := True;
  1466. end
  1467. else
  1468. begin
  1469. FLoading := True;
  1470. try
  1471. FHasParentDir := False;
  1472. if Assigned(FOnStartLoading) then FOnStartLoading(Self);
  1473. SaveCursor := Screen.Cursor;
  1474. Screen.Cursor := crHourGlass;
  1475. try
  1476. FNotifyEnabled := False;
  1477. ClearItems;
  1478. GetSystemTime(FReloadTime);
  1479. FFilesSize := 0;
  1480. FFilesSelSize := 0;
  1481. SortType := stNone;
  1482. Items.BeginUpdate;
  1483. try
  1484. try
  1485. DoAnimation(True);
  1486. LoadFiles;
  1487. finally
  1488. DoAnimation(False);
  1489. end;
  1490. finally
  1491. Items.EndUpdate;
  1492. end;
  1493. finally
  1494. Screen.Cursor := SaveCursor;
  1495. end;
  1496. finally
  1497. FLoading := False;
  1498. try
  1499. if FAbortLoading then
  1500. begin
  1501. FAbortLoading := False;
  1502. Reload(False);
  1503. end
  1504. else
  1505. begin
  1506. if DirOK then SortItems;
  1507. FAbortLoading := False;
  1508. FDirty := False;
  1509. if (Length(LastPath) > Length(PathName)) and
  1510. (Copy(LastPath, 1, Length(PathName)) = PathName) and
  1511. (Items.Count > 0) then
  1512. begin
  1513. LastDirName := Copy(LastPath, LastDelimiter('\:/', LastPath) + 1, MaxInt);
  1514. ItemFocused := FindFileItem(LastDirName);
  1515. end;
  1516. end;
  1517. finally
  1518. // nested try .. finally block is included
  1519. // because we really want these to be executed
  1520. FNotifyEnabled := True;
  1521. if DirOK and not FAbortLoading and Assigned(FOnDirUpdated) then
  1522. FOnDirUpdated(Self);
  1523. FocusSomething;
  1524. if Assigned(FOnLoaded) then FOnLoaded(Self);
  1525. UpdatePathLabel;
  1526. UpdateStatusBar;
  1527. end;
  1528. end;
  1529. end;
  1530. end;
  1531. procedure TCustomDirView.SetLoadEnabled(Enabled: Boolean);
  1532. begin
  1533. if Enabled <> LoadEnabled then
  1534. begin
  1535. FLoadEnabled := Enabled;
  1536. if Enabled and Dirty then Reload(True);
  1537. end;
  1538. end;
  1539. function TCustomDirView.ItemDragFileName(Item: TListItem): string;
  1540. begin
  1541. Result := ItemFullFileName(Item);
  1542. end;
  1543. function TCustomDirView.GetFilesCount: Integer;
  1544. begin
  1545. Result := Items.Count;
  1546. if (Result > 0) and HasParentDir then Dec(Result);
  1547. end;
  1548. procedure TCustomDirView.SetViewStyle(Value: TViewStyle);
  1549. begin
  1550. if (Value <> ViewStyle) and (not FLoading) then
  1551. begin
  1552. FNotifyEnabled := False;
  1553. inherited;
  1554. FNotifyEnabled := True;
  1555. end;
  1556. end;
  1557. procedure TCustomDirView.ColClick(Column: TListColumn);
  1558. var
  1559. ScrollToFocused: Boolean;
  1560. begin
  1561. ScrollToFocused := Assigned(ItemFocused);
  1562. inherited;
  1563. if ScrollToFocused and Assigned(ItemFocused) then
  1564. ItemFocused.MakeVisible(False);
  1565. end;
  1566. procedure TCustomDirView.CustomSortItems(SortProc: Pointer);
  1567. var
  1568. SavedCursor: TCursor;
  1569. SavedNotifyEnabled: Boolean;
  1570. begin
  1571. if HandleAllocated then
  1572. begin
  1573. SavedNotifyEnabled := FNotifyEnabled;
  1574. SavedCursor := Screen.Cursor;
  1575. Items.BeginUpdate;
  1576. try
  1577. Screen.Cursor := crHourglass;
  1578. FNotifyEnabled := False;
  1579. CustomSort(TLVCompare(SortProc), Integer(Pointer(Self)));
  1580. finally
  1581. Screen.Cursor := SavedCursor;
  1582. FNotifyEnabled := SavedNotifyEnabled;
  1583. Items.EndUpdate;
  1584. end;
  1585. end;
  1586. end;
  1587. procedure TCustomDirView.ReloadForce(CacheIcons: Boolean);
  1588. begin
  1589. FLoadEnabled := True;
  1590. FDirty := False;
  1591. Reload(CacheIcons);
  1592. end;
  1593. procedure TCustomDirView.DDDragEnter(DataObj: IDataObject; grfKeyState: Longint;
  1594. Point: TPoint; var dwEffect: longint; var Accept: Boolean);
  1595. var
  1596. Index: Integer;
  1597. begin
  1598. Accept := Accept and DirOK and (not Loading);
  1599. if Accept and (DragDropFilesEx.FileList.Count > 0) and
  1600. (Length(TFDDListItem(DragDropFilesEx.FileList[0]^).Name) > 2) and
  1601. ((TFDDListItem(DragDropFilesEx.FileList[0]^).Name[2] = ':') or
  1602. (TFDDListItem(DragDropFilesEx.FileList[0]^).Name[2] = '\')) and
  1603. (not IsRecycleBin or not DragDropFilesEx.FileNamesAreMapped) then
  1604. begin
  1605. FDragDrive := Upcase(TFDDListItem(DragDropFilesEx.FileList[0]^).Name[1]);
  1606. FExeDrag := FDDLinkOnExeDrag and
  1607. (deLink in DragDropFilesEx.TargetEffects) and
  1608. ((DragDropFilesEx.AvailableDropEffects and DropEffect_Link) <> 0);
  1609. if FExeDrag then
  1610. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  1611. if not IsExecutable(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  1612. begin
  1613. FExeDrag := False;
  1614. Break;
  1615. end;
  1616. end
  1617. else
  1618. begin
  1619. FDragDrive := #0;
  1620. Accept := False;
  1621. end;
  1622. GetSystemTimeAsFileTime(FLastVScrollTime);
  1623. FVScrollCount := 0;
  1624. if Assigned(FOnDDDragEnter) then
  1625. FOnDDDragEnter(Self, DataObj, grfKeyState, Point, dwEffect, Accept);
  1626. end;
  1627. procedure TCustomDirView.DDDragLeave;
  1628. begin
  1629. if Assigned(DropTarget) and GlobalDragImageList.Dragging then
  1630. begin
  1631. GlobalDragImageList.HideDragImage;
  1632. DropTarget := nil;
  1633. Update; {ie30}
  1634. end
  1635. else DropTarget := nil;
  1636. if Assigned(FOnDDDragLeave) then
  1637. FOnDDDragLeave(Self);
  1638. end;
  1639. procedure TCustomDirView.DDDragOver(grfKeyState: Integer; Point: TPoint;
  1640. var dwEffect: Integer);
  1641. var
  1642. DropItem: TListItem;
  1643. KnowTime: TFileTime;
  1644. NbPixels: Integer;
  1645. CanDrop: Boolean;
  1646. HasDropHandler: Boolean;
  1647. WParam: LongInt;
  1648. begin
  1649. FDDOwnerIsSource := DragDropFilesEx.OwnerIsSource;
  1650. {Set droptarget if target is directory:}
  1651. if not Loading then DropItem := GetItemAt(Point.X, Point.Y)
  1652. else DropItem := nil;
  1653. HasDropHandler := (Assigned(DropItem) and (not IsRecycleBin) and
  1654. TargetHasDropHandler(DropItem, dwEffect));
  1655. CanDrop := Assigned(DropItem) and (not IsRecycleBin) and
  1656. (ItemIsDirectory(DropItem) or HasDropHandler);
  1657. if (CanDrop and (DropTarget <> DropItem)) or
  1658. (not CanDrop and Assigned(DropTarget)) then
  1659. begin
  1660. if GlobalDragImageList.Dragging then
  1661. begin
  1662. GlobalDragImageList.HideDragImage;
  1663. DropTarget := nil;
  1664. Update;
  1665. if CanDrop then
  1666. begin
  1667. DropTarget := DropItem;
  1668. Update;
  1669. end;
  1670. GlobalDragImageList.ShowDragImage;
  1671. end
  1672. else
  1673. begin
  1674. DropTarget := nil;
  1675. if CanDrop then DropTarget := DropItem;
  1676. end;
  1677. end;
  1678. GetSystemTimeAsFileTime(KnowTime);
  1679. NbPixels := Abs((Font.Height));
  1680. {Vertical scrolling, if viewstyle = vsReport:}
  1681. if (ViewStyle = vsReport) and (not Loading) and Assigned(TopItem) and
  1682. (((Int64(KnowTime) - Int64(FLastVScrollTime)) > DDVScrollDelay) or
  1683. ((FVScrollCount > DDMaxSlowCount) and
  1684. ((Int64(KnowTime) - Int64(FLastVScrollTime)) > (DDVScrollDelay div 4)))) then
  1685. begin
  1686. if ((DropItem = TopItem) or (Point.Y - 3 * nbPixels <= 0)) and
  1687. (TopItem.Index > 0) then WParam := SB_LINEUP
  1688. else
  1689. if (Point.Y + 3 * nbPixels > Height) then WParam := SB_LINEDOWN
  1690. else WParam := -1;
  1691. if WParam >= 0 then
  1692. begin
  1693. if GlobalDragImageList.Dragging then
  1694. GlobalDragImageList.HideDragImage;
  1695. Perform(WM_VSCROLL, WParam, 0);
  1696. if FVScrollCount > DDMaxSlowCount then
  1697. Perform(WM_VSCROLL, WParam, 0);
  1698. if FVScrollCount > DDMaxSlowCount * 3 then
  1699. Perform(WM_VSCROLL, WParam, 0);
  1700. Update;
  1701. if GlobalDragImageList.Dragging then
  1702. GlobalDragImageList.ShowDragImage;
  1703. GetSystemTimeAsFileTime(FLastVScrollTime);
  1704. Inc(FVScrollCount);
  1705. end
  1706. else FVScrollCount := 0;
  1707. end; {VScrollDelay}
  1708. {Set dropeffect:}
  1709. if (not HasDropHandler) and (not Loading) then
  1710. begin
  1711. if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  1712. begin
  1713. if ExeDrag and (Path[1] >= FirstFixedDrive) and
  1714. (DragDrive >= FirstFixedDrive) then dwEffect := DropEffect_Link
  1715. else
  1716. if DragOnDriveIsMove and
  1717. (not FDDOwnerIsSource or Assigned(DropTarget)) and
  1718. (((DragDrive = Upcase(Path[1])) and (dwEffect = DropEffect_Copy) and
  1719. (DragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0))
  1720. or IsRecycleBin) then dwEffect := DropEffect_Move;
  1721. end;
  1722. if Assigned(FOnDDDragOver) then
  1723. FOnDDDragOver(Self, grfKeyState, Point, dwEffect);
  1724. if DragDropFilesEx.OwnerIsSource and (dwEffect = DropEffect_Move) and
  1725. (not Assigned(DropTarget)) then dwEffect := DropEffect_None
  1726. else
  1727. if Assigned(DropTarget) and ItemIsRecycleBin(DropTarget) Then
  1728. dwEffect := DropEffect_Move;
  1729. end;
  1730. end;
  1731. function TCustomDirView.CustomCreateFileList(Focused, OnlyFocused: Boolean;
  1732. FullPath: Boolean; FileList: TStrings): TStrings;
  1733. procedure AddItem(Item: TListItem);
  1734. begin
  1735. Assert(Assigned(Item));
  1736. if FullPath then Result.AddObject(ItemFullFileName(Item), Item.Data)
  1737. else Result.AddObject(ItemFileName(Item), Item.Data);
  1738. end;
  1739. var
  1740. Item: TListItem;
  1741. begin
  1742. if Assigned(FileList) then Result := FileList
  1743. else Result := TStringList.Create;
  1744. try
  1745. if Assigned(ItemFocused) and
  1746. ((Focused and (not ItemFocused.Selected)) or (SelCount = 0) or OnlyFocused) then
  1747. begin
  1748. AddItem(ItemFocused)
  1749. end
  1750. else
  1751. begin
  1752. Item := GetNextItem(nil, sdAll, [isSelected]);
  1753. while Assigned(Item) do
  1754. begin
  1755. AddItem(Item);
  1756. Item := GetNextItem(Item, sdAll, [isSelected]);
  1757. end;
  1758. end;
  1759. except
  1760. if not Assigned(FileList) then FreeAndNil(Result);
  1761. raise;
  1762. end;
  1763. end;
  1764. function TCustomDirView.CreateFocusedFileList(FullPath: Boolean; FileList: TStrings): TStrings;
  1765. begin
  1766. Result := CustomCreateFileList(False, True, FullPath, FileList);
  1767. end;
  1768. function TCustomDirView.CreateFileList(Focused: Boolean; FullPath: Boolean;
  1769. FileList: TStrings): TStrings;
  1770. begin
  1771. Result := CustomCreateFileList(Focused, False, FullPath, FileList);
  1772. end;
  1773. procedure TCustomDirView.DDDrop(DataObj: IDataObject; grfKeyState: Integer;
  1774. Point: TPoint; var dwEffect: Integer);
  1775. begin
  1776. if GlobalDragImageList.Dragging then
  1777. GlobalDragImageList.HideDragImage;
  1778. if dwEffect = DropEffect_None then
  1779. DropTarget := nil;
  1780. if Assigned(OnDDDrop) then
  1781. OnDDDrop(Self, DataObj, grfKeyState, Point, dwEffect);
  1782. end;
  1783. procedure TCustomDirView.DDQueryContinueDrag(FEscapePressed: LongBool;
  1784. grfKeyState: Integer; var Result: HResult);
  1785. var
  1786. MousePos: TPoint;
  1787. KnowTime: TFileTime;
  1788. begin
  1789. if Result = DRAGDROP_S_DROP then
  1790. begin
  1791. GetSystemTimeAsFileTime(KnowTime);
  1792. if ((Int64(KnowTime) - INT64(FDragStartTime)) <= DDDragStartDelay) then
  1793. Result := DRAGDROP_S_CANCEL;
  1794. end;
  1795. if Assigned(OnDDQueryContinueDrag) then
  1796. OnDDQueryContinueDrag(Self, FEscapePressed, grfKeyState, Result);
  1797. if FEscapePressed then
  1798. begin
  1799. if GlobalDragImageList.Dragging then
  1800. GlobalDragImageList.HideDragImage;
  1801. end
  1802. else
  1803. begin
  1804. if GlobalDragImageList.Dragging Then
  1805. begin
  1806. MousePos := ParentForm.ScreenToClient(Mouse.CursorPos);
  1807. {Move the drag image to the new position and show it:}
  1808. if (MousePos.X <> FDragPos.X) or (MousePos.Y <> FDragPos.Y) then
  1809. begin
  1810. FDragPos := MousePos;
  1811. if PtInRect(ParentForm.BoundsRect, Mouse.CursorPos) then
  1812. begin
  1813. GlobalDragImageList.DragMove(MousePos.X, MousePos.Y);
  1814. GlobalDragImageList.ShowDragImage;
  1815. end
  1816. else GlobalDragImageList.HideDragImage;
  1817. end;
  1818. end;
  1819. end;
  1820. end;
  1821. procedure TCustomDirView.DDSpecifyDropTarget(Sender: TObject;
  1822. DragDropHandler: Boolean; Point: TPoint; var pidlFQ: PItemIDList;
  1823. var Filename: string);
  1824. var
  1825. Item: TListItem;
  1826. begin
  1827. pidlFQ := nil;
  1828. if DirOK and (not Loading) then
  1829. begin
  1830. if DragDropHandler then
  1831. begin
  1832. if Assigned(DropTarget) and ItemIsDirectory(DropTarget) then
  1833. FileName := ItemFullFileName(DropTarget)
  1834. else
  1835. FileName := PathName;
  1836. end
  1837. else
  1838. begin
  1839. Item := GetItemAt(Point.X, Point.Y);
  1840. if Assigned(Item) and (not ItemIsDirectory(Item)) and
  1841. (not IsRecycleBin) then
  1842. FileName := ItemFullFileName(Item)
  1843. else
  1844. FileName := '';
  1845. end;
  1846. end
  1847. else FileName := '';
  1848. end;
  1849. procedure TCustomDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  1850. begin
  1851. end;
  1852. procedure TCustomDirView.DDDropHandlerSucceeded(Sender: TObject;
  1853. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  1854. begin
  1855. DropTarget := nil;
  1856. end;
  1857. procedure TCustomDirView.DDGiveFeedback(dwEffect: Integer;
  1858. var Result: HResult);
  1859. begin
  1860. if Assigned(FOnDDGiveFeedback) then
  1861. FOnDDGiveFeedback(Self, dwEffect, Result);
  1862. end;
  1863. procedure TCustomDirView.DDProcessDropped(Sender: TObject;
  1864. grfKeyState: Integer; Point: TPoint; dwEffect: Integer);
  1865. begin
  1866. if DirOK and (not Loading) then
  1867. try
  1868. try
  1869. if Assigned(FOnDDProcessDropped) then
  1870. FOnDDProcessDropped(Self, grfKeyState, Point, dwEffect);
  1871. if dwEffect <> DropEffect_None then
  1872. begin
  1873. PerformItemDragDropOperation(DropTarget, dwEffect);
  1874. if Assigned(FOnDDExecuted) then
  1875. FOnDDExecuted(Self, dwEffect);
  1876. end;
  1877. finally
  1878. DragDropFilesEx.FileList.Clear;
  1879. DropTarget := nil;
  1880. end;
  1881. except
  1882. Application.HandleException(Self);
  1883. end;
  1884. end;
  1885. function TCustomDirView.AnyFileSelected(OnlyFocused: Boolean): Boolean;
  1886. var
  1887. Item: TListItem;
  1888. begin
  1889. if OnlyFocused or (SelCount = 0) then
  1890. Result := Assigned(ItemFocused) and ItemIsFile(ItemFocused)
  1891. else
  1892. begin
  1893. Result := True;
  1894. Item := GetNextItem(nil, sdAll, [isSelected]);
  1895. while Assigned(Item) do
  1896. begin
  1897. if ItemIsFile(Item) then Exit;
  1898. Item := GetNextItem(Item, sdAll, [isSelected]);
  1899. end;
  1900. Result := False;
  1901. end;
  1902. end;
  1903. function TCustomDirView.CanEdit(Item: TListItem): Boolean;
  1904. begin
  1905. Result :=
  1906. (inherited CanEdit(Item) or FForceRename) and (not Loading) and
  1907. Assigned(Item) and (not ReadOnly) and (not IsRecycleBin) and
  1908. (not ItemIsParentDirectory(Item));
  1909. if Result then FLoadEnabled := False;
  1910. FForceRename := False;
  1911. end;
  1912. function TCustomDirView.CanChangeSelection(Item: TListItem;
  1913. Select: Boolean): Boolean;
  1914. begin
  1915. Result :=
  1916. (not Loading) and
  1917. not (Assigned(Item) and Assigned(Item.Data) and
  1918. ItemIsParentDirectory(Item));
  1919. end;
  1920. procedure TCustomDirView.Edit(const HItem: TLVItem);
  1921. var
  1922. Item: TListItem;
  1923. Info: string;
  1924. Index: Integer;
  1925. begin
  1926. if Length(HItem.pszText) = 0 then LoadEnabled := True
  1927. else
  1928. begin
  1929. Item := GetItemFromHItem(HItem);
  1930. {Does the changed filename contains invalid characters?}
  1931. if StrContains(FInvalidNameChars, HItem.pszText) then
  1932. begin
  1933. Info := FInvalidNameChars;
  1934. for Index := Length(Info) downto 1 do
  1935. System.Insert(Space, Info, Index);
  1936. MessageBeep(MB_ICONHAND);
  1937. if MessageDlg(SErrorInvalidName + Space + Info, mtError,
  1938. [mbOK, mbAbort], 0) = mrOK then RetryRename(HItem.pszText);
  1939. LoadEnabled := True;
  1940. end
  1941. else
  1942. begin
  1943. if Assigned(FOnBeginRename) then
  1944. FOnBeginRename(Self, Item, string(HItem.pszText));
  1945. InternalEdit(HItem);
  1946. if Assigned(FOnEndRename) then
  1947. FOnEndRename(Self, Item, string(HItem.pszText));
  1948. end;
  1949. end;
  1950. end; {Edit}
  1951. procedure TCustomDirView.EndSelectionUpdate;
  1952. begin
  1953. inherited;
  1954. if FUpdatingSelection = 0 then
  1955. UpdateStatusBar;
  1956. end; { EndUpdatingSelection }
  1957. procedure TCustomDirView.ExecuteCurrentFile();
  1958. begin
  1959. Assert(Assigned(ItemFocused));
  1960. Execute(ItemFocused);
  1961. end;
  1962. procedure TCustomDirView.Execute(Item: TListItem);
  1963. var
  1964. AllowExec: Boolean;
  1965. begin
  1966. Assert(Assigned(Item));
  1967. if Assigned(Item) and Assigned(Item.Data) and (not Loading) then
  1968. begin
  1969. if IsRecycleBin then DisplayPropertiesMenu
  1970. else
  1971. begin
  1972. AllowExec := True;
  1973. if Assigned(FOnExecFile) then FOnExecFile(Self, Item, AllowExec);
  1974. if AllowExec then
  1975. begin
  1976. if ItemIsParentDirectory(Item) then ExecuteParentDirectory
  1977. else ExecuteFile(Item);
  1978. end;
  1979. end;
  1980. end;
  1981. end;
  1982. procedure TCustomDirView.GetDisplayInfo(ListItem: TListItem;
  1983. var DispInfo: TLVItemA);
  1984. begin
  1985. // Nothing
  1986. end;
  1987. procedure TCustomDirView.WMUserRename(var Message: TMessage);
  1988. begin
  1989. if Assigned(ItemFocused) then
  1990. begin
  1991. FForceRename := True;
  1992. ListView_EditLabel(Handle, ItemFocused.Index);
  1993. SetWindowText(ListView_GetEditControl(Self.Handle),
  1994. PChar(FLastRenameName));
  1995. end;
  1996. end;
  1997. procedure TCustomDirView.RetryRename(NewName: string);
  1998. begin
  1999. FLastRenameName := NewName;
  2000. PostMessage(Self.Handle, WM_USER_RENAME, Longint(PChar(NewName)), 0);
  2001. end;
  2002. procedure TCustomDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2003. begin
  2004. FileList.AddItem(nil, ItemDragFileName(Item));
  2005. end;
  2006. procedure TCustomDirView.DDDragDetect(grfKeyState: Integer; DetectStart,
  2007. Point: TPoint; DragStatus: TDragDetectStatus);
  2008. var
  2009. FilesCount: Integer;
  2010. DirsCount: Integer;
  2011. Item: TListItem;
  2012. FirstItem : TListItem;
  2013. Bitmap: TBitmap;
  2014. ImageListHandle: HImageList;
  2015. Spot: TPoint;
  2016. ItemPos: TPoint;
  2017. DragText: string;
  2018. ClientPoint: TPoint;
  2019. OldCursor: TCursor;
  2020. begin
  2021. if Assigned(FOnDDDragDetect) then
  2022. FOnDDDragDetect(Self, grfKeyState, DetectStart, Point, DragStatus);
  2023. if (DragStatus = ddsDrag) and (not Loading) and (MarkedCount > 0) then
  2024. begin
  2025. DragDropFilesEx.CompleteFileList := DragCompleteFileList;
  2026. DragDropFilesEx.FileList.Clear;
  2027. FirstItem := nil;
  2028. FilesCount := 0;
  2029. DirsCount := 0;
  2030. if Assigned(ItemFocused) and (not ItemFocused.Selected) and
  2031. ItemCanDrag(ItemFocused) then
  2032. begin
  2033. FirstItem := ItemFocused;
  2034. AddToDragFileList(DragDropFilesEx.FileList, ItemFocused);
  2035. if ItemIsDirectory(ItemFocused) then DirsCount := 1
  2036. else FilesCount := 1;
  2037. end
  2038. else
  2039. if SelCount > 0 then
  2040. begin
  2041. Item := GetNextItem(nil, sdAll, [isSelected]);
  2042. while Assigned(Item) do
  2043. begin
  2044. if ItemCanDrag(Item) then
  2045. begin
  2046. if not Assigned(FirstItem) then
  2047. FirstItem := Item;
  2048. AddToDragFileList(DragDropFilesEx.FileList, Item);
  2049. if ItemIsDirectory(Item) then Inc(DirsCount)
  2050. else Inc(FilesCount);
  2051. end;
  2052. Item := GetNextItem(Item, sdAll, [isSelected]);
  2053. end;
  2054. end;
  2055. if Assigned(FirstItem) then
  2056. begin
  2057. OldCursor := Screen.Cursor;
  2058. Screen.Cursor := crHourGlass;
  2059. try
  2060. FDragEnabled := False;
  2061. {Create the dragimage:}
  2062. GlobalDragImageList := DragImageList;
  2063. if UseDragImages then
  2064. begin
  2065. ImageListHandle := ListView_CreateDragImage(Handle, FirstItem.Index, Spot);
  2066. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2067. if ImageListHandle <> Invalid_Handle_Value then
  2068. begin
  2069. GlobalDragImageList.Handle := ImageListHandle;
  2070. if FilesCount + DirsCount = 1 then
  2071. begin
  2072. ItemPos := ClientToScreen(FirstItem.DisplayRect(drBounds).TopLeft);
  2073. GlobalDragImageList.SetDragImage(0,
  2074. DetectStart.X - ItemPos.X, DetectStart.Y - ItemPos.Y);
  2075. end
  2076. else
  2077. begin
  2078. GlobalDragImageList.Clear;
  2079. GlobalDragImageList.Width := 32;
  2080. GlobalDragImageList.Height := 32;
  2081. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES', 0,
  2082. [lrTransparent], $FFFFFF) Then
  2083. begin
  2084. Bitmap := TBitmap.Create;
  2085. try
  2086. try
  2087. GlobalDragImageList.GetBitmap(0, Bitmap);
  2088. Bitmap.Canvas.Font.Assign(Self.Font);
  2089. DragText := '';
  2090. if FilesCount > 0 then
  2091. DragText := Format(STextFiles, [FilesCount]);
  2092. if DirsCount > 0 then
  2093. begin
  2094. if FilesCount > 0 then
  2095. DragText := DragText + ', ';
  2096. DragText := DragText + Format(STextDirectories, [DirsCount]);
  2097. end;
  2098. Bitmap.Width := 33 + Bitmap.Canvas.TextWidth(DragText);
  2099. Bitmap.TransparentMode := tmAuto;
  2100. Bitmap.Canvas.TextOut(33,
  2101. Max(24 - Abs(Canvas.Font.Height), 0), DragText);
  2102. GlobalDragImageList.Clear;
  2103. GlobalDragImageList.Width := Bitmap.Width;
  2104. GlobalDragImageList.AddMasked(Bitmap,
  2105. Bitmap.Canvas.Pixels[0, 0]);
  2106. GlobalDragImageList.SetDragImage(0, 25, 20);
  2107. except
  2108. if GlobalDragImageList.GetResource(rtBitMap, 'DRAGFILES',
  2109. 0, [lrTransparent], $FFFFFF) then
  2110. GlobalDragImageList.SetDragImage(0, 25, 20);
  2111. end;
  2112. finally
  2113. Bitmap.Free;
  2114. end;
  2115. end;
  2116. end;
  2117. ClientPoint := ParentForm.ScreenToClient(Point);
  2118. GlobalDragImageList.BeginDrag(ParentForm.Handle,
  2119. ClientPoint.X, ClientPoint.Y);
  2120. GlobalDragImageList.HideDragImage;
  2121. ShowCursor(True);
  2122. end;
  2123. end;
  2124. finally
  2125. Screen.Cursor := OldCursor;
  2126. end;
  2127. FContextMenu := False;
  2128. if IsRecycleBin then DragDropFilesEx.SourceEffects := [deMove]
  2129. else DragDropFilesEx.SourceEffects := DragSourceEffects;
  2130. DropSourceControl := Self;
  2131. GetSystemTimeAsFileTime(FDragStartTime);
  2132. {Execute the drag&drop-Operation:}
  2133. FLastDDResult := DragDropFilesEx.Execute;
  2134. {the drag&drop operation is finished, so clean up the used drag image:}
  2135. GlobalDragImageList.EndDrag;
  2136. GlobalDragImageList.Clear;
  2137. Application.ProcessMessages;
  2138. DragDropFilesEx.FileList.Clear;
  2139. FContextMenu := False;
  2140. DropTarget := nil;
  2141. DropSourceControl := nil;
  2142. end;
  2143. end;
  2144. end;
  2145. procedure TCustomDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2146. begin
  2147. inherited;
  2148. if Operation = opRemove then
  2149. begin
  2150. if AComponent = PathLabel then FPathLabel := nil;
  2151. if AComponent = StatusBar then FStatusBar := nil;
  2152. if AComponent = PathComboBox then FPathComboBox := nil;
  2153. end;
  2154. end; { Notification }
  2155. procedure TCustomDirView.WndProc(var Message: TMessage);
  2156. begin
  2157. case Message.Msg of
  2158. WM_SETFOCUS, WM_KILLFOCUS:
  2159. UpdatePathLabel;
  2160. end;
  2161. inherited;
  2162. end; { WndProc }
  2163. function TCustomDirView.FindFileItem(FileName: string): TListItem;
  2164. type
  2165. TFileNameCompare = function(const S1, S2: string): Integer;
  2166. var
  2167. Index: Integer;
  2168. CompareFunc: TFileNameCompare;
  2169. begin
  2170. if FCaseSensitive then CompareFunc := CompareStr
  2171. else CompareFunc := CompareText;
  2172. begin
  2173. for Index := 0 to Items.Count - 1 do
  2174. if CompareFunc(FileName, ItemFileName(Items[Index])) = 0 then
  2175. begin
  2176. Result := Items[Index];
  2177. Exit;
  2178. end;
  2179. Result := nil;
  2180. end;
  2181. end;
  2182. procedure TCustomDirView.DoAnimation(Start: Boolean);
  2183. begin
  2184. if Start and LoadAnimation then
  2185. begin
  2186. if not Assigned(FAnimation) then
  2187. begin
  2188. FAnimation := TAnimate.Create(Self);
  2189. try
  2190. FAnimation.Top := (Height - FAnimation.Height) div 2;
  2191. FAnimation.Left := (Width - FAnimation.Width) div 2;
  2192. FAnimation.Parent := Self;
  2193. FAnimation.CommonAVI := aviFindFolder;
  2194. FAnimation.Transparent := True;
  2195. FAnimation.Active := True;
  2196. except
  2197. FreeAndNil(FAnimation);
  2198. end;
  2199. end;
  2200. end
  2201. else
  2202. if not Start then
  2203. FreeAndNil(FAnimation);
  2204. end; { DoAnimation }
  2205. function TCustomDirView.GetForwardCount: Integer;
  2206. begin
  2207. Result := FHistoryPaths.Count - BackCount;
  2208. end; { GetForwardCount }
  2209. function TCustomDirView.GetBackMenu: TPopupMenu;
  2210. begin
  2211. if not Assigned(FBackMenu) then
  2212. begin
  2213. FBackMenu := TPopupMenu.Create(Self);
  2214. UpdateHistoryMenu(hdBack);
  2215. end;
  2216. Result := FBackMenu;
  2217. end; { GetBackMenu }
  2218. function TCustomDirView.GetForwardMenu: TPopupMenu;
  2219. begin
  2220. if not Assigned(FForwardMenu) then
  2221. begin
  2222. FForwardMenu := TPopupMenu.Create(Self);
  2223. UpdateHistoryMenu(hdForward);
  2224. end;
  2225. Result := FForwardMenu;
  2226. end; { GetForwardMenu }
  2227. procedure TCustomDirView.HistoryItemClick(Sender: TObject);
  2228. begin
  2229. HistoryGo((Sender as TMenuItem).Tag);
  2230. end; { HistoryItemClick }
  2231. procedure TCustomDirView.LimitHistorySize;
  2232. begin
  2233. while FHistoryPaths.Count > MaxHistoryCount do
  2234. begin
  2235. if BackCount > 0 then
  2236. begin
  2237. FHistoryPaths.Delete(0);
  2238. Dec(FBackCount);
  2239. end
  2240. else
  2241. FHistoryPaths.Delete(FHistoryPaths.Count-1);
  2242. end;
  2243. end; { LimitHistorySize }
  2244. procedure TCustomDirView.UpdateHistoryMenu(Direction: THistoryDirection);
  2245. var
  2246. Menu: TPopupMenu;
  2247. ICount: Integer;
  2248. Index: Integer;
  2249. Factor: Integer;
  2250. Item: TMenuItem;
  2251. begin
  2252. if Direction = hdBack then
  2253. begin
  2254. Menu := BackMenu;
  2255. ICount := BackCount;
  2256. Factor := -1;
  2257. end
  2258. else
  2259. begin
  2260. Menu := ForwardMenu;
  2261. ICount := ForwardCount;
  2262. Factor := 1;
  2263. end;
  2264. if ICount > MaxHistoryMenuLen then ICount := MaxHistoryMenuLen;
  2265. if Assigned(Menu) then
  2266. with Menu.Items do
  2267. begin
  2268. Clear;
  2269. for Index := 1 to ICount do
  2270. begin
  2271. Item := TMenuItem.Create(Menu);
  2272. with Item do
  2273. begin
  2274. Caption := MinimizePath(HistoryPath[Index * Factor],
  2275. MaxHistoryMenuWidth);
  2276. Hint := HistoryPath[Index * Factor];
  2277. Tag := Index * Factor;
  2278. OnClick := HistoryItemClick;
  2279. end;
  2280. Add(Item);
  2281. end;
  2282. end;
  2283. end; { UpdateHistoryMenu }
  2284. function TCustomDirView.GetHistoryPath(Index: Integer): string;
  2285. begin
  2286. Assert(Assigned(FHistoryPaths));
  2287. if Index = 0 then Result := PathName
  2288. else
  2289. if Index < 0 then Result := FHistoryPaths[Index + BackCount]
  2290. else
  2291. if Index > 0 then Result := FHistoryPaths[Index + BackCount - 1];
  2292. end; { GetHistoryPath }
  2293. procedure TCustomDirView.SetMaxHistoryCount(Value: Integer);
  2294. begin
  2295. if FMaxHistoryCount <> Value then
  2296. begin
  2297. FMaxHistoryCount := Value;
  2298. DoHistoryChange;
  2299. end;
  2300. end; { SetMaxHistoryCount }
  2301. procedure TCustomDirView.SetMaxHistoryMenuLen(Value: Integer);
  2302. begin
  2303. if FMaxHistoryMenuLen <> Value then
  2304. begin
  2305. FMaxHistoryMenuLen := Value;
  2306. DoHistoryChange;
  2307. end;
  2308. end; { SetMaxHistoryMenuLen }
  2309. procedure TCustomDirView.SetMaxHistoryMenuWidth(Value: Integer);
  2310. begin
  2311. if FMaxHistoryMenuWidth <> Value then
  2312. begin
  2313. FMaxHistoryMenuWidth := Value;
  2314. DoHistoryChange;
  2315. end;
  2316. end; { SetMaxHistoryMenuWidth }
  2317. procedure TCustomDirView.DoHistoryChange;
  2318. begin
  2319. LimitHistorySize;
  2320. UpdateHistoryMenu(hdBack);
  2321. UpdateHistoryMenu(hdForward);
  2322. if Assigned(OnHistoryChange) then
  2323. OnHistoryChange(Self);
  2324. end; { DoHistoryChange }
  2325. procedure TCustomDirView.HistoryGo(Index: Integer);
  2326. begin
  2327. if Index <> 0 then
  2328. begin
  2329. FDontRecordPath := True;
  2330. try
  2331. Path := HistoryPath[Index];
  2332. finally
  2333. FDontRecordPath := False;
  2334. end;
  2335. FHistoryPaths.Insert(FBackCount, LastPath);
  2336. FHistoryPaths.Delete(Index + BackCount);
  2337. Inc(FBackCount, Index);
  2338. DoHistoryChange;
  2339. end;
  2340. end; { HistoryGo }
  2341. procedure TCustomDirView.PathChanged;
  2342. var
  2343. Index: Integer;
  2344. begin
  2345. UpdatePathComboBox;
  2346. if (not FDontRecordPath) and (LastPath <> '') and (LastPath <> PathName) then
  2347. begin
  2348. Assert(Assigned(FHistoryPaths));
  2349. for Index := FHistoryPaths.Count - 1 downto BackCount do
  2350. FHistoryPaths.Delete(Index);
  2351. FHistoryPaths.Add(LastPath);
  2352. Inc(FBackCount);
  2353. DoHistoryChange;
  2354. end;
  2355. end; { PathChanged }
  2356. procedure TCustomDirView.ProcessChangedFiles(DirView: TCustomDirView;
  2357. FileList: TStrings; FullPath: Boolean; ExistingOnly: Boolean;
  2358. Criterias: TCompareCriterias);
  2359. var
  2360. Item, MirrorItem: TListItem;
  2361. FileTime, MirrorFileTime: TDateTime;
  2362. OldCursor: TCursor;
  2363. Index: Integer;
  2364. Changed: Boolean;
  2365. SameTime: Boolean;
  2366. begin
  2367. Assert(Valid);
  2368. OldCursor := Screen.Cursor;
  2369. if not Assigned(FileList) then
  2370. begin
  2371. Items.BeginUpdate;
  2372. BeginSelectionUpdate;
  2373. end;
  2374. try
  2375. Screen.Cursor := crHourGlass;
  2376. for Index := 0 to Items.Count-1 do
  2377. begin
  2378. Item := Items[Index];
  2379. Changed := False;
  2380. if not ItemIsDirectory(Item) then
  2381. begin
  2382. MirrorItem := DirView.FindFileItem(ItemFileName(Item));
  2383. if MirrorItem = nil then
  2384. begin
  2385. Changed := not ExistingOnly;
  2386. end
  2387. else
  2388. begin
  2389. if ccTime in Criterias then
  2390. begin
  2391. FileTime := ItemFileTime(Item);
  2392. MirrorFileTime := DirView.ItemFileTime(MirrorItem);
  2393. UnifyDateTimePrecision(FileTime, MirrorFileTime);
  2394. Changed :=
  2395. (FileTime > MirrorFileTime) { or
  2396. ((FileTime = MirrorFileTime) and
  2397. (ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem))) };
  2398. SameTime := (FileTime = MirrorFileTime);
  2399. end
  2400. else
  2401. begin
  2402. SameTime := True;
  2403. end;
  2404. if (not Changed) and SameTime and (ccSize in Criterias) then
  2405. begin
  2406. Changed := ItemFileSize(Item) <> DirView.ItemFileSize(MirrorItem);
  2407. end
  2408. end;
  2409. end;
  2410. if Assigned(FileList) then
  2411. begin
  2412. if Changed then
  2413. begin
  2414. if FullPath then
  2415. begin
  2416. FileList.AddObject(ItemFullFileName(Item), Item.Data)
  2417. end
  2418. else
  2419. begin
  2420. FileList.AddObject(ItemFileName(Item), Item.Data);
  2421. end;
  2422. end;
  2423. end
  2424. else
  2425. begin
  2426. Item.Selected := Changed;
  2427. end;
  2428. end;
  2429. finally
  2430. Screen.Cursor := OldCursor;
  2431. if not Assigned(FileList) then
  2432. begin
  2433. Items.EndUpdate;
  2434. EndSelectionUpdate;
  2435. end;
  2436. end;
  2437. end;
  2438. function TCustomDirView.CreateChangedFileList(DirView: TCustomDirView;
  2439. FullPath: Boolean; ExistingOnly: Boolean; Criterias: TCompareCriterias): TStrings;
  2440. begin
  2441. Result := TStringList.Create;
  2442. try
  2443. ProcessChangedFiles(DirView, Result, FullPath, ExistingOnly, Criterias);
  2444. except
  2445. FreeAndNil(Result);
  2446. raise;
  2447. end;
  2448. end;
  2449. procedure TCustomDirView.CompareFiles(DirView: TCustomDirView;
  2450. ExistingOnly: Boolean; Criterias: TCompareCriterias);
  2451. begin
  2452. ProcessChangedFiles(DirView, nil, True, ExistingOnly, Criterias);
  2453. end;
  2454. procedure TCustomDirView.FocusSomething;
  2455. begin
  2456. if FSavedSelection then FPendingFocusSomething := True
  2457. else inherited;
  2458. end;
  2459. procedure TCustomDirView.SaveSelection;
  2460. var
  2461. Closest: TListItem;
  2462. begin
  2463. Assert(not FSavedSelection);
  2464. FSavedSelectionFile := '';
  2465. FSavedSelectionLastFile := '';
  2466. if Assigned(ItemFocused) then
  2467. begin
  2468. FSavedSelectionLastFile := ItemFocused.Caption;
  2469. end;
  2470. Closest := ClosestUnselected(ItemFocused);
  2471. if Assigned(Closest) then
  2472. begin
  2473. FSavedSelectionFile := Closest.Caption;
  2474. end;
  2475. FSavedSelection := True;
  2476. end;
  2477. procedure TCustomDirView.RestoreSelection;
  2478. var
  2479. ItemToSelect: TListItem;
  2480. begin
  2481. Assert(FSavedSelection);
  2482. FSavedSelection := False;
  2483. if (FSavedSelectionLastFile <> '') and
  2484. ((not Assigned(ItemFocused)) or
  2485. (ItemFocused.Caption <> FSavedSelectionLastFile)) then
  2486. begin
  2487. ItemToSelect := FindFileItem(FSavedSelectionFile);
  2488. if Assigned(ItemToSelect) then
  2489. begin
  2490. ItemFocused := ItemToSelect;
  2491. end;
  2492. end;
  2493. if not Assigned(ItemFocused) then FocusSomething
  2494. else ItemFocused.MakeVisible(False);
  2495. end;
  2496. procedure TCustomDirView.DiscardSavedSelection;
  2497. begin
  2498. Assert(FSavedSelection);
  2499. FSavedSelection := False;
  2500. if FPendingFocusSomething then
  2501. begin
  2502. FPendingFocusSomething := False;
  2503. FocusSomething;
  2504. end;
  2505. end;
  2506. var
  2507. DocPIDL: PItemIDList;
  2508. initialization
  2509. HasExtendedCOMCTL32 := COMCTL32OK;
  2510. DropSourceControl := nil;
  2511. SetLength(WinDir, MAX_PATH);
  2512. SetLength(WinDir, GetWindowsDirectory(PChar(WinDir), MAX_PATH));
  2513. SetLength(TempDir, MAX_PATH);
  2514. SetLength(TempDir, GetTempPath(MAX_PATH, PChar(TempDir)));
  2515. SetLength(UserDocumentDirectory, MAX_PATH);
  2516. SHGetSpecialFolderLocation(Application.Handle, CSIDL_PERSONAL, DocPIDL);
  2517. SHGetPathFromIDList(DocPIDL, PChar(UserDocumentDirectory));
  2518. SetLength(UserDocumentDirectory, StrLen(PChar(UserDocumentDirectory)));
  2519. UnknownFileIcon := GetshFileInfo('$#)(.#$)', FILE_ATTRIBUTE_NORMAL,
  2520. SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
  2521. DefaultExeIcon := GetshFileInfo('.COM',
  2522. FILE_ATTRIBUTE_NORMAL, SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES).iIcon;
  2523. with GetshFileInfo(WinDir, FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY,
  2524. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES) do
  2525. begin
  2526. StdDirTypeName := szTypeName;
  2527. StdDirIcon := iIcon;
  2528. end;
  2529. StdDirSelIcon := GetIconIndex(WinDir,
  2530. FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY, SHGFI_OPENICON);
  2531. WinDir := IncludeTrailingPathDelimiter(WinDir);
  2532. TempDir := IncludeTrailingPathDelimiter(TempDir);
  2533. finalization
  2534. SetLength(StdDirTypeName, 0);
  2535. SetLength(WinDir, 0);
  2536. SetLength(TempDir, 0);
  2537. end.