NortonLikeListView.pas 32 KB

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