CustomDirView.pas 88 KB

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