CustomDirView.pas 100 KB

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