CustomDirView.pas 100 KB

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