CustomDirView.pas 96 KB

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