1
0

CustomDirView.pas 101 KB

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