NortonLikeListView.pas 29 KB

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