Просто некоторые изменения кода @ Fredrik, так как я тестировал оба его метода.
Первый - это только сокращенная версия
private void TextBox_Pasting(object sender, DataObjectPastingEventArgs e)
{
string clipboard = e.DataObject.GetData(typeof(string)) as string;
Regex nonNumeric = new System.Text.RegularExpressions.Regex (@"\D");
string result = nonNumeric.Replace(clipboard, string.Empty);
int caret = CaretIndex;
Text = Text.Substring(0, SelectionStart) + result +
Text.Substring(SelectionStart + SelectionLength);
CaretIndex = caret + result.Length;
e.CancelCommand();
}
, а другая один из них обновляется с сохранением содержимого буфера обмена
private string oldClipboardContent { get; set; } = "";
private bool pasteModified { get; set; } = false;
private void TextBox_Pasting(object sender, DataObjectPastingEventArgs e)
{
if (pasteModified)
{
pasteModified = false;
}
else
{
pasteModified = true;
string text = (string)e.DataObject.GetData(typeof(string));
oldClipboardContent = text;
Regex nonNumeric = new System.Text.RegularExpressions.Regex (@"\D");
text = nonNumeric.Replace(text, string.Empty);
e.CancelCommand();
Clipboard.SetData(DataFormats.Text, text);
ApplicationCommands.Paste.Execute(text, this);
Clipboard.SetData(DataFormats.Text, OldClipboardContent);
oldClipboardContent = "";
}
}
Я использовал те, что были внутри моего настраиваемого элемента управления TextBox
, поэтому я мог получить доступ к свойствам TextBox
, не записывая сначала имя.
Попробуйте переопределить метод MouseWheelHandler
вашей формы следующим образом (я не проверял это полностью):
procedure TMyForm.MouseWheelHandler(var Message: TMessage);
var
Control: TControl;
begin
Control := ControlAtPos(ScreenToClient(SmallPointToPoint(TWMMouseWheel(Message).Pos)), False, True, True);
if Assigned(Control) and (Control <> ActiveControl) then
begin
Message.Result := Control.Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
Control.DefaultHandler(Message);
end
else
inherited MouseWheelHandler(Message);
end;
В событии OnMouseEnter для каждого прокручиваемого элемента управления добавьте соответствующий вызов SetFocus
Так для ListBox1:
procedure TForm1.ListBox1MouseEnter(Sender: TObject);
begin
ListBox1.SetFocus;
end;
Достигает ли это желаемого эффекта?
Эта статья может оказаться полезной: отправить сообщение с прокруткой вниз в список с помощью колеса мыши, но у списка нет фокуса [1] , он написан на C #, но преобразование в Delphi не должно это не будет большой проблемой. Он использует крючки для достижения желаемого эффекта.
Чтобы узнать, над каким компонентом находится курсор мыши, вы можете использовать функцию FindVCLWindow, пример которой можно найти в этой статье: Получить управление мышью в приложении Delphi [2] .
[1] http://social.msdn.microsoft.com/forums/en-US/winforms/thread/ec1fbfa2-137e-49f6-b444-b634e4f44f21/
[2] http://delphi.about.com/od/ delphitips2008 / qt / find-vcl-window.htm
Переопределите событие TApplication.OnMessage (или создайте компонент TApplicationEvents) и перенаправьте сообщение WM_MOUSEWHEEL в обработчик событий:
procedure TMyForm.AppEventsMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Pt: TPoint;
C: TWinControl;
begin
if Msg.message = WM_MOUSEWHEEL then begin
Pt.X := SmallInt(Msg.lParam);
Pt.Y := SmallInt(Msg.lParam shr 16);
C := FindVCLWindow(Pt);
if C = nil then
Handled := True
else if C.Handle <> Msg.hwnd then begin
Handled := True;
SendMessage(C.Handle, WM_MOUSEWHEEL, Msg.wParam, Msg.lParam);
end;
end;
end;
Здесь все работает нормально, хотя вы можете добавить некоторая защита, чтобы он не повторялся, если произойдет что-то неожиданное.