NortonLikeListView.pas 31 KB

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