CustomDirView.pas 90 KB

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