NortonLikeListView.pas 31 KB

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