NortonLikeListView.pas 34 KB

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