NortonLikeListView.pas 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130
  1. unit NortonLikeListView;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5. ComCtrls, ListViewColProperties, CommCtrl, Menus;
  6. type
  7. TCustomNortonLikeListView = class;
  8. TSelectMode = (smAll, smNone, smInvert);
  9. TNortonLikeMode = (nlOn, nlOff, nlKeyboard);
  10. TSelectMethod = (smNoneYet, smMouse, smKeyboard);
  11. TCustomNortonLikeListView = class(TCustomListView)
  12. private
  13. { Private declarations }
  14. FColProperties: TCustomListViewColProperties;
  15. FDontSelectItem: Boolean;
  16. FDontUnSelectItem: Boolean;
  17. FSelCount: Integer;
  18. FNortonLike: TNortonLikeMode;
  19. FLastDeletedItem: TListItem; // aby sme nepocitali smazany item 2x
  20. FFocusingItem: Boolean;
  21. FManageSelection: Boolean;
  22. FForceUpdateOnItemUnfocus: Boolean;
  23. FFirstSelected: Integer;
  24. FLastSelected: Integer;
  25. FFocused: TDateTime;
  26. FIgnoreSetFocusFrom: THandle;
  27. FSelectingImplicitly: Boolean;
  28. FAnyAndAllSelectedImplicitly: Boolean;
  29. FLButtonDownShiftState: TShiftState;
  30. FLButtonDownPos: TPoint;
  31. FLastSelectMethod: TSelectMethod;
  32. procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  33. procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  34. procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  35. procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  36. procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  37. procedure WMChar(var Message: TWMChar); message WM_CHAR;
  38. procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  39. procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  40. procedure LVMEditLabel(var Message: TMessage); message LVM_EDITLABEL;
  41. procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  42. procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  43. procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  44. function GetMarkedCount: Integer;
  45. function GetMarkedFile: TListItem;
  46. procedure ItemSelected(Item: TListItem; Index: Integer);
  47. procedure ItemUnselected(Item: TListItem; Index: Integer);
  48. procedure SelectAll(Mode: TSelectMode; Exclude: TListItem); reintroduce; overload;
  49. protected
  50. { Protected declarations }
  51. FClearingItems: Boolean;
  52. FInsertingNewUnselectedItem: Boolean;
  53. FUpdatingSelection: Integer;
  54. FNextCharToIgnore: Word;
  55. FHeaderHandle: HWND;
  56. procedure CreateWnd; override;
  57. procedure DestroyWnd; override;
  58. procedure BeginSelectionUpdate; virtual;
  59. procedure EndSelectionUpdate; virtual;
  60. function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; virtual;
  61. procedure ClearItems; virtual;
  62. procedure ItemsReordered;
  63. procedure Delete(Item: TListItem); override;
  64. function ExCanChange(Item: TListItem; Change: Integer;
  65. NewState, OldState: Word): Boolean; dynamic;
  66. procedure InsertItem(Item: TListItem); override;
  67. function NewColProperties: TCustomListViewColProperties; virtual; abstract;
  68. procedure FocusSomething(ForceMakeVisible: Boolean); virtual;
  69. function EnableDragOnClick: Boolean; virtual;
  70. function GetItemFromHItem(const Item: TLVItem): TListItem;
  71. function GetValid: Boolean; virtual;
  72. function GetSelCount: Integer; override;
  73. procedure DDBeforeDrag;
  74. function CanEdit(Item: TListItem): Boolean; override;
  75. function GetPopupMenu: TPopupMenu; override;
  76. procedure ChangeScale(M, D: Integer; isDpiChange: Boolean); override;
  77. procedure SetItemSelectedByIndex(Index: Integer; Select: Boolean);
  78. function GetItemSelectedByIndex(Index: Integer): Boolean;
  79. procedure MakeTopItem(Item: TListItem);
  80. public
  81. { Public declarations }
  82. constructor Create(AOwner: TComponent); override;
  83. destructor Destroy; override;
  84. function ClosestUnselected(Item: TListItem): TListItem;
  85. procedure SelectAll(Mode: TSelectMode); reintroduce; overload;
  86. procedure SelectCurrentItem(FocusNext: Boolean);
  87. function GetNextItem(StartItem: TListItem; Direction: TSearchDirection;
  88. States: TItemStates): TListItem;
  89. procedure MakeProgressVisible(Item: TListItem);
  90. procedure FocusItem(Item: TListItem);
  91. property ColProperties: TCustomListViewColProperties read FColProperties write FColProperties stored False;
  92. property MultiSelect default True;
  93. property NortonLike: TNortonLikeMode read FNortonLike write FNortonLike default nlOn;
  94. property MarkedCount: Integer read GetMarkedCount;
  95. property MarkedFile: TListItem read GetMarkedFile;
  96. property Valid: Boolean read GetValid;
  97. property LastSelectMethod: TSelectMethod read FLastSelectMethod;
  98. end;
  99. implementation
  100. uses
  101. PasTools, Types;
  102. { TCustomNortonLikeListView }
  103. constructor TCustomNortonLikeListView.Create(AOwner: TComponent);
  104. begin
  105. inherited Create(AOwner);
  106. FSelCount := 0;
  107. FFirstSelected := -1;
  108. FLastSelected := -1;
  109. FClearingItems := False;
  110. FInsertingNewUnselectedItem := False;
  111. MultiSelect := True;
  112. FDontSelectItem := False;
  113. FDontUnSelectItem := False;
  114. FNortonLike := nlOn;
  115. FColProperties := NewColProperties;
  116. FLastDeletedItem := nil;
  117. FUpdatingSelection := 0;
  118. FFocusingItem := False;
  119. FLastSelectMethod := smNoneYet;
  120. // On Windows Vista, native GetNextItem for selection stops working once we
  121. // disallow deselecting any item (see ExCanChange).
  122. // So we need to manage selection state ourselves
  123. // cannot use Win32MajorVersion as it is affected by compatibility mode and
  124. // the bug is present even in compatibility mode
  125. FManageSelection := IsVistaHard;
  126. FFocused := 0;
  127. FIgnoreSetFocusFrom := INVALID_HANDLE_VALUE;
  128. // On Windows 7 we have to force item update when it looses focus,
  129. // otherwise some remnants of focus rectangle remain
  130. // Doing the same on WinXP makes list view down from the item flicker,
  131. // so we avoid this there.
  132. // Not sure about Vista
  133. FForceUpdateOnItemUnfocus := IsWin7;
  134. FNextCharToIgnore := 0;
  135. end;
  136. destructor TCustomNortonLikeListView.Destroy;
  137. begin
  138. FColProperties.Free;
  139. inherited;
  140. end;
  141. procedure TCustomNortonLikeListView.ItemSelected(Item: TListItem; Index: Integer);
  142. begin
  143. Inc(FSelCount);
  144. if FSelectingImplicitly and (FSelCount = 1) then
  145. begin
  146. FAnyAndAllSelectedImplicitly := True;
  147. end
  148. else
  149. if not FSelectingImplicitly then
  150. begin
  151. FAnyAndAllSelectedImplicitly := False;
  152. end;
  153. if FManageSelection then
  154. begin
  155. if Index < 0 then
  156. Index := Item.Index;
  157. if FSelCount = 1 then
  158. begin
  159. Assert(FFirstSelected < 0);
  160. FFirstSelected := Index;
  161. Assert(FLastSelected < 0);
  162. FLastSelected := Index;
  163. end
  164. else
  165. begin
  166. // if reference is not assigned, do not assign it as we
  167. // cannot be sure that the item is actually first/last
  168. if (FFirstSelected >= 0) and (Index < FFirstSelected) then
  169. FFirstSelected := Index;
  170. if (FLastSelected >= 0) and (Index > FLastSelected) then
  171. FLastSelected := Index;
  172. end;
  173. end;
  174. end;
  175. procedure TCustomNortonLikeListView.ItemUnselected(Item: TListItem; Index: Integer);
  176. begin
  177. Dec(FSelCount);
  178. if (FSelCount = 0) or (not FSelectingImplicitly) then
  179. begin
  180. FAnyAndAllSelectedImplicitly := False;
  181. end;
  182. if FManageSelection then
  183. begin
  184. if Index < 0 then
  185. Index := Item.Index;
  186. if FFirstSelected = Index then
  187. begin
  188. if FSelCount = 1 then
  189. FFirstSelected := FLastSelected // may be -1
  190. else
  191. FFirstSelected := -1;
  192. end;
  193. if FLastSelected = Index then
  194. begin
  195. if FSelCount = 1 then
  196. FLastSelected := FFirstSelected // may be -1
  197. else
  198. FLastSelected := -1;
  199. end;
  200. end;
  201. end;
  202. procedure TCustomNortonLikeListView.Delete(Item: TListItem);
  203. var
  204. Index: Integer;
  205. begin
  206. if (FLastDeletedItem <> Item) and (not FClearingItems) then
  207. begin
  208. Index := Item.Index;
  209. if GetItemSelectedByIndex(Index) then
  210. ItemUnselected(Item, Index);
  211. if FManageSelection then
  212. begin
  213. if (FLastSelected >= 0) and (Index <= FLastSelected) then
  214. Dec(FLastSelected);
  215. if (FFirstSelected >= 0) and (Index <= FFirstSelected) then
  216. Dec(FFirstSelected);
  217. end;
  218. end;
  219. FLastDeletedItem := Item;
  220. inherited;
  221. FLastDeletedItem := nil;
  222. end;
  223. function TCustomNortonLikeListView.ExCanChange(Item: TListItem; Change: Integer;
  224. NewState, OldState: Word): Boolean;
  225. begin
  226. Assert(Assigned(Item));
  227. Result := True;
  228. if (Change = LVIF_STATE) and
  229. ((((OldState and LVIS_SELECTED) < (NewState and LVIS_SELECTED)) and
  230. (FDontSelectItem or (not CanChangeSelection(Item, True)))) or
  231. (((OldState and LVIS_SELECTED) > (NewState and LVIS_SELECTED)) and
  232. (FDontUnSelectItem or (not CanChangeSelection(Item, False))))) then
  233. begin
  234. if (OldState or LVIS_SELECTED) <> (NewState or LVIS_SELECTED) then
  235. begin
  236. ListView_SetItemState(Handle, Item.Index, NewState,
  237. (NewState or OldState) - LVIS_SELECTED);
  238. end;
  239. Result := False;
  240. end;
  241. end;
  242. function TCustomNortonLikeListView.CanChangeSelection(Item: TListItem;
  243. Select: Boolean): Boolean;
  244. begin
  245. Result := True;
  246. end;
  247. procedure TCustomNortonLikeListView.ClearItems;
  248. begin
  249. Items.BeginUpdate;
  250. try
  251. FClearingItems := True;
  252. Items.Clear;
  253. finally
  254. FSelCount := 0;
  255. if FManageSelection then
  256. begin
  257. FFirstSelected := -1;
  258. FLastSelected := -1;
  259. end;
  260. FClearingItems := False;
  261. Items.EndUpdate;
  262. end;
  263. end; { ClearItems }
  264. procedure TCustomNortonLikeListView.ItemsReordered;
  265. begin
  266. if FManageSelection then
  267. begin
  268. FFirstSelected := -1;
  269. FLastSelected := -1;
  270. end;
  271. end;
  272. function TCustomNortonLikeListView.ClosestUnselected(Item: TListItem): TListItem;
  273. var
  274. Index: Integer;
  275. begin
  276. if Assigned(Item) and (Item.Selected or ((NortonLike <> nlOff) and (SelCount = 0))) then
  277. begin
  278. Index := Item.Index + 1;
  279. while (Index < Items.Count) and GetItemSelectedByIndex(Index) do Inc(Index);
  280. if (Index >= Items.Count) or GetItemSelectedByIndex(Index) then
  281. begin
  282. Index := Item.Index - 1;
  283. while (Index >= 0) and GetItemSelectedByIndex(Index) do Dec(Index);
  284. end;
  285. if (Index >= 0) and (Index < Items.Count) and (not GetItemSelectedByIndex(Index)) then
  286. Result := Items[Index]
  287. else
  288. Result := nil;
  289. end
  290. else Result := Item;
  291. end;
  292. function TCustomNortonLikeListView.GetPopupMenu: TPopupMenu;
  293. begin
  294. // While editing pretend that we do not have a popup menu.
  295. // Otherwise Ctrl+V is swallowed by the TWinControl.CNKeyDown,
  296. // when it finds out (TWinControl.IsMenuKey) that there's a command with Ctrl+V shortcut in the list view context menu
  297. // (the "paste" file action)
  298. if IsEditing then
  299. begin
  300. Result := nil;
  301. end
  302. else
  303. begin
  304. Result := inherited;
  305. end;
  306. end;
  307. procedure TCustomNortonLikeListView.WMNotify(var Message: TWMNotify);
  308. var
  309. HDNotify: PHDNotify;
  310. begin
  311. if (FHeaderHandle <> 0) and (Message.NMHdr^.hWndFrom = FHeaderHandle) then
  312. begin
  313. HDNotify := PHDNotify(Message.NMHdr);
  314. // Disallow resizing of "invisible" (width=0) columns.
  315. // (We probably get only Unicode versions of the messages here as
  316. // controls are created as Unicode by VCL)
  317. case HDNotify.Hdr.code of
  318. HDN_BEGINTRACKA, HDN_TRACKA, HDN_BEGINTRACKW, HDN_TRACKW:
  319. if not ColProperties.Visible[HDNotify.Item] then
  320. begin
  321. Message.Result := 1;
  322. Exit;
  323. end;
  324. // We won't get here when user tries to resize the column by mouse,
  325. // as that's prevented above.
  326. // But we get here when other methods are used
  327. // (the only we know about atm is Ctrl-+ shortcut)
  328. // We are getting this notification also when control is being setup,
  329. // with mask including also other fields, not just HDI_WIDTH.
  330. // While it does not seem to hurt to swallow even those messages,
  331. // not sure it's good thing to do, so we swallow width-only messages only.
  332. // That's why there's "= HDI_WIDTH" not "and HDI_WIDTH <> 0".
  333. HDN_ITEMCHANGINGA, HDN_ITEMCHANGINGW:
  334. if (HDNotify.PItem.Mask = HDI_WIDTH) and
  335. (HDNotify.PItem.cxy <> 0) and
  336. (not ColProperties.Visible[HDNotify.Item]) then
  337. begin
  338. Message.Result := 1;
  339. Exit;
  340. end;
  341. end;
  342. end;
  343. inherited;
  344. end;
  345. procedure TCustomNortonLikeListView.DDBeforeDrag;
  346. begin
  347. FDontSelectItem := False;
  348. FDontUnSelectItem := False;
  349. end;
  350. procedure TCustomNortonLikeListView.CNNotify(var Message: TWMNotify);
  351. var
  352. Item: TListItem;
  353. begin
  354. with Message do
  355. case NMHdr^.code of
  356. LVN_ITEMCHANGING:
  357. with PNMListView(NMHdr)^ do
  358. begin
  359. Item := Items[iItem];
  360. if Valid and (not FClearingItems) and (Item <> FLastDeletedItem) and
  361. ((not CanChange(Item, uChanged)) or
  362. (not ExCanChange(Item, uChanged, uNewState, uOldState)))
  363. then
  364. begin
  365. Result := 1;
  366. end;
  367. end;
  368. LVN_ITEMCHANGED:
  369. begin
  370. with PNMListView(NMHdr)^ do
  371. begin
  372. Item := Items[iItem];
  373. if Valid and (not FClearingItems) and
  374. (uChanged = LVIF_STATE) and (Item <> FLastDeletedItem) then
  375. begin
  376. if FForceUpdateOnItemUnfocus and
  377. (NortonLike <> nlOff) and
  378. ((uOldState and LVIS_FOCUSED) > (uNewState and LVIS_FOCUSED)) then
  379. begin
  380. // force update, otherwise some remnants of focus rectangle remain
  381. Item.Update;
  382. end;
  383. if (uOldState and LVIS_SELECTED) <> (uNewState and LVIS_SELECTED) then
  384. begin
  385. if (uOldState and LVIS_SELECTED) <> 0 then
  386. begin
  387. ItemUnselected(Item, iItem);
  388. end
  389. else
  390. begin
  391. ItemSelected(Item, iItem);
  392. end;
  393. end;
  394. end;
  395. end;
  396. inherited;
  397. end;
  398. LVN_ENDLABELEDIT:
  399. begin
  400. FIgnoreSetFocusFrom := ListView_GetEditControl(Handle);
  401. inherited;
  402. end;
  403. else
  404. begin
  405. inherited;
  406. end;
  407. end;
  408. end;
  409. procedure TCustomNortonLikeListView.SelectCurrentItem(FocusNext: Boolean);
  410. var
  411. Item: TListItem;
  412. begin
  413. Item := ItemFocused;
  414. if Item = nil then Item := Items[0];
  415. Item.Selected := not Item.Selected;
  416. if FocusNext then
  417. begin
  418. SendMessage(Handle, WM_KEYDOWN, VK_DOWN, LongInt(0));
  419. end;
  420. end;
  421. procedure TCustomNortonLikeListView.WMKeyDown(var Message: TWMKeyDown);
  422. var
  423. PLastSelectMethod: TSelectMethod;
  424. PDontUnSelectItem: Boolean;
  425. PDontSelectItem: Boolean;
  426. begin
  427. FNextCharToIgnore := 0;
  428. if (NortonLike <> nlOff) and (Message.CharCode = VK_INSERT) then
  429. begin
  430. if Items.Count > 0 then
  431. begin
  432. PLastSelectMethod := FLastSelectMethod;
  433. FLastSelectMethod := smKeyboard;
  434. try
  435. SelectCurrentItem(True);
  436. finally
  437. FLastSelectMethod := PLastSelectMethod;
  438. end;
  439. Message.Result := 1;
  440. end;
  441. end
  442. else
  443. if Message.CharCode = VK_ADD then
  444. begin
  445. FNextCharToIgnore := Word('+');
  446. inherited;
  447. end
  448. else
  449. if Message.CharCode = VK_SUBTRACT then
  450. begin
  451. FNextCharToIgnore := Word('-');
  452. inherited;
  453. end
  454. else
  455. if Message.CharCode = VK_MULTIPLY then
  456. begin
  457. FNextCharToIgnore := Word('*');
  458. inherited;
  459. end
  460. else
  461. if (NortonLike <> nlOff) and (Message.CharCode in [VK_LEFT, VK_RIGHT]) and
  462. (ViewStyle = vsReport) and
  463. ((GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL) = 0) then
  464. begin
  465. if Items.Count > 0 then
  466. begin
  467. // do not focus item directly to make later selecting work
  468. if Message.CharCode = VK_LEFT then
  469. SendMessage(Handle, WM_KEYDOWN, VK_HOME, LongInt(0))
  470. else
  471. SendMessage(Handle, WM_KEYDOWN, VK_END, LongInt(0));
  472. end;
  473. Message.Result := 1;
  474. end
  475. else
  476. if (NortonLike <> nlOff) and (Message.CharCode = VK_SPACE) and
  477. ((KeyDataToShiftState(Message.KeyData) * [ssCtrl]) <> []) then
  478. begin
  479. // prevent Ctrl+Space landing in else branch below,
  480. // this can safely get processed by default handler as Ctrl+Space
  481. // toggles only focused item, not affecting others
  482. PLastSelectMethod := FLastSelectMethod;
  483. FLastSelectMethod := smKeyboard;
  484. try
  485. inherited;
  486. finally
  487. FLastSelectMethod := PLastSelectMethod;
  488. end;
  489. end
  490. else
  491. if (Message.CharCode in [VK_SPACE, VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT,
  492. VK_UP, VK_RIGHT, VK_DOWN, VK_SELECT]) then
  493. begin
  494. PLastSelectMethod := FLastSelectMethod;
  495. PDontSelectItem := FDontSelectItem;
  496. PDontUnSelectItem := FDontUnSelectItem;
  497. FLastSelectMethod := smKeyboard;
  498. FDontSelectItem := FDontSelectItem or
  499. ((NortonLike <> nlOff) and
  500. ((KeyDataToShiftState(Message.KeyData) * [ssShift]) = []));
  501. // Note that Space (selecting toggling) is processed by default handler for WM_CHAR,
  502. // otherwise the below condition would prevent unselection
  503. FDontUnSelectItem :=
  504. FDontUnSelectItem or
  505. (NortonLike = nlOn) or
  506. ((NortonLike = nlKeyboard) and (not FAnyAndAllSelectedImplicitly));
  507. try
  508. inherited;
  509. finally
  510. FDontSelectItem := PDontSelectItem;
  511. FDontUnSelectItem := PDontUnSelectItem;
  512. FLastSelectMethod := PLastSelectMethod;
  513. end;
  514. end
  515. else inherited;
  516. end;
  517. procedure TCustomNortonLikeListView.WMSysCommand(var Message: TWMSysCommand);
  518. begin
  519. // Ugly workaround to avoid Windows beeping when Alt+Grey +/- are pressed
  520. // (for (Us)Select File with Same Ext commands)
  521. // The same for Alt+Enter (for Properties)
  522. if (Message.CmdType = SC_KEYMENU) and
  523. ((Message.Key = Word('+')) or (Message.Key = Word('-')) or (Message.Key = VK_RETURN)) then
  524. begin
  525. Message.Result := 1;
  526. end
  527. else inherited;
  528. end;
  529. procedure TCustomNortonLikeListView.WMChar(var Message: TWMChar);
  530. var
  531. PLastSelectMethod: TSelectMethod;
  532. PDontUnSelectItem: Boolean;
  533. PDontSelectItem: Boolean;
  534. begin
  535. if Message.CharCode = FNextCharToIgnore then
  536. begin
  537. // ugly fix to avoid Windows beeping when these keys are processed by
  538. // WMKeyDown instead of here (WMChar)
  539. Message.Result := 1;
  540. end
  541. else
  542. if (NortonLike <> nlOff) and (Message.CharCode = Byte(' ')) then
  543. begin
  544. if (GetKeyState(VK_CONTROL) >= 0) then
  545. begin
  546. // If not handled in TCustomScpExplorerForm::DirViewKeyPress
  547. if not DoKeyPress(Message) then
  548. begin
  549. if Assigned(ItemFocused) then
  550. ItemFocused.Selected := not ItemFocused.Selected;
  551. end;
  552. end
  553. else inherited;
  554. end
  555. else
  556. begin
  557. PLastSelectMethod := FLastSelectMethod;
  558. PDontSelectItem := FDontSelectItem;
  559. PDontUnSelectItem := FDontUnSelectItem;
  560. FDontSelectItem := FDontSelectItem or (NortonLike <> nlOff);
  561. FLastSelectMethod := smKeyboard;
  562. FDontUnSelectItem :=
  563. FDontUnSelectItem or
  564. (NortonLike = nlOn) or
  565. ((NortonLike = nlKeyboard) and (not FAnyAndAllSelectedImplicitly));
  566. try
  567. inherited;
  568. finally
  569. FLastSelectMethod := PLastSelectMethod;
  570. FDontSelectItem := PDontSelectItem;
  571. FDontUnSelectItem := PDontUnSelectItem;
  572. end;
  573. end;
  574. FNextCharToIgnore := 0;
  575. end;
  576. procedure TCustomNortonLikeListView.FocusSomething(ForceMakeVisible: Boolean);
  577. var
  578. MakeVisible: Boolean;
  579. begin
  580. MakeVisible := ForceMakeVisible;
  581. if Valid and (Items.Count > 0) and not Assigned(ItemFocused) then
  582. begin
  583. MakeVisible := True;
  584. if (NortonLike <> nlOff) then
  585. begin
  586. SendMessage(Handle, WM_KEYDOWN, VK_DOWN, LongInt(0));
  587. end;
  588. if not Assigned(ItemFocused) then
  589. begin
  590. ItemFocused := Items[0];
  591. end;
  592. end;
  593. if MakeVisible and Assigned(ItemFocused) then
  594. begin
  595. ItemFocused.MakeVisible(False);
  596. end;
  597. end;
  598. function TCustomNortonLikeListView.EnableDragOnClick: Boolean;
  599. begin
  600. Result := (not FFocusingItem);
  601. end;
  602. procedure TCustomNortonLikeListView.FocusItem(Item: TListItem);
  603. var
  604. P: TPoint;
  605. PLastSelectMethod: TSelectMethod;
  606. PDontUnSelectItem: Boolean;
  607. PDontSelectItem: Boolean;
  608. WParam: UINT_PTR;
  609. LParam: INT_PTR;
  610. begin
  611. // This whole is replacement for mere ItemFocused := Item
  612. // because that does not reset some internal focused pointer,
  613. // causing subsequent Shift-Click selects range from the first item,
  614. // not from focused item.
  615. Item.MakeVisible(False);
  616. Assert(Focused);
  617. if Focused then
  618. begin
  619. P := Item.GetPosition;
  620. PLastSelectMethod := FLastSelectMethod;
  621. PDontSelectItem := FDontSelectItem;
  622. PDontUnSelectItem := FDontUnSelectItem;
  623. FLastSelectMethod := smNoneYet;
  624. FDontSelectItem := True;
  625. FDontUnSelectItem := True;
  626. FFocusingItem := True;
  627. try
  628. // HACK
  629. // WM_LBUTTONDOWN enters loop, waiting for WM_LBUTTONUP,
  630. // so we have to post it in advance to break the loop immediately
  631. // Without MK_CONTROL, if there are more items selected,
  632. // they won't get unselected on subsequent focus change
  633. // (with explorer-style selection).
  634. // And it also makes the click the least obtrusive, affecting the focused
  635. // file only.
  636. WParam := MK_LBUTTON or MK_CONTROL;
  637. LParam := MAKELPARAM(P.X, P.Y);
  638. PostMessage(Handle, WM_LBUTTONUP, WParam, LParam);
  639. SendMessage(Handle, WM_LBUTTONDOWN, WParam, LParam);
  640. finally
  641. FFocusingItem := False;
  642. FLastSelectMethod := PLastSelectMethod;
  643. FDontSelectItem := PDontSelectItem;
  644. FDontUnSelectItem := PDontUnSelectItem;
  645. end;
  646. end;
  647. if ItemFocused <> Item then
  648. ItemFocused := Item;
  649. end;
  650. // TListItem.Selected needs an index, which is expensively looked up.
  651. // If we know it already, avoid that loop up.
  652. procedure TCustomNortonLikeListView.SetItemSelectedByIndex(Index: Integer; Select: Boolean);
  653. var
  654. State: Integer;
  655. begin
  656. if Select then State := LVIS_SELECTED
  657. else State := 0;
  658. ListView_SetItemState(Handle, Index, State, LVIS_SELECTED);
  659. end;
  660. function TCustomNortonLikeListView.GetItemSelectedByIndex(Index: Integer): Boolean;
  661. begin
  662. Result := (ListView_GetItemState(Handle, Index, LVIS_SELECTED) and LVIS_SELECTED) <> 0;
  663. end;
  664. procedure TCustomNortonLikeListView.SelectAll(Mode: TSelectMode; Exclude: TListItem);
  665. var
  666. Index: Integer;
  667. Item: TListItem;
  668. NewState: Boolean;
  669. begin
  670. BeginSelectionUpdate;
  671. try
  672. // Setting/Querying selected state is expensive.
  673. // This optimization is important for call from TCustomNortonLikeListView.WMLButtonUp in nlKeyboard mode.
  674. if (Mode = smNone) and
  675. // If there are too many, plain iteration is more effective then using GetNextItem
  676. // (though that can be optimized too, by passing index in and out instead of an item pointer)
  677. (FSelCount < Items.Count div 4) then
  678. begin
  679. Item := GetNextItem(nil, sdAll, [isSelected]);
  680. while Assigned(Item) do
  681. begin
  682. if Item <> Exclude then
  683. Item.Selected := False;
  684. Item := GetNextItem(Item, sdAll, [isSelected]);
  685. end;
  686. end
  687. else
  688. begin
  689. for Index := 0 to Items.Count - 1 do
  690. begin
  691. Item := Items[Index];
  692. if Item <> Exclude then
  693. begin
  694. case Mode of
  695. smAll: NewState := True;
  696. smNone: NewState := False;
  697. smInvert: NewState := not GetItemSelectedByIndex(Index);
  698. else
  699. begin
  700. Assert(False);
  701. NewState := False;
  702. end;
  703. end;
  704. SetItemSelectedByIndex(Index, NewState);
  705. end;
  706. end;
  707. end;
  708. finally
  709. EndSelectionUpdate;
  710. end;
  711. end;
  712. procedure TCustomNortonLikeListView.SelectAll(Mode: TSelectMode);
  713. begin
  714. SelectAll(Mode, nil);
  715. end;
  716. procedure TCustomNortonLikeListView.WMLButtonDown(var Message: TWMLButtonDown);
  717. var
  718. PLastSelectMethod: TSelectMethod;
  719. PDontUnSelectItem: Boolean;
  720. PDontSelectItem: Boolean;
  721. PSelectingImplicitly: Boolean;
  722. SelectingImplicitly: Boolean;
  723. Shift: TShiftState;
  724. Item: TListItem;
  725. begin
  726. Shift := KeysToShiftState(Message.Keys);
  727. PLastSelectMethod := FLastSelectMethod;
  728. PDontSelectItem := FDontSelectItem;
  729. PDontUnSelectItem := FDontUnSelectItem;
  730. PSelectingImplicitly := FSelectingImplicitly;
  731. FLastSelectMethod := smMouse;
  732. FDontSelectItem := FDontSelectItem or ((NortonLike = nlOn) and ((Shift * [ssCtrl, ssShift]) = []));
  733. FDontUnSelectItem := FDontUnSelectItem or ((NortonLike = nlOn) and ((Shift * [ssCtrl]) = []));
  734. SelectingImplicitly := ((Shift * [ssCtrl, ssShift]) = []);
  735. if SelectingImplicitly and (NortonLike = nlKeyboard) then
  736. begin
  737. // in general, when clicking, we clear selection only after mouse button is released,
  738. // from within WMLButtonUp, so we know we are not starting dragging,
  739. // so we do not want to clear the selection.
  740. // on the other hand, when clicking outside of the selection,
  741. // we want to explicitly clear the selection, no matter what
  742. Item := GetItemAt(Message.XPos, Message.YPos);
  743. if (Item = nil) or (not Item.Selected) then
  744. SelectAll(smNone);
  745. end;
  746. FSelectingImplicitly := FSelectingImplicitly or SelectingImplicitly;
  747. FLButtonDownShiftState := Shift;
  748. FLButtonDownPos := Point(Message.XPos, Message.YPos);
  749. try
  750. inherited;
  751. finally
  752. FLastSelectMethod := PLastSelectMethod;
  753. FDontSelectItem := PDontSelectItem;
  754. FDontUnSelectItem := PDontUnSelectItem;
  755. FSelectingImplicitly := PSelectingImplicitly;
  756. end;
  757. end;
  758. procedure TCustomNortonLikeListView.WMRButtonDown(var Message: TWMRButtonDown);
  759. var
  760. PLastSelectMethod: TSelectMethod;
  761. PDontUnSelectItem: Boolean;
  762. PDontSelectItem: Boolean;
  763. PSelectingImplicitly: Boolean;
  764. SelectingImplicitly: Boolean;
  765. Shift: TShiftState;
  766. begin
  767. Shift := KeysToShiftState(Message.Keys);
  768. PLastSelectMethod := FLastSelectMethod;
  769. PDontSelectItem := FDontSelectItem;
  770. PDontUnSelectItem := FDontUnSelectItem;
  771. PSelectingImplicitly := FSelectingImplicitly;
  772. FLastSelectMethod := smMouse;
  773. FDontSelectItem := FDontSelectItem or (NortonLike = nlOn);
  774. FDontUnSelectItem := FDontUnSelectItem or (NortonLike = nlOn);
  775. SelectingImplicitly := ((Shift * [ssCtrl, ssShift]) = []);
  776. // TODO unselect all when clicking outside of selection
  777. // (is not done automatically when focused item is not selected)
  778. FSelectingImplicitly := FSelectingImplicitly or SelectingImplicitly;
  779. try
  780. inherited;
  781. finally
  782. FLastSelectMethod := PLastSelectMethod;
  783. FDontSelectItem := PDontSelectItem;
  784. FDontUnSelectItem := PDontUnSelectItem;
  785. FSelectingImplicitly := PSelectingImplicitly;
  786. end;
  787. end;
  788. procedure TCustomNortonLikeListView.WMLButtonUp(var Message: TWMLButtonUp);
  789. var
  790. SelectingImplicitly: Boolean;
  791. Shift: TShiftState;
  792. begin
  793. // Workaround
  794. // For some reason Message.Keys is always 0 here,
  795. // so we use shift state from the LButtonDown as a workaround
  796. Shift := KeysToShiftState(Message.Keys);
  797. SelectingImplicitly :=
  798. ((Shift * [ssCtrl, ssShift]) = []) and
  799. ((FLButtonDownShiftState * [ssCtrl, ssShift]) = []);
  800. if SelectingImplicitly and (csClicked in ControlState) and
  801. (Abs(FLButtonDownPos.X - Message.XPos) <= 4) and
  802. (Abs(FLButtonDownPos.Y - Message.YPos) <= 4) then
  803. begin
  804. SelectAll(smNone, ItemFocused);
  805. // Because condition in ItemSelected is not triggered as we first select
  806. // the new item and then unselect the previous.
  807. // This probably means that we can get rid of the code in ItemSelected.
  808. FAnyAndAllSelectedImplicitly := True;
  809. end;
  810. inherited;
  811. end;
  812. function TCustomNortonLikeListView.GetMarkedFile: TListItem;
  813. begin
  814. if Assigned(Selected) then Result := Selected
  815. else
  816. if Assigned(ItemFocused) and (NortonLike <> nlOff) then Result := ItemFocused
  817. else Result := nil;
  818. end;
  819. function TCustomNortonLikeListView.GetNextItem(StartItem: TListItem;
  820. Direction: TSearchDirection; States: TItemStates): TListItem;
  821. var
  822. Start, Index, First, Last: Integer;
  823. begin
  824. if not FManageSelection then
  825. begin
  826. Result := inherited GetNextItem(StartItem, Direction, States);
  827. end
  828. else
  829. begin
  830. Assert(Direction = sdAll);
  831. if States = [isSelected] then
  832. begin
  833. if FSelCount = 0 then
  834. begin
  835. Result := nil
  836. end
  837. else
  838. if (not Assigned(StartItem)) and (FFirstSelected >= 0) then
  839. begin
  840. Result := Items[FFirstSelected]
  841. end
  842. else
  843. begin
  844. if Assigned(StartItem) then
  845. Start := StartItem.Index
  846. else
  847. Start := -1;
  848. if (FFirstSelected >= 0) and (Start < FFirstSelected) then
  849. First := FFirstSelected
  850. else
  851. First := Start + 1;
  852. if FLastSelected >= 0 then
  853. Last := FLastSelected
  854. else
  855. Last := Items.Count - 1;
  856. if Start > Last then
  857. begin
  858. Result := nil;
  859. end
  860. else
  861. begin
  862. Index := First;
  863. while (Index <= Last) and (not GetItemSelectedByIndex(Index)) do
  864. begin
  865. Inc(Index);
  866. end;
  867. if Index > Last then
  868. begin
  869. Result := nil;
  870. if (Start >= 0) and GetItemSelectedByIndex(Start) then
  871. begin
  872. Assert((FLastSelected < 0) or (FLastSelected = Start));
  873. FLastSelected := Start;
  874. end;
  875. end
  876. else
  877. begin
  878. Result := Items[Index];
  879. Assert(GetItemSelectedByIndex(Index));
  880. if not Assigned(StartItem) then
  881. begin
  882. Assert((FFirstSelected < 0) or (FFirstSelected = Index));
  883. FFirstSelected := Index;
  884. end;
  885. end;
  886. end;
  887. end;
  888. end
  889. else
  890. if States = [isCut] then
  891. begin
  892. Result := inherited GetNextItem(StartItem, Direction, States);
  893. end
  894. else
  895. if States = [] then
  896. begin
  897. if Assigned(StartItem) then
  898. Start := StartItem.Index
  899. else
  900. Start := -1;
  901. Inc(Start);
  902. if Start < Items.Count then
  903. Result := Items[Start]
  904. else
  905. Result := nil;
  906. end
  907. else
  908. begin
  909. Assert(False);
  910. Result := nil;
  911. end;
  912. end;
  913. end;
  914. function TCustomNortonLikeListView.GetSelCount: Integer;
  915. begin
  916. Result := FSelCount;
  917. end;
  918. procedure TCustomNortonLikeListView.InsertItem(Item: TListItem);
  919. begin
  920. inherited;
  921. if (not FInsertingNewUnselectedItem) and // Optimization to avoid expensive Item.Selected
  922. Item.Selected then
  923. begin
  924. ItemSelected(Item, -1);
  925. end;
  926. end;
  927. function TCustomNortonLikeListView.GetItemFromHItem(const Item: TLVItem): TListItem;
  928. begin
  929. with Item do
  930. if (state and LVIF_PARAM) <> 0 then Result := Pointer(lParam)
  931. else Result := Items[iItem];
  932. end;
  933. function TCustomNortonLikeListView.GetMarkedCount: Integer;
  934. begin
  935. if (SelCount > 0) or (NortonLike = nlOff) then Result := SelCount
  936. else
  937. if Assigned(ItemFocused) then Result := 1
  938. else Result := 0;
  939. end;
  940. function TCustomNortonLikeListView.GetValid: Boolean;
  941. begin
  942. // Note that TCustomDirView::GetValid don't inherit
  943. // this method because of optimalization
  944. Result := (not (csDestroying in ComponentState)) and (not FClearingItems);
  945. end;
  946. procedure TCustomNortonLikeListView.BeginSelectionUpdate;
  947. begin
  948. // Higher value is probably some nesting error
  949. Assert(FUpdatingSelection in [0..4]);
  950. Inc(FUpdatingSelection);
  951. end; { BeginUpdatingSelection }
  952. procedure TCustomNortonLikeListView.EndSelectionUpdate;
  953. begin
  954. Assert(FUpdatingSelection > 0);
  955. Dec(FUpdatingSelection);
  956. end; { EndUpdatingSelection }
  957. procedure TCustomNortonLikeListView.WMNCDestroy(var Message: TWMNCDestroy);
  958. begin
  959. // VCLCOPY
  960. FHeaderHandle := 0;
  961. inherited;
  962. end;
  963. procedure TCustomNortonLikeListView.CreateWnd;
  964. begin
  965. try
  966. Assert(ColProperties <> nil);
  967. inherited;
  968. // VCL gets the handle from WM_CREATE
  969. FHeaderHandle := ListView_GetHeader(Handle);
  970. ColProperties.ListViewWndCreated;
  971. finally
  972. end;
  973. end;
  974. procedure TCustomNortonLikeListView.DestroyWnd;
  975. begin
  976. ColProperties.ListViewWndDestroying;
  977. try
  978. inherited;
  979. finally
  980. ColProperties.ListViewWndDestroyed;
  981. end;
  982. end;
  983. procedure TCustomNortonLikeListView.LVMEditLabel(var Message: TMessage);
  984. begin
  985. // explicitly requesting editing (e.g. F2),
  986. // so we do not care anymore when the view was focused
  987. FFocused := 0;
  988. inherited;
  989. end;
  990. function TCustomNortonLikeListView.CanEdit(Item: TListItem): Boolean;
  991. var
  992. N: TDateTime;
  993. Delta: Double;
  994. begin
  995. N := Now;
  996. Result := inherited CanEdit(Item);
  997. if Result and (FFocused > 0) then
  998. begin
  999. Delta := N - FFocused;
  1000. // it takes little more than 500ms to trigger editing after click
  1001. Result := Delta > (750.0/MSecsPerDay);
  1002. end;
  1003. FFocused := 0;
  1004. end;
  1005. procedure TCustomNortonLikeListView.WMSetFocus(var Message: TWMSetFocus);
  1006. begin
  1007. inherited;
  1008. if Message.FocusedWnd <> FIgnoreSetFocusFrom then
  1009. FFocused := Now;
  1010. end;
  1011. procedure TCustomNortonLikeListView.CMWantSpecialKey(var Message: TCMWantSpecialKey);
  1012. begin
  1013. inherited;
  1014. if IsEditing and (Message.CharCode = VK_TAB) then
  1015. Message.Result := 1;
  1016. end;
  1017. procedure TCustomNortonLikeListView.MakeTopItem(Item: TListItem);
  1018. begin
  1019. Scroll(0, Item.Top - TopItem.Top);
  1020. end;
  1021. procedure TCustomNortonLikeListView.MakeProgressVisible(Item: TListItem);
  1022. var
  1023. DisplayRect: TRect;
  1024. begin
  1025. if ViewStyle = vsReport then
  1026. begin
  1027. DisplayRect := Item.DisplayRect(drBounds);
  1028. if DisplayRect.Bottom > ClientHeight then
  1029. begin
  1030. MakeTopItem(Item);
  1031. end;
  1032. end;
  1033. Item.MakeVisible(False);
  1034. end;
  1035. procedure TCustomNortonLikeListView.ChangeScale(M, D: Integer; isDpiChange: Boolean);
  1036. begin
  1037. if M <> D then
  1038. begin
  1039. // When font is scaled, while the control is being re-created, previous font is restored once
  1040. // read from the persistence data in TCustomListView.CreateWnd.
  1041. // Requiring handle, makes sure the re-create phase is closed.
  1042. // We could limit impact by checking ControlHasRecreationPersistenceData,
  1043. // but for now, we actually prefer larger impact to test this change better.
  1044. HandleNeeded;
  1045. end;
  1046. inherited;
  1047. end;
  1048. end.