NortonLikeListView.pas 31 KB

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