1
0

CustomDirView.pas 106 KB

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