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