NortonLikeListView.pas 28 KB

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