CustomDirView.pas 100 KB

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