NortonLikeListView.pas 35 KB

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