CustomDirView.pas 100 KB

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