NortonLikeListView.pas 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859
  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. TSelectByMaskEvent = procedure(Control: TCustomNortonLikeListView; Select: Boolean) of object;
  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. FOnSelectByMask: TSelectByMaskEvent;
  20. FLastDeletedItem: TListItem; // aby sme nepocitali smazany item 2x
  21. FFocusingItem: Boolean;
  22. FManageSelection: Boolean;
  23. FFirstSelected: Integer;
  24. FLastSelected: Integer;
  25. FFocused: TDateTime;
  26. FIgnoreSetFocusFrom: THandle;
  27. procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  28. procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  29. procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  30. procedure WMChar(var Message: TWMChar); message WM_CHAR;
  31. procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  32. procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  33. procedure LVMEditLabel(var Message: TMessage); message LVM_EDITLABEL;
  34. procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  35. procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  36. function GetMarkedCount: Integer;
  37. function GetMarkedFile: TListItem;
  38. procedure ItemSelected(Item: TListItem; Index: Integer);
  39. procedure ItemUnselected(Item: TListItem; Index: Integer);
  40. protected
  41. { Protected declarations }
  42. FClearingItems: Boolean;
  43. FUpdatingSelection: Integer;
  44. procedure CreateWnd; override;
  45. procedure BeginSelectionUpdate; virtual;
  46. procedure EndSelectionUpdate; virtual;
  47. function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; virtual;
  48. procedure ClearItems; virtual;
  49. procedure ItemsReordered;
  50. procedure ColRightClick(Column: TListColumn; Point: TPoint); override;
  51. procedure Delete(Item: TListItem); override;
  52. function DoSelectByMask(Select: Boolean): Boolean; virtual;
  53. function ExCanChange(Item: TListItem; Change: Integer;
  54. NewState, OldState: Word): Boolean; dynamic;
  55. procedure InsertItem(Item: TListItem); override;
  56. function NewColProperties: TCustomListViewColProperties; virtual;
  57. procedure FocusSomething; virtual;
  58. function EnableDragOnClick: Boolean; virtual;
  59. procedure FocusItem(Item: TListItem);
  60. function GetItemFromHItem(const Item: TLVItem): TListItem;
  61. function GetValid: Boolean; virtual;
  62. function GetSelCount: Integer; override;
  63. procedure DDBeforeDrag;
  64. function CanEdit(Item: TListItem): Boolean; override;
  65. public
  66. { Public declarations }
  67. constructor Create(AOwner: TComponent); override;
  68. destructor Destroy; override;
  69. function ClosestUnselected(Item: TListItem): TListItem;
  70. procedure SelectAll(Mode: TSelectMode); reintroduce;
  71. procedure SelectCurrentItem(FocusNext: Boolean);
  72. function GetNextItem(StartItem: TListItem; Direction: TSearchDirection;
  73. States: TItemStates): TListItem;
  74. property ColProperties: TCustomListViewColProperties read FColProperties write FColProperties stored False;
  75. property MultiSelect default True;
  76. property NortonLike: TNortonLikeMode read FNortonLike write FNortonLike default nlOn;
  77. property OnSelectByMask: TSelectByMaskEvent read FOnSelectByMask write FOnSelectByMask;
  78. property MarkedCount: Integer read GetMarkedCount;
  79. property MarkedFile: TListItem read GetMarkedFile;
  80. property Valid: Boolean read GetValid;
  81. end;
  82. type
  83. TNortonLikeListView = class(TCustomNortonLikeListView)
  84. published
  85. { Published declarations }
  86. property Align;
  87. property AllocBy;
  88. property Anchors;
  89. property BiDiMode;
  90. property BorderStyle;
  91. property BorderWidth;
  92. property Checkboxes;
  93. property Color;
  94. property ColumnClick;
  95. property Constraints;
  96. property Ctl3D;
  97. property Enabled;
  98. property Font;
  99. property FlatScrollBars;
  100. property FullDrag;
  101. property GridLines;
  102. property HideSelection;
  103. property HotTrack;
  104. property HotTrackStyles;
  105. property IconOptions;
  106. property Items;
  107. property LargeImages;
  108. property ReadOnly;
  109. property RowSelect;
  110. property ParentBiDiMode;
  111. property ParentColor;
  112. property ParentFont;
  113. property ParentShowHint;
  114. property PopupMenu;
  115. property ShowColumnHeaders;
  116. property ShowHint;
  117. property SmallImages;
  118. property StateImages;
  119. property TabOrder;
  120. property TabStop;
  121. property ViewStyle;
  122. property Visible;
  123. property OnChange;
  124. property OnChanging;
  125. property OnClick;
  126. property OnColumnClick;
  127. property OnCustomDraw;
  128. property OwnerDraw;
  129. property OnCustomDrawItem;
  130. property OnCustomDrawSubItem;
  131. property OwnerData;
  132. property OnGetImageIndex;
  133. property OnCompare;
  134. property OnData;
  135. property OnDataFind;
  136. property OnDataHint;
  137. property OnDataStateChange;
  138. property OnDblClick;
  139. property OnDeletion;
  140. property OnDrawItem;
  141. property OnEdited;
  142. property OnEditing;
  143. property OnEndDock;
  144. property OnEnter;
  145. property OnExit;
  146. property OnInsert;
  147. property OnKeyDown;
  148. property OnKeyPress;
  149. property OnKeyUp;
  150. property OnMouseDown;
  151. property OnMouseMove;
  152. property OnMouseUp;
  153. property OnResize;
  154. property OnStartDock;
  155. property OnSelectItem;
  156. property NortonLike;
  157. property OnSelectByMask;
  158. property ColProperties;
  159. end;
  160. procedure Register;
  161. implementation
  162. uses
  163. PasTools;
  164. procedure Register;
  165. begin
  166. RegisterComponents('Martin', [TNortonLikeListView]);
  167. end;
  168. { TCustomNortonLikeListView }
  169. constructor TCustomNortonLikeListView.Create(AOwner: TComponent);
  170. begin
  171. inherited Create(AOwner);
  172. FSelCount := 0;
  173. FFirstSelected := -1;
  174. FLastSelected := -1;
  175. FClearingItems := False;
  176. MultiSelect := True;
  177. FDontSelectItem := False;
  178. FDontUnSelectItem := False;
  179. FNortonLike := nlOn;
  180. FColProperties := NewColProperties;
  181. FLastDeletedItem := nil;
  182. FUpdatingSelection := 0;
  183. FFocusingItem := False;
  184. // On Windows Vista, native GetNextItem for selection stops working once we
  185. // disallow deselecting any item (see ExCanChange).
  186. // So we need to manage selection state ourselves
  187. // cannot use Win32MajorVersion as it is affected by compatibility mode and
  188. // the bug is present even in compatibility mode
  189. FManageSelection := IsVista;
  190. FFocused := 0;
  191. FIgnoreSetFocusFrom := INVALID_HANDLE_VALUE;
  192. end;
  193. destructor TCustomNortonLikeListView.Destroy;
  194. begin
  195. FColProperties.Free;
  196. inherited;
  197. end;
  198. procedure TCustomNortonLikeListView.ItemSelected(Item: TListItem; Index: Integer);
  199. begin
  200. Inc(FSelCount);
  201. if FManageSelection then
  202. begin
  203. if Index < 0 then
  204. Index := Item.Index;
  205. if FSelCount = 1 then
  206. begin
  207. Assert(FFirstSelected < 0);
  208. FFirstSelected := Index;
  209. Assert(FLastSelected < 0);
  210. FLastSelected := Index;
  211. end
  212. else
  213. begin
  214. // if reference is not assigned, do not assign it as we
  215. // cannot be sure that the item is actually first/last
  216. if (FFirstSelected >= 0) and (Index < FFirstSelected) then
  217. FFirstSelected := Index;
  218. if (FLastSelected >= 0) and (Index > FLastSelected) then
  219. FLastSelected := Index;
  220. end;
  221. end;
  222. end;
  223. procedure TCustomNortonLikeListView.ItemUnselected(Item: TListItem; Index: Integer);
  224. begin
  225. Dec(FSelCount);
  226. if FManageSelection then
  227. begin
  228. if Index < 0 then
  229. Index := Item.Index;
  230. if FFirstSelected = Index then
  231. begin
  232. if FSelCount = 1 then
  233. FFirstSelected := FLastSelected // may be -1
  234. else
  235. FFirstSelected := -1;
  236. end;
  237. if FLastSelected = Index then
  238. begin
  239. if FSelCount = 1 then
  240. FLastSelected := FFirstSelected // may be -1
  241. else
  242. FLastSelected := -1;
  243. end;
  244. end;
  245. end;
  246. procedure TCustomNortonLikeListView.Delete(Item: TListItem);
  247. begin
  248. if (FLastDeletedItem <> Item) and Item.Selected then
  249. begin
  250. ItemUnselected(Item, -1);
  251. end;
  252. FLastDeletedItem := Item;
  253. inherited;
  254. FLastDeletedItem := nil;
  255. end;
  256. function TCustomNortonLikeListView.DoSelectByMask(Select: Boolean): Boolean;
  257. begin
  258. if Assigned(FOnSelectByMask) then
  259. begin
  260. FOnSelectByMask(Self, Select);
  261. Result := True;
  262. end
  263. else Result := False;
  264. end;
  265. function TCustomNortonLikeListView.ExCanChange(Item: TListItem; Change: Integer;
  266. NewState, OldState: Word): Boolean;
  267. begin
  268. Assert(Assigned(Item));
  269. Result := True;
  270. if (Change = LVIF_STATE) and
  271. ((((OldState and LVIS_SELECTED) < (NewState and LVIS_SELECTED)) and
  272. (FDontSelectItem or (not CanChangeSelection(Item, True)))) or
  273. (((OldState and LVIS_SELECTED) > (NewState and LVIS_SELECTED)) and
  274. (FDontUnSelectItem or (not CanChangeSelection(Item, False))))) then
  275. begin
  276. if (OldState or LVIS_SELECTED) <> (NewState or LVIS_SELECTED) then
  277. begin
  278. ListView_SetItemState(Handle, Item.Index, NewState,
  279. (NewState or OldState) - LVIS_SELECTED);
  280. end;
  281. Result := False;
  282. end;
  283. end;
  284. function TCustomNortonLikeListView.CanChangeSelection(Item: TListItem;
  285. Select: Boolean): Boolean;
  286. begin
  287. Result := True;
  288. end;
  289. procedure TCustomNortonLikeListView.ClearItems;
  290. begin
  291. Items.BeginUpdate;
  292. try
  293. FClearingItems := True;
  294. Items.Clear;
  295. finally
  296. FSelCount := 0;
  297. if FManageSelection then
  298. begin
  299. FFirstSelected := -1;
  300. FLastSelected := -1;
  301. end;
  302. FClearingItems := False;
  303. Items.EndUpdate;
  304. end;
  305. end; { ClearItems }
  306. procedure TCustomNortonLikeListView.ItemsReordered;
  307. begin
  308. if FManageSelection then
  309. begin
  310. FFirstSelected := -1;
  311. FLastSelected := -1;
  312. end;
  313. end;
  314. procedure TCustomNortonLikeListView.ColRightClick(Column: TListColumn; Point: TPoint);
  315. var
  316. HitInfo: TLVHitTestInfo;
  317. begin
  318. // Fix: Otherwise we get wrong column when view is horizontally scrolled
  319. HitInfo.pt := Point;
  320. if ListView_SubItemHitTest(Handle, @HitInfo) = 0 then
  321. Column := Columns[HitInfo.iSubItem];
  322. inherited ColRightClick(Column, Point);
  323. end;
  324. function TCustomNortonLikeListView.ClosestUnselected(Item: TListItem): TListItem;
  325. var
  326. Index: Integer;
  327. begin
  328. if Assigned(Item) and (Item.Selected or ((NortonLike <> nlOff) and (SelCount = 0))) then
  329. begin
  330. Index := Item.Index + 1;
  331. while (Index < Items.Count) and Items[Index].Selected do Inc(Index);
  332. if (Index >= Items.Count) or Items[Index].Selected then
  333. begin
  334. Index := Item.Index - 1;
  335. while (Index >= 0) and Items[Index].Selected do Dec(Index);
  336. end;
  337. if (Index >= 0) and (Index < Items.Count) and (not Items[Index].Selected) then
  338. Result := Items[Index]
  339. else
  340. Result := nil;
  341. end
  342. else Result := Item;
  343. end;
  344. procedure TCustomNortonLikeListView.WMNotify(var Message: TWMNotify);
  345. begin
  346. // disallow resizing of "invisible" (width=0) columns
  347. with PHDNotify(Message.NMHdr)^ do
  348. case Hdr.code of
  349. HDN_BEGINTRACK, HDN_TRACK, HDN_BEGINTRACKW, HDN_TRACKW:
  350. if not ColProperties.Visible[Item] then
  351. begin
  352. Message.Result := 1;
  353. Exit;
  354. end;
  355. end;
  356. inherited;
  357. end;
  358. procedure TCustomNortonLikeListView.DDBeforeDrag;
  359. begin
  360. FDontSelectItem := False;
  361. FDontUnSelectItem := False;
  362. end;
  363. procedure TCustomNortonLikeListView.CNNotify(var Message: TWMNotify);
  364. var
  365. Item: TListItem;
  366. begin
  367. with Message do
  368. case NMHdr^.code of
  369. LVN_ITEMCHANGING:
  370. with PNMListView(NMHdr)^ do
  371. begin
  372. Item := Items[iItem];
  373. if Valid and (not FClearingItems) and (Item <> FLastDeletedItem) and
  374. ((not CanChange(Item, uChanged)) or
  375. (not ExCanChange(Item, uChanged, uNewState, uOldState)))
  376. then
  377. begin
  378. Result := 1;
  379. end;
  380. end;
  381. LVN_ITEMCHANGED:
  382. begin
  383. with PNMListView(NMHdr)^ do
  384. begin
  385. Item := Items[iItem];
  386. if Valid and (not FClearingItems) and
  387. (uChanged = LVIF_STATE) and (Item <> FLastDeletedItem) and
  388. ((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. inherited;
  401. end;
  402. LVN_ENDLABELEDIT:
  403. begin
  404. FIgnoreSetFocusFrom := ListView_GetEditControl(Handle);
  405. inherited;
  406. end;
  407. else
  408. inherited;
  409. end;
  410. end;
  411. procedure TCustomNortonLikeListView.SelectCurrentItem(FocusNext: Boolean);
  412. var
  413. Item: TListItem;
  414. begin
  415. Item := ItemFocused;
  416. if Item = nil then Item := Items[0];
  417. Item.Selected := not Item.Selected;
  418. if FocusNext then
  419. begin
  420. SendMessage(Handle, WM_KEYDOWN, VK_DOWN, LongInt(0));
  421. end;
  422. end;
  423. procedure TCustomNortonLikeListView.WMKeyDown(var Message: TWMKeyDown);
  424. var
  425. PDontUnSelectItem: Boolean;
  426. PDontSelectItem: Boolean;
  427. begin
  428. if (NortonLike <> nlOff) and (Message.CharCode = VK_INSERT) then
  429. begin
  430. if Items.Count > 0 then
  431. begin
  432. SelectCurrentItem(True);
  433. Message.Result := 1;
  434. end;
  435. end
  436. else
  437. {if (NortonLike <> nlOff) and (Message.CharCode = VK_MULTIPLY) then
  438. begin
  439. SelectAll(smInvert)
  440. Message.Result := 1;
  441. end
  442. else }
  443. if (Message.CharCode = VK_ADD) or (Message.CharCode = VK_SUBTRACT) then
  444. begin
  445. if DoSelectByMask((Message.CharCode = VK_ADD)) then
  446. Message.Result := 1;
  447. end
  448. else
  449. if (NortonLike <> nlOff) and (Message.CharCode in [VK_LEFT, VK_RIGHT]) and
  450. (ViewStyle = vsReport) and
  451. ((GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL) = 0) then
  452. begin
  453. if Items.Count > 0 then
  454. begin
  455. // do not focus item directly to make later selecting work
  456. if Message.CharCode = VK_LEFT then
  457. SendMessage(Handle, WM_KEYDOWN, VK_HOME, LongInt(0))
  458. else
  459. SendMessage(Handle, WM_KEYDOWN, VK_END, LongInt(0));
  460. end;
  461. Message.Result := 1;
  462. end
  463. else
  464. if (Message.CharCode in [VK_SPACE, VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT,
  465. VK_UP, VK_RIGHT, VK_DOWN, VK_SELECT]) then
  466. begin
  467. PDontSelectItem := FDontSelectItem;
  468. PDontUnSelectItem := FDontUnSelectItem;
  469. FDontSelectItem := FDontSelectItem or
  470. ((NortonLike <> nlOff) and
  471. ((KeyDataToShiftState(Message.KeyData) * [ssShift]) = []));
  472. FDontUnSelectItem := FDontUnSelectItem or (NortonLike <> nlOff);
  473. try
  474. inherited;
  475. finally
  476. FDontSelectItem := PDontSelectItem;
  477. FDontUnSelectItem := PDontUnSelectItem;
  478. end;
  479. end
  480. else inherited;
  481. end;
  482. procedure TCustomNortonLikeListView.WMChar(var Message: TWMChar);
  483. var
  484. PDontUnSelectItem: Boolean;
  485. PDontSelectItem: Boolean;
  486. begin
  487. if Message.CharCode in [Word('+'), Word('-'), Word('*')] then
  488. begin
  489. // ugly fix to avoid Windows beeping when these keys are processed by
  490. // WMKeyDown instead of here (WMChar)
  491. Message.Result := 1;
  492. end
  493. else
  494. if (NortonLike <> nlOff) and (Message.CharCode = Byte(' ')) then
  495. begin
  496. if (GetKeyState(VK_CONTROL) >= 0) then
  497. begin
  498. if Assigned(ItemFocused) then
  499. ItemFocused.Selected := not ItemFocused.Selected;
  500. end
  501. else inherited;
  502. end
  503. else
  504. begin
  505. PDontSelectItem := FDontSelectItem;
  506. PDontUnSelectItem := FDontUnSelectItem;
  507. FDontSelectItem := FDontSelectItem or (NortonLike <> nlOff);
  508. FDontUnSelectItem := FDontUnSelectItem or (NortonLike <> nlOff);
  509. try
  510. inherited;
  511. finally
  512. FDontSelectItem := PDontSelectItem;
  513. FDontUnSelectItem := PDontUnSelectItem;
  514. end;
  515. end;
  516. end;
  517. procedure TCustomNortonLikeListView.FocusSomething;
  518. begin
  519. if Valid and (Items.Count > 0) and not Assigned(ItemFocused) then
  520. begin
  521. if (NortonLike <> nlOff) then SendMessage(Handle, WM_KEYDOWN, VK_DOWN, LongInt(0));
  522. if not Assigned(ItemFocused) then
  523. ItemFocused := Items[0];
  524. end;
  525. if Assigned(ItemFocused) then
  526. ItemFocused.MakeVisible(False);
  527. end;
  528. function TCustomNortonLikeListView.EnableDragOnClick: Boolean;
  529. begin
  530. Result := (not FFocusingItem);
  531. end;
  532. procedure TCustomNortonLikeListView.FocusItem(Item: TListItem);
  533. var
  534. P: TPoint;
  535. PDontUnSelectItem: Boolean;
  536. PDontSelectItem: Boolean;
  537. AParent: TWinControl;
  538. begin
  539. Item.MakeVisible(False);
  540. if Focused then
  541. begin
  542. P := Item.GetPosition;
  543. PDontSelectItem := FDontSelectItem;
  544. PDontUnSelectItem := FDontUnSelectItem;
  545. FDontSelectItem := True;
  546. FDontUnSelectItem := True;
  547. FFocusingItem := True;
  548. try
  549. AParent := Parent;
  550. P := ClientToScreen(P);
  551. while AParent.Parent <> nil do
  552. AParent := AParent.Parent;
  553. P := AParent.ScreenToClient(P);
  554. SendMessage(AParent.Handle, WM_LBUTTONDOWN, MK_LBUTTON, MAKELPARAM(P.X, P.Y));
  555. SendMessage(AParent.Handle, WM_LBUTTONUP, MK_LBUTTON, MAKELPARAM(P.X, P.Y));
  556. finally
  557. FFocusingItem := False;
  558. FDontSelectItem := PDontSelectItem;
  559. FDontUnSelectItem := PDontUnSelectItem;
  560. end;
  561. Assert(ItemFocused = Item);
  562. end;
  563. if ItemFocused <> Item then
  564. ItemFocused := Item;
  565. end;
  566. procedure TCustomNortonLikeListView.SelectAll(Mode: TSelectMode);
  567. var
  568. Index: Integer;
  569. Item: TListItem;
  570. begin
  571. BeginSelectionUpdate;
  572. try
  573. for Index := 0 to Items.Count - 1 do
  574. begin
  575. Item := Items[Index];
  576. case Mode of
  577. smAll: Item.Selected := True;
  578. smNone: Item.Selected := False;
  579. smInvert: Item.Selected := not Item.Selected;
  580. end;
  581. end;
  582. finally
  583. EndSelectionUpdate;
  584. end;
  585. end;
  586. procedure TCustomNortonLikeListView.WMLButtonDown(var Message: TWMLButtonDown);
  587. var
  588. PDontUnSelectItem: Boolean;
  589. PDontSelectItem: Boolean;
  590. Shift: TShiftState;
  591. begin
  592. Shift := KeysToShiftState(Message.Keys);
  593. PDontSelectItem := FDontSelectItem;
  594. PDontUnSelectItem := FDontUnSelectItem;
  595. FDontSelectItem := FDontSelectItem or ((NortonLike = nlOn) and ((Shift * [ssCtrl, ssShift]) = []));
  596. FDontUnSelectItem := FDontUnSelectItem or ((NortonLike = nlOn) and ((Shift * [ssCtrl]) = []));
  597. try
  598. inherited;
  599. finally
  600. FDontSelectItem := PDontSelectItem;
  601. FDontUnSelectItem := PDontUnSelectItem;
  602. end;
  603. end;
  604. procedure TCustomNortonLikeListView.WMRButtonDown(var Message: TWMRButtonDown);
  605. var
  606. PDontUnSelectItem: Boolean;
  607. PDontSelectItem: Boolean;
  608. begin
  609. PDontSelectItem := FDontSelectItem;
  610. PDontUnSelectItem := FDontUnSelectItem;
  611. FDontSelectItem := FDontSelectItem or (NortonLike = nlOn);
  612. FDontUnSelectItem := FDontUnSelectItem or (NortonLike = nlOn);
  613. try
  614. inherited;
  615. finally
  616. FDontSelectItem := PDontSelectItem;
  617. FDontUnSelectItem := PDontUnSelectItem;
  618. end;
  619. end;
  620. function TCustomNortonLikeListView.GetMarkedFile: TListItem;
  621. begin
  622. if Assigned(Selected) then Result := Selected
  623. else
  624. if Assigned(ItemFocused) and (NortonLike <> nlOff) then Result := ItemFocused
  625. else Result := nil;
  626. end;
  627. function TCustomNortonLikeListView.GetNextItem(StartItem: TListItem;
  628. Direction: TSearchDirection; States: TItemStates): TListItem;
  629. var
  630. Start, Index, First, Last: Integer;
  631. begin
  632. if not FManageSelection then
  633. begin
  634. Result := inherited GetNextItem(StartItem, Direction, States);
  635. end
  636. else
  637. begin
  638. Assert(Direction = sdAll);
  639. if States = [isSelected] then
  640. begin
  641. if FSelCount = 0 then
  642. begin
  643. Result := nil
  644. end
  645. else
  646. if (not Assigned(StartItem)) and (FFirstSelected >= 0) then
  647. begin
  648. Result := Items[FFirstSelected]
  649. end
  650. else
  651. begin
  652. if Assigned(StartItem) then
  653. Start := StartItem.Index
  654. else
  655. Start := -1;
  656. if (FFirstSelected >= 0) and (Start < FFirstSelected) then
  657. First := FFirstSelected
  658. else
  659. First := Start + 1;
  660. if FLastSelected >= 0 then
  661. Last := FLastSelected
  662. else
  663. Last := Items.Count - 1;
  664. if Start > Last then
  665. begin
  666. Result := nil;
  667. end
  668. else
  669. begin
  670. Index := First;
  671. while (Index <= Last) and (not (Items[Index].Selected)) do
  672. begin
  673. Inc(Index);
  674. end;
  675. if Index > Last then
  676. begin
  677. Result := nil;
  678. if Assigned(StartItem) and StartItem.Selected then
  679. begin
  680. Assert((FLastSelected < 0) or (FLastSelected = Start));
  681. FLastSelected := Start;
  682. end;
  683. end
  684. else
  685. begin
  686. Result := Items[Index];
  687. Assert(Result.Selected);
  688. if not Assigned(StartItem) then
  689. begin
  690. Assert((FFirstSelected < 0) or (FFirstSelected = Index));
  691. FFirstSelected := Index;
  692. end;
  693. end;
  694. end;
  695. end;
  696. end
  697. else
  698. if States = [isCut] then
  699. begin
  700. Result := inherited GetNextItem(StartItem, Direction, States);
  701. end
  702. else
  703. begin
  704. Assert(False);
  705. Result := nil;
  706. end;
  707. end;
  708. end;
  709. function TCustomNortonLikeListView.GetSelCount: Integer;
  710. begin
  711. Result := FSelCount;
  712. end;
  713. procedure TCustomNortonLikeListView.InsertItem(Item: TListItem);
  714. begin
  715. inherited;
  716. if Item.Selected then
  717. ItemSelected(Item, -1);
  718. end;
  719. function TCustomNortonLikeListView.NewColProperties: TCustomListViewColProperties;
  720. begin
  721. Result := TListViewColProperties.Create(Self, 5);
  722. end;
  723. function TCustomNortonLikeListView.GetItemFromHItem(const Item: TLVItem): TListItem;
  724. begin
  725. with Item do
  726. if (state and LVIF_PARAM) <> 0 then Result := Pointer(lParam)
  727. else Result := Items[iItem];
  728. end;
  729. function TCustomNortonLikeListView.GetMarkedCount: Integer;
  730. begin
  731. if (SelCount > 0) or (NortonLike = nlOff) then Result := SelCount
  732. else
  733. if Assigned(ItemFocused) then Result := 1
  734. else Result := 0;
  735. end;
  736. function TCustomNortonLikeListView.GetValid: Boolean;
  737. begin
  738. // Note that TCustomDirView::GetValid don't inherit
  739. // this method because of optimalization
  740. Result := (not (csDestroying in ComponentState)) and (not FClearingItems);
  741. end;
  742. procedure TCustomNortonLikeListView.BeginSelectionUpdate;
  743. begin
  744. // Higher value is probably some nesting error
  745. Assert(FUpdatingSelection in [0..4]);
  746. Inc(FUpdatingSelection);
  747. end; { BeginUpdatingSelection }
  748. procedure TCustomNortonLikeListView.EndSelectionUpdate;
  749. begin
  750. Assert(FUpdatingSelection > 0);
  751. Dec(FUpdatingSelection);
  752. end; { EndUpdatingSelection }
  753. procedure TCustomNortonLikeListView.CreateWnd;
  754. begin
  755. inherited;
  756. Assert(ColProperties <> nil);
  757. ColProperties.ListViewWndCreated;
  758. end;
  759. procedure TCustomNortonLikeListView.LVMEditLabel(var Message: TMessage);
  760. begin
  761. // explicitly requesting editing (e.g. F2),
  762. // so we do not care anymore when the view was focused
  763. FFocused := 0;
  764. inherited;
  765. end;
  766. function TCustomNortonLikeListView.CanEdit(Item: TListItem): Boolean;
  767. var
  768. N: TDateTime;
  769. Delta: Double;
  770. begin
  771. N := Now;
  772. Result := inherited CanEdit(Item);
  773. if Result and (FFocused > 0) then
  774. begin
  775. Delta := N - FFocused;
  776. // it takes little more than 500ms to trigger editing after click
  777. Result := Delta > (750.0/(24*60*60*1000));
  778. end;
  779. FFocused := 0;
  780. end;
  781. procedure TCustomNortonLikeListView.WMSetFocus(var Message: TWMSetFocus);
  782. begin
  783. inherited;
  784. if Message.FocusedWnd <> FIgnoreSetFocusFrom then
  785. FFocused := Now;
  786. end;
  787. procedure TCustomNortonLikeListView.CMWantSpecialKey(var Message: TCMWantSpecialKey);
  788. begin
  789. inherited;
  790. if IsEditing and (Message.CharCode = VK_TAB) then
  791. Message.Result := 1;
  792. end;
  793. end.