CustomDirView.pas 97 KB

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