unit NortonLikeListView; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ListViewColProperties, CommCtrl, Menus; type TCustomNortonLikeListView = class; TSelectMode = (smAll, smNone, smInvert); TNortonLikeMode = (nlOn, nlOff, nlKeyboard); TSelectMethod = (smNoneYet, smMouse, smKeyboard); TCustomNortonLikeListView = class(TCustomListView) private { Private declarations } FColProperties: TCustomListViewColProperties; FDontSelectItem: Boolean; FDontUnSelectItem: Boolean; FSelCount: Integer; FNortonLike: TNortonLikeMode; FLastDeletedItem: TListItem; // aby sme nepocitali smazany item 2x FFocusingItem: Boolean; FManageSelection: Boolean; FForceUpdateOnItemUnfocus: Boolean; FFirstSelected: Integer; FLastSelected: Integer; FFocused: TDateTime; FIgnoreSetFocusFrom: THandle; FSelectingImplicitly: Boolean; FAnyAndAllSelectedImplicitly: Boolean; FLButtonDownShiftState: TShiftState; FLButtonDownPos: TPoint; FLastSelectMethod: TSelectMethod; FDarkMode: Boolean; procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; procedure WMChar(var Message: TWMChar); message WM_CHAR; procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY; procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY; procedure LVMEditLabel(var Message: TMessage); message LVM_EDITLABEL; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY; procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; function GetMarkedCount: Integer; function GetMarkedFile: TListItem; procedure ItemSelected(Item: TListItem; Index: Integer); procedure ItemUnselected(Item: TListItem; Index: Integer); procedure SelectAll(Mode: TSelectMode; Exclude: TListItem); reintroduce; overload; procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED; procedure SetDarkMode(Value: Boolean); protected { Protected declarations } FClearingItems: Boolean; FInsertingNewUnselectedItem: Boolean; FUpdatingSelection: Integer; FNextCharToIgnore: Word; FHeaderHandle: HWND; procedure CreateWnd; override; procedure DestroyWnd; override; procedure BeginSelectionUpdate; virtual; procedure EndSelectionUpdate; virtual; function CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; virtual; procedure ClearItems; virtual; procedure ItemsReordered; procedure Delete(Item: TListItem); override; function ExCanChange(Item: TListItem; Change: Integer; NewState, OldState: Word): Boolean; dynamic; procedure InsertItem(Item: TListItem); override; function NewColProperties: TCustomListViewColProperties; virtual; abstract; procedure FocusSomething(ForceMakeVisible: Boolean); virtual; function EnableDragOnClick: Boolean; virtual; function GetItemFromHItem(const Item: TLVItem): TListItem; function GetValid: Boolean; virtual; function GetSelCount: Integer; override; procedure DDBeforeDrag; function CanEdit(Item: TListItem): Boolean; override; function GetPopupMenu: TPopupMenu; override; procedure ChangeScale(M, D: Integer; isDpiChange: Boolean); override; procedure SetItemSelectedByIndex(Index: Integer; Select: Boolean); function GetItemSelectedByIndex(Index: Integer): Boolean; procedure MakeTopItem(Item: TListItem); procedure UpdateDarkMode; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ClosestUnselected(Item: TListItem): TListItem; procedure SelectAll(Mode: TSelectMode); reintroduce; overload; procedure SelectCurrentItem(FocusNext: Boolean); function GetNextItem(StartItem: TListItem; Direction: TSearchDirection; States: TItemStates): TListItem; procedure MakeProgressVisible(Item: TListItem); procedure FocusItem(Item: TListItem); function IsItemVisible(Item: TListItem): Boolean; property ColProperties: TCustomListViewColProperties read FColProperties write FColProperties stored False; property MultiSelect default True; property NortonLike: TNortonLikeMode read FNortonLike write FNortonLike default nlOn; property MarkedCount: Integer read GetMarkedCount; property MarkedFile: TListItem read GetMarkedFile; property Valid: Boolean read GetValid; property LastSelectMethod: TSelectMethod read FLastSelectMethod; property DarkMode: Boolean read FDarkMode write SetDarkMode; end; implementation uses PasTools, Types, Winapi.UxTheme; { TCustomNortonLikeListView } constructor TCustomNortonLikeListView.Create(AOwner: TComponent); begin inherited Create(AOwner); FSelCount := 0; FFirstSelected := -1; FLastSelected := -1; FClearingItems := False; FInsertingNewUnselectedItem := False; MultiSelect := True; FDontSelectItem := False; FDontUnSelectItem := False; FNortonLike := nlOn; FColProperties := NewColProperties; FLastDeletedItem := nil; FUpdatingSelection := 0; FFocusingItem := False; FLastSelectMethod := smNoneYet; // Since Windows Vista, native GetNextItem for selection stops working // once we disallow deselecting any item (see ExCanChange). // So we need to manage selection state ourselves // All supported Windows versions have the bug (last time tested on Windows 11 23H2 22631), // keeping the variable only as a way to tag all related code FManageSelection := True; FFocused := 0; FIgnoreSetFocusFrom := INVALID_HANDLE_VALUE; // On Windows 7 we have to force item update when it looses focus, // otherwise some remnants of focus rectangle remain // Doing the same on WinXP makes list view down from the item flicker, // so we avoid this there. // Not sure about Vista FForceUpdateOnItemUnfocus := IsWin7; FNextCharToIgnore := 0; FDarkMode := False; end; destructor TCustomNortonLikeListView.Destroy; begin FColProperties.Free; inherited; end; procedure TCustomNortonLikeListView.ItemSelected(Item: TListItem; Index: Integer); begin Inc(FSelCount); if FSelectingImplicitly and (FSelCount = 1) then begin FAnyAndAllSelectedImplicitly := True; end else if not FSelectingImplicitly then begin FAnyAndAllSelectedImplicitly := False; end; if FManageSelection then begin if Index < 0 then Index := Item.Index; if FSelCount = 1 then begin Assert(FFirstSelected < 0); FFirstSelected := Index; Assert(FLastSelected < 0); FLastSelected := Index; end else begin // if reference is not assigned, do not assign it as we // cannot be sure that the item is actually first/last if (FFirstSelected >= 0) and (Index < FFirstSelected) then FFirstSelected := Index; if (FLastSelected >= 0) and (Index > FLastSelected) then FLastSelected := Index; end; end; end; procedure TCustomNortonLikeListView.ItemUnselected(Item: TListItem; Index: Integer); begin Dec(FSelCount); if (FSelCount = 0) or (not FSelectingImplicitly) then begin FAnyAndAllSelectedImplicitly := False; end; if FManageSelection then begin if Index < 0 then Index := Item.Index; if FFirstSelected = Index then begin if FSelCount = 1 then FFirstSelected := FLastSelected // may be -1 else FFirstSelected := -1; end; if FLastSelected = Index then begin if FSelCount = 1 then FLastSelected := FFirstSelected // may be -1 else FLastSelected := -1; end; end; end; procedure TCustomNortonLikeListView.Delete(Item: TListItem); var Index: Integer; begin if (FLastDeletedItem <> Item) and (not FClearingItems) then begin Index := Item.Index; if GetItemSelectedByIndex(Index) then ItemUnselected(Item, Index); if FManageSelection then begin if (FLastSelected >= 0) and (Index <= FLastSelected) then Dec(FLastSelected); if (FFirstSelected >= 0) and (Index <= FFirstSelected) then Dec(FFirstSelected); end; end; FLastDeletedItem := Item; inherited; FLastDeletedItem := nil; end; function TCustomNortonLikeListView.ExCanChange(Item: TListItem; Change: Integer; NewState, OldState: Word): Boolean; begin Assert(Assigned(Item)); Result := True; if (Change = LVIF_STATE) and ((((OldState and LVIS_SELECTED) < (NewState and LVIS_SELECTED)) and (FDontSelectItem or (not CanChangeSelection(Item, True)))) or (((OldState and LVIS_SELECTED) > (NewState and LVIS_SELECTED)) and (FDontUnSelectItem or (not CanChangeSelection(Item, False))))) then begin if (OldState or LVIS_SELECTED) <> (NewState or LVIS_SELECTED) then begin ListView_SetItemState(Handle, Item.Index, NewState, (NewState or OldState) - LVIS_SELECTED); end; Result := False; end; end; function TCustomNortonLikeListView.CanChangeSelection(Item: TListItem; Select: Boolean): Boolean; begin Result := True; end; procedure TCustomNortonLikeListView.ClearItems; begin Items.BeginUpdate; try FClearingItems := True; Items.Clear; finally FSelCount := 0; if FManageSelection then begin FFirstSelected := -1; FLastSelected := -1; end; FClearingItems := False; Items.EndUpdate; end; end; { ClearItems } procedure TCustomNortonLikeListView.ItemsReordered; begin if FManageSelection then begin FFirstSelected := -1; FLastSelected := -1; end; end; function TCustomNortonLikeListView.ClosestUnselected(Item: TListItem): TListItem; var Index: Integer; begin if Assigned(Item) and (Item.Selected or ((NortonLike <> nlOff) and (SelCount = 0))) then begin Index := Item.Index + 1; while (Index < Items.Count) and GetItemSelectedByIndex(Index) do Inc(Index); if (Index >= Items.Count) or GetItemSelectedByIndex(Index) then begin Index := Item.Index - 1; while (Index >= 0) and GetItemSelectedByIndex(Index) do Dec(Index); end; if (Index >= 0) and (Index < Items.Count) and (not GetItemSelectedByIndex(Index)) then Result := Items[Index] else Result := nil; end else Result := Item; end; function TCustomNortonLikeListView.GetPopupMenu: TPopupMenu; begin // While editing pretend that we do not have a popup menu. // Otherwise Ctrl+V is swallowed by the TWinControl.CNKeyDown, // when it finds out (TWinControl.IsMenuKey) that there's a command with Ctrl+V shortcut in the list view context menu // (the "paste" file action) if IsEditing then begin Result := nil; end else begin Result := inherited; end; end; procedure TCustomNortonLikeListView.WMNotify(var Msg: TWMNotify); var HDNotify: PHDNotify; begin if (FHeaderHandle <> 0) and (Msg.NMHdr^.hWndFrom = FHeaderHandle) then begin HDNotify := PHDNotify(Msg.NMHdr); // Disallow resizing of "invisible" (width=0) columns. // (We probably get only Unicode versions of the messages here as // controls are created as Unicode by VCL) case HDNotify.Hdr.code of HDN_BEGINTRACKA, HDN_TRACKA, HDN_BEGINTRACKW, HDN_TRACKW: if not ColProperties.Visible[HDNotify.Item] then begin Msg.Result := 1; Exit; end; // We won't get here when user tries to resize the column by mouse, // as that's prevented above. // But we get here when other methods are used // (the only we know about atm is Ctrl-+ shortcut) // We are getting this notification also when control is being setup, // with mask including also other fields, not just HDI_WIDTH. // While it does not seem to hurt to swallow even those messages, // not sure it's good thing to do, so we swallow width-only messages only. // That's why there's "= HDI_WIDTH" not "and HDI_WIDTH <> 0". HDN_ITEMCHANGINGA, HDN_ITEMCHANGINGW: if (HDNotify.PItem.Mask = HDI_WIDTH) and (HDNotify.PItem.cxy <> 0) and (not ColProperties.Visible[HDNotify.Item]) then begin Msg.Result := 1; Exit; end; // This all is to make header text white in dark mode. NM_CUSTOMDRAW: if DarkMode and SupportsDarkMode and GetSysDarkTheme then // When system app theme is light, headers are not dark begin with PNMLVCustomDraw(Msg.NMHdr)^ do begin if nmcd.dwDrawStage = CDDS_PREPAINT then begin inherited; Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW; Exit; end else if nmcd.dwDrawStage = CDDS_ITEMPREPAINT then begin SetTextColor(nmcd.hdc, ColorToRGB(Font.Color)); Msg.Result := CDRF_DODEFAULT; end; end; end end; end; inherited; end; procedure TCustomNortonLikeListView.WMThemeChanged(var Msg: TMessage); begin if SupportsDarkMode then // To reduce impact begin UpdateDarkMode; RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); end; inherited; end; procedure TCustomNortonLikeListView.UpdateDarkMode; begin if SupportsDarkMode then // To reduce impact begin AllowDarkModeForWindow(Self, DarkMode); // To update scrollbar theme SendMessage(Handle, WM_THEMECHANGED, 0, 0); if FHeaderHandle <> 0 then begin AllowDarkModeForWindow(FHeaderHandle, DarkMode); // Needs to be sent explicitly (does not propagate from the above call) SendMessage(FHeaderHandle, WM_THEMECHANGED, 0, 0); end; end; end; procedure TCustomNortonLikeListView.SetDarkMode(Value: Boolean); begin if DarkMode <> Value then begin FDarkMode := Value; // Call only when switching to dark more and when switching back to the light mode. // But not for initial light mode - To reduce an impact of calling an undocumented function. if HandleAllocated then UpdateDarkMode; end; end; procedure TCustomNortonLikeListView.DDBeforeDrag; begin FDontSelectItem := False; FDontUnSelectItem := False; end; procedure TCustomNortonLikeListView.CNNotify(var Message: TWMNotify); var Item: TListItem; begin with Message do case NMHdr^.code of LVN_ITEMCHANGING: with PNMListView(NMHdr)^ do begin Item := Items[iItem]; if Valid and (not FClearingItems) and (Item <> FLastDeletedItem) and ((not CanChange(Item, uChanged)) or (not ExCanChange(Item, uChanged, uNewState, uOldState))) then begin Result := 1; end; end; LVN_ITEMCHANGED: begin with PNMListView(NMHdr)^ do begin Item := Items[iItem]; if Valid and (not FClearingItems) and (uChanged = LVIF_STATE) and (Item <> FLastDeletedItem) then begin if FForceUpdateOnItemUnfocus and (NortonLike <> nlOff) and ((uOldState and LVIS_FOCUSED) > (uNewState and LVIS_FOCUSED)) then begin // force update, otherwise some remnants of focus rectangle remain Item.Update; end; if (uOldState and LVIS_SELECTED) <> (uNewState and LVIS_SELECTED) then begin if (uOldState and LVIS_SELECTED) <> 0 then begin ItemUnselected(Item, iItem); end else begin ItemSelected(Item, iItem); end; end; end; end; inherited; end; LVN_ENDLABELEDIT: begin FIgnoreSetFocusFrom := ListView_GetEditControl(Handle); inherited; end; else begin inherited; end; end; end; procedure TCustomNortonLikeListView.SelectCurrentItem(FocusNext: Boolean); var Item: TListItem; begin Item := ItemFocused; if Item = nil then Item := Items[0]; Item.Selected := not Item.Selected; if FocusNext then begin SendMessage(Handle, WM_KEYDOWN, VK_DOWN, LongInt(0)); end; end; procedure TCustomNortonLikeListView.WMKeyDown(var Message: TWMKeyDown); var PLastSelectMethod: TSelectMethod; PDontUnSelectItem: Boolean; PDontSelectItem: Boolean; begin FNextCharToIgnore := 0; if (NortonLike <> nlOff) and (Message.CharCode = VK_INSERT) then begin if Items.Count > 0 then begin PLastSelectMethod := FLastSelectMethod; FLastSelectMethod := smKeyboard; try SelectCurrentItem(True); finally FLastSelectMethod := PLastSelectMethod; end; Message.Result := 1; end; end else if Message.CharCode = VK_ADD then begin FNextCharToIgnore := Word('+'); inherited; end else if Message.CharCode = VK_SUBTRACT then begin FNextCharToIgnore := Word('-'); inherited; end else if Message.CharCode = VK_MULTIPLY then begin FNextCharToIgnore := Word('*'); inherited; end else if (NortonLike <> nlOff) and (Message.CharCode in [VK_LEFT, VK_RIGHT]) and (ViewStyle = vsReport) and ((GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL) = 0) then begin if Items.Count > 0 then begin // do not focus item directly to make later selecting work if Message.CharCode = VK_LEFT then SendMessage(Handle, WM_KEYDOWN, VK_HOME, LongInt(0)) else SendMessage(Handle, WM_KEYDOWN, VK_END, LongInt(0)); end; Message.Result := 1; end else if (NortonLike <> nlOff) and (Message.CharCode = VK_SPACE) and ((KeyDataToShiftState(Message.KeyData) * [ssCtrl]) <> []) then begin // prevent Ctrl+Space landing in else branch below, // this can safely get processed by default handler as Ctrl+Space // toggles only focused item, not affecting others PLastSelectMethod := FLastSelectMethod; FLastSelectMethod := smKeyboard; try inherited; finally FLastSelectMethod := PLastSelectMethod; end; end else if (Message.CharCode in [VK_SPACE, VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN, VK_SELECT]) then begin PLastSelectMethod := FLastSelectMethod; PDontSelectItem := FDontSelectItem; PDontUnSelectItem := FDontUnSelectItem; FLastSelectMethod := smKeyboard; FDontSelectItem := FDontSelectItem or ((NortonLike <> nlOff) and ((KeyDataToShiftState(Message.KeyData) * [ssShift]) = [])); // Note that Space (selecting toggling) is processed by default handler for WM_CHAR, // otherwise the below condition would prevent unselection FDontUnSelectItem := FDontUnSelectItem or (NortonLike = nlOn) or ((NortonLike = nlKeyboard) and (not FAnyAndAllSelectedImplicitly)); try inherited; finally FDontSelectItem := PDontSelectItem; FDontUnSelectItem := PDontUnSelectItem; FLastSelectMethod := PLastSelectMethod; end; end else inherited; end; procedure TCustomNortonLikeListView.WMSysCommand(var Message: TWMSysCommand); begin // Ugly workaround to avoid Windows beeping when Alt+Grey +/- are pressed // (for (Us)Select File with Same Ext commands) // The same for Alt+Enter (for Properties) if (Message.CmdType = SC_KEYMENU) and ((Message.Key = Word('+')) or (Message.Key = Word('-')) or (Message.Key = VK_RETURN)) then begin Message.Result := 1; end else inherited; end; procedure TCustomNortonLikeListView.WMChar(var Message: TWMChar); var PLastSelectMethod: TSelectMethod; PDontUnSelectItem: Boolean; PDontSelectItem: Boolean; begin if Message.CharCode = FNextCharToIgnore then begin // ugly fix to avoid Windows beeping when these keys are processed by // WMKeyDown instead of here (WMChar) Message.Result := 1; end else if (NortonLike <> nlOff) and (Message.CharCode = Byte(' ')) then begin if (GetKeyState(VK_CONTROL) >= 0) then begin // If not handled in TCustomScpExplorerForm::DirViewKeyPress if not DoKeyPress(Message) then begin if Assigned(ItemFocused) then ItemFocused.Selected := not ItemFocused.Selected; end; end else inherited; end else begin PLastSelectMethod := FLastSelectMethod; PDontSelectItem := FDontSelectItem; PDontUnSelectItem := FDontUnSelectItem; FDontSelectItem := FDontSelectItem or (NortonLike <> nlOff); FLastSelectMethod := smKeyboard; FDontUnSelectItem := FDontUnSelectItem or (NortonLike = nlOn) or ((NortonLike = nlKeyboard) and (not FAnyAndAllSelectedImplicitly)); try inherited; finally FLastSelectMethod := PLastSelectMethod; FDontSelectItem := PDontSelectItem; FDontUnSelectItem := PDontUnSelectItem; end; end; FNextCharToIgnore := 0; end; procedure TCustomNortonLikeListView.FocusSomething(ForceMakeVisible: Boolean); var MakeVisible: Boolean; begin MakeVisible := ForceMakeVisible; if Valid and (Items.Count > 0) and not Assigned(ItemFocused) then begin MakeVisible := True; if (NortonLike <> nlOff) then begin SendMessage(Handle, WM_KEYDOWN, VK_DOWN, LongInt(0)); end; if not Assigned(ItemFocused) then begin ItemFocused := Items[0]; end; end; if MakeVisible and Assigned(ItemFocused) then begin ItemFocused.MakeVisible(False); end; end; function TCustomNortonLikeListView.EnableDragOnClick: Boolean; begin Result := (not FFocusingItem); end; procedure TCustomNortonLikeListView.FocusItem(Item: TListItem); var P: TPoint; PLastSelectMethod: TSelectMethod; PDontUnSelectItem: Boolean; PDontSelectItem: Boolean; WParam: UINT_PTR; LParam: INT_PTR; begin // This whole is replacement for mere ItemFocused := Item // because that does not reset some internal focused pointer, // causing subsequent Shift-Click selects range from the first item, // not from focused item. Item.MakeVisible(False); Assert(Focused); if Focused then begin P := Item.GetPosition; PLastSelectMethod := FLastSelectMethod; PDontSelectItem := FDontSelectItem; PDontUnSelectItem := FDontUnSelectItem; FLastSelectMethod := smNoneYet; FDontSelectItem := True; FDontUnSelectItem := True; FFocusingItem := True; try // HACK // WM_LBUTTONDOWN enters loop, waiting for WM_LBUTTONUP, // so we have to post it in advance to break the loop immediately // Without MK_CONTROL, if there are more items selected, // they won't get unselected on subsequent focus change // (with explorer-style selection). // And it also makes the click the least obtrusive, affecting the focused // file only. WParam := MK_LBUTTON or MK_CONTROL; LParam := MAKELPARAM(P.X, P.Y); PostMessage(Handle, WM_LBUTTONUP, WParam, LParam); SendMessage(Handle, WM_LBUTTONDOWN, WParam, LParam); finally FFocusingItem := False; FLastSelectMethod := PLastSelectMethod; FDontSelectItem := PDontSelectItem; FDontUnSelectItem := PDontUnSelectItem; end; end; if ItemFocused <> Item then ItemFocused := Item; end; // TListItem.Selected needs an index, which is expensively looked up. // If we know it already, avoid that loop up. procedure TCustomNortonLikeListView.SetItemSelectedByIndex(Index: Integer; Select: Boolean); var State: Integer; begin if Select then State := LVIS_SELECTED else State := 0; ListView_SetItemState(Handle, Index, State, LVIS_SELECTED); end; function TCustomNortonLikeListView.GetItemSelectedByIndex(Index: Integer): Boolean; begin Result := (ListView_GetItemState(Handle, Index, LVIS_SELECTED) and LVIS_SELECTED) <> 0; end; procedure TCustomNortonLikeListView.SelectAll(Mode: TSelectMode; Exclude: TListItem); var Index: Integer; Item: TListItem; NewState: Boolean; begin BeginSelectionUpdate; try // Setting/Querying selected state is expensive. // This optimization is important for call from TCustomNortonLikeListView.WMLButtonUp in nlKeyboard mode. if (Mode = smNone) and // If there are too many, plain iteration is more effective then using GetNextItem // (though that can be optimized too, by passing index in and out instead of an item pointer) (FSelCount < Items.Count div 4) then begin Item := GetNextItem(nil, sdAll, [isSelected]); while Assigned(Item) do begin if Item <> Exclude then Item.Selected := False; Item := GetNextItem(Item, sdAll, [isSelected]); end; end else begin for Index := 0 to Items.Count - 1 do begin Item := Items[Index]; if Item <> Exclude then begin case Mode of smAll: NewState := True; smNone: NewState := False; smInvert: NewState := not GetItemSelectedByIndex(Index); else begin Assert(False); NewState := False; end; end; SetItemSelectedByIndex(Index, NewState); end; end; end; finally EndSelectionUpdate; end; end; procedure TCustomNortonLikeListView.SelectAll(Mode: TSelectMode); begin SelectAll(Mode, nil); end; procedure TCustomNortonLikeListView.WMLButtonDown(var Message: TWMLButtonDown); var PLastSelectMethod: TSelectMethod; PDontUnSelectItem: Boolean; PDontSelectItem: Boolean; PSelectingImplicitly: Boolean; SelectingImplicitly: Boolean; Shift: TShiftState; Item: TListItem; begin Shift := KeysToShiftState(Message.Keys); PLastSelectMethod := FLastSelectMethod; PDontSelectItem := FDontSelectItem; PDontUnSelectItem := FDontUnSelectItem; PSelectingImplicitly := FSelectingImplicitly; FLastSelectMethod := smMouse; FDontSelectItem := FDontSelectItem or ((NortonLike = nlOn) and ((Shift * [ssCtrl, ssShift]) = [])); FDontUnSelectItem := FDontUnSelectItem or ((NortonLike = nlOn) and ((Shift * [ssCtrl]) = [])); SelectingImplicitly := ((Shift * [ssCtrl, ssShift]) = []); if SelectingImplicitly and (NortonLike = nlKeyboard) then begin // in general, when clicking, we clear selection only after mouse button is released, // from within WMLButtonUp, so we know we are not starting dragging, // so we do not want to clear the selection. // on the other hand, when clicking outside of the selection, // we want to explicitly clear the selection, no matter what Item := GetItemAt(Message.XPos, Message.YPos); if (Item = nil) or (not Item.Selected) then SelectAll(smNone); end; FSelectingImplicitly := FSelectingImplicitly or SelectingImplicitly; FLButtonDownShiftState := Shift; FLButtonDownPos := Point(Message.XPos, Message.YPos); try inherited; finally FLastSelectMethod := PLastSelectMethod; FDontSelectItem := PDontSelectItem; FDontUnSelectItem := PDontUnSelectItem; FSelectingImplicitly := PSelectingImplicitly; end; end; procedure TCustomNortonLikeListView.WMRButtonDown(var Message: TWMRButtonDown); var PLastSelectMethod: TSelectMethod; PDontUnSelectItem: Boolean; PDontSelectItem: Boolean; PSelectingImplicitly: Boolean; SelectingImplicitly: Boolean; Shift: TShiftState; begin Shift := KeysToShiftState(Message.Keys); PLastSelectMethod := FLastSelectMethod; PDontSelectItem := FDontSelectItem; PDontUnSelectItem := FDontUnSelectItem; PSelectingImplicitly := FSelectingImplicitly; FLastSelectMethod := smMouse; FDontSelectItem := FDontSelectItem or (NortonLike = nlOn); FDontUnSelectItem := FDontUnSelectItem or (NortonLike = nlOn); SelectingImplicitly := ((Shift * [ssCtrl, ssShift]) = []); // TODO unselect all when clicking outside of selection // (is not done automatically when focused item is not selected) FSelectingImplicitly := FSelectingImplicitly or SelectingImplicitly; try inherited; finally FLastSelectMethod := PLastSelectMethod; FDontSelectItem := PDontSelectItem; FDontUnSelectItem := PDontUnSelectItem; FSelectingImplicitly := PSelectingImplicitly; end; end; procedure TCustomNortonLikeListView.WMLButtonUp(var Message: TWMLButtonUp); var SelectingImplicitly: Boolean; Shift: TShiftState; begin // Workaround // For some reason Message.Keys is always 0 here, // so we use shift state from the LButtonDown as a workaround Shift := KeysToShiftState(Message.Keys); SelectingImplicitly := ((Shift * [ssCtrl, ssShift]) = []) and ((FLButtonDownShiftState * [ssCtrl, ssShift]) = []); if SelectingImplicitly and (csClicked in ControlState) and (Abs(FLButtonDownPos.X - Message.XPos) <= 4) and (Abs(FLButtonDownPos.Y - Message.YPos) <= 4) then begin SelectAll(smNone, ItemFocused); // Because condition in ItemSelected is not triggered as we first select // the new item and then unselect the previous. // This probably means that we can get rid of the code in ItemSelected. FAnyAndAllSelectedImplicitly := True; end; inherited; end; function TCustomNortonLikeListView.GetMarkedFile: TListItem; begin if Assigned(Selected) then Result := Selected else if Assigned(ItemFocused) and (NortonLike <> nlOff) then Result := ItemFocused else Result := nil; end; function TCustomNortonLikeListView.GetNextItem(StartItem: TListItem; Direction: TSearchDirection; States: TItemStates): TListItem; var Start, Index, First, Last: Integer; begin if not FManageSelection then begin Result := inherited GetNextItem(StartItem, Direction, States); end else begin Assert(Direction = sdAll); if States = [isSelected] then begin if FSelCount = 0 then begin Result := nil end else if (not Assigned(StartItem)) and (FFirstSelected >= 0) then begin Result := Items[FFirstSelected] end else begin if Assigned(StartItem) then Start := StartItem.Index else Start := -1; if (FFirstSelected >= 0) and (Start < FFirstSelected) then First := FFirstSelected else First := Start + 1; if FLastSelected >= 0 then Last := FLastSelected else Last := Items.Count - 1; if Start > Last then begin Result := nil; end else begin Index := First; while (Index <= Last) and (not GetItemSelectedByIndex(Index)) do begin Inc(Index); end; if Index > Last then begin Result := nil; if (Start >= 0) and GetItemSelectedByIndex(Start) then begin Assert((FLastSelected < 0) or (FLastSelected = Start)); FLastSelected := Start; end; end else begin Result := Items[Index]; Assert(GetItemSelectedByIndex(Index)); if not Assigned(StartItem) then begin Assert((FFirstSelected < 0) or (FFirstSelected = Index)); FFirstSelected := Index; end; end; end; end; end else if States = [isCut] then begin Result := inherited GetNextItem(StartItem, Direction, States); end else if States = [] then begin if Assigned(StartItem) then Start := StartItem.Index else Start := -1; Inc(Start); if Start < Items.Count then Result := Items[Start] else Result := nil; end else begin Assert(False); Result := nil; end; end; end; function TCustomNortonLikeListView.GetSelCount: Integer; begin Result := FSelCount; end; procedure TCustomNortonLikeListView.InsertItem(Item: TListItem); begin inherited; if (not FInsertingNewUnselectedItem) and // Optimization to avoid expensive Item.Selected Item.Selected then begin ItemSelected(Item, -1); end; end; function TCustomNortonLikeListView.GetItemFromHItem(const Item: TLVItem): TListItem; begin with Item do if (state and LVIF_PARAM) <> 0 then Result := Pointer(lParam) else Result := Items[iItem]; end; function TCustomNortonLikeListView.GetMarkedCount: Integer; begin if (SelCount > 0) or (NortonLike = nlOff) then Result := SelCount else if Assigned(ItemFocused) then Result := 1 else Result := 0; end; function TCustomNortonLikeListView.GetValid: Boolean; begin // Note that TCustomDirView::GetValid don't inherit // this method because of optimalization Result := (not (csDestroying in ComponentState)) and (not FClearingItems); end; procedure TCustomNortonLikeListView.BeginSelectionUpdate; begin // Higher value is probably some nesting error Assert(FUpdatingSelection in [0..4]); Inc(FUpdatingSelection); end; { BeginUpdatingSelection } procedure TCustomNortonLikeListView.EndSelectionUpdate; begin Assert(FUpdatingSelection > 0); Dec(FUpdatingSelection); end; { EndUpdatingSelection } procedure TCustomNortonLikeListView.WMNCDestroy(var Message: TWMNCDestroy); begin // VCLCOPY FHeaderHandle := 0; inherited; end; procedure TCustomNortonLikeListView.CreateWnd; begin try Assert(ColProperties <> nil); inherited; // VCL gets the handle from WM_CREATE FHeaderHandle := ListView_GetHeader(Handle); ColProperties.ListViewWndCreated; if SupportsDarkMode then begin // This enables dark mode - List view itself supports dark mode somewhat even in the our 'Explorer' theme. // The 'ItemsView' has better (Explorer-like) dark mode selection color, but on the other hand it does not have dark scrollbars. // win32-darkmode has ugly fix for that (FixDarkScrollBar), which we do not want to employ. // The 'DarkMode_Explorer' uses the standard selection color (bright blue). // Enables dark headers: SetWindowTheme(FHeaderHandle, 'ItemsView', nil); if DarkMode then UpdateDarkMode; end; finally end; end; procedure TCustomNortonLikeListView.DestroyWnd; begin ColProperties.ListViewWndDestroying; try inherited; finally ColProperties.ListViewWndDestroyed; end; end; procedure TCustomNortonLikeListView.LVMEditLabel(var Message: TMessage); begin // explicitly requesting editing (e.g. F2), // so we do not care anymore when the view was focused FFocused := 0; inherited; end; function TCustomNortonLikeListView.CanEdit(Item: TListItem): Boolean; var N: TDateTime; Delta: Double; begin N := Now; Result := inherited CanEdit(Item); if Result and (FFocused > 0) then begin Delta := N - FFocused; // it takes little more than 500ms to trigger editing after click Result := Delta > (750.0/MSecsPerDay); end; FFocused := 0; end; procedure TCustomNortonLikeListView.WMSetFocus(var Message: TWMSetFocus); begin inherited; if Message.FocusedWnd <> FIgnoreSetFocusFrom then FFocused := Now; end; procedure TCustomNortonLikeListView.CMWantSpecialKey(var Message: TCMWantSpecialKey); begin inherited; if IsEditing and (Message.CharCode = VK_TAB) then Message.Result := 1; end; procedure TCustomNortonLikeListView.MakeTopItem(Item: TListItem); begin Scroll(0, Item.Top - TopItem.Top); end; procedure TCustomNortonLikeListView.MakeProgressVisible(Item: TListItem); var DisplayRect: TRect; begin if ViewStyle = vsReport then begin DisplayRect := Item.DisplayRect(drBounds); if DisplayRect.Bottom > ClientHeight then begin MakeTopItem(Item); end; end; Item.MakeVisible(False); end; function TCustomNortonLikeListView.IsItemVisible(Item: TListItem): Boolean; begin Result := (ListView_IsItemVisible(Handle, Item.Index) <> 0); end; procedure TCustomNortonLikeListView.ChangeScale(M, D: Integer; isDpiChange: Boolean); begin if M <> D then begin // When font is scaled, while the control is being re-created, previous font is restored once // read from the persistence data in TCustomListView.CreateWnd. // Requiring handle, makes sure the re-create phase is closed. // We could limit impact by checking ControlHasRecreationPersistenceData, // but for now, we actually prefer larger impact to test this change better. HandleNeeded; end; inherited; ColProperties.ChangeScale(M, D); end; end.