CustomDirView.pas 101 KB

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