CustomDirView.pas 101 KB

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