NortonLikeListView.pas 31 KB

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