Заменить контекстное меню TCustomEdit своим собственным

Question

Я хочу заменить все всплывающие меню, отображаемые delphi в компонентах TCustomEdit, таких как TEdit или TMemo, с помощью моего собственного всплывающего меню (в котором много других действий). До сих пор я заменяю свойство PopUpMenu каждого компонента вручную своим собственным TPopUpMenu. но мне интересно, могу ли я сделать это без изменения этого свойства вручную для каждого компонента во всех моих формах.

Я хочу что-то вроде перехвата, чтобы перехватывать вызовы этого системного меню и заменять мое собственное меню. это возможно?

Answer 1

Если ваши Формы происходят от общего предка (а не по умолчанию TForm), например TMyBaseForm, что означает TForm1 = class(TMyBaseForm), это можно сделать легко.В событии TMyBaseForm.OnShow вы можете перебирать его элементы управления, и если вы найдете TEdit или TMemo, вы динамически устанавливаете их свойство PopupMenu.

Другой способ - использовать Screen.OnActiveFormChange (Screen.OnActiveControlChange срабатывает слишком поздно, если щелкнуть правой кнопкой мыши активный элемент управления - РЕДАКТИРОВАТЬ: это верно только для D5 ) в основном обработчике событий формы, чтобы захватить активную форму и выполнить итерации элементов управления Screen.ActiveForm иустановите TEdit или TMemo свойство PopupMenu на свой пользовательский MyPopupMenu:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.OnActiveFormChange := ActiveFormChange;
end;    

procedure TForm1.ActiveFormChange(Sender: TObject);
begin
  CustomEditControlsNormalize(Screen.ActiveForm);
end;

type
  TCustomEditAccess = class(TCustomEdit);

procedure TForm1.CustomEditControlsNormalize(F: TForm);
var
  I: Integer;
begin
  if not Assigned(F) then Exit;
  for I := 0 to F.ComponentCount - 1 do
    if F.Components[I] is TCustomEdit then
      TCustomEditAccess(F.Components[I]).Popupmenu := MyPopupMenu;
end;    

---

Чтобы определить, какой элемент управления TCustomEdit вызвал всплывающее меню, обратитесь к MyPopupMenu.PopupComponent (в событии MyPopupMenu.OnPopup):

procedure TForm1.MyPopupMenuPopup(Sender: TObject);
begin
  if MyPopupMenu.PopupComponent is TCustomEdit then
  begin
    FEditPopupControl := TCustomEdit(MyPopupMenu.PopupComponent);
    Caption := FEditPopupControl.Name; // debug :-P
  end;
end;

---

EDIT: Screen.OnActiveControlChange было моей первоначальной мыслью.Я проверил это в D5.если Edit1 сфокусирован, и я щелкаю правой кнопкой мыши на Edit2, он сначала выскочит меню по умолчанию, только затем он станет активным элементом управления.Я наконец проверил это с D7 и D2009.оба работают просто отлично.Это проблема D5 , поэтому Ответ Justmade , безусловно, является лучшим решением, чем использование Screen.OnActiveFormChange.

Answer 2

В основной форме добавьте следующий код.Он должен применяться ко всем пользовательским элементам управления вашей формы.

TForm2 = class(TForm)
  procedure FormCreate(Sender: TObject);
private
  procedure ActiveControlChanged(Sender: TObject);
end;

implementation

type
  TCustomEditAccess = class(TCustomEdit);
  TCustomGridAccess = class(TCustomGrid);

procedure TForm2.ActiveControlChanged(Sender: TObject);
begin
  if (Screen.ActiveControl is TCustomEdit) and not Assigned(TCustomEditAccess(Screen.ActiveControl).PopupMenu) then
    TCustomEditAccess(Screen.ActiveControl).PopupMenu := MyPopupMenu
  else if (Screen.ActiveControl is TCustomGrid) then
  begin
    TCustomGridAccess(Screen.ActiveControl).ShowEditor;
    if Assigned(TCustomGridAccess(Screen.ActiveControl).InplaceEditor) then
      TCustomEditAccess(TCustomGridAccess(Screen.ActiveControl).InplaceEditor).PopupMenu := MyPopupMenu;
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Screen.OnActiveControlChange := ActiveControlChanged;
end;

Это просто упрощенная версия (с точки зрения кодирования) ответа Кобика, а также он будет обращаться к любому TCustomEdit, созданному кодом или другим способом.сложные элементы управления, которые не используют форму как владелец.

Его инструкция о том, как определить, какое всплывающее окно CustomEdit применяется.

Редактировать: добавить поддержку сетки InplaceEditor

Answer 3

Вы можете назначить один обработчик события OnContextPopup всем элементам управления редактирования, вызвать его для вызова метода Popup() TPopupMenu и установить для параметра Handled события значение True.Но это не сильно отличается от простого присвоения TPopupMenu всем элементам управления напрямую.

Чтобы сделать это еще дальше, вы можете назначить один обработчик события OnContextPopup своему родителю TFormвместо отдельных элементов управления редактирования.Событие сообщает вам координаты мыши, когда меню вызывается мышью.Вы можете найти дочерний элемент управления под этими координатами, и если он является одним из ваших правок редактирования, тогда вызовите Popup() и установите для Handled значение True.Вместо этого пользователь может вызывать меню с клавиатуры, в этом случае координаты мыши будут {-1, -1}, поэтому используйте свойство TScreen.ActiveControl, чтобы узнать, какой элемент управления вызывается.

Answer 4

Добавьте компонент TApplicationEvents в ваше приложение delphi. Сделать свое собственное попупмену (popupmenu1)? В OnMessage компонента TApplicationEvents добавьте следующий код:

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var
  ctrl: TWincontrol;

begin
  if (msg.Message = WM_RBUTTONUP) or (msg.Message = WM_KEYUP ) then begin
     ctrl := FindControl(Msg.hwnd);
     if ctrl <> nil then begin
       if ((ctrl is TEdit))  then begin
        (ctrl as TEdit).PopupMenu := Popupmenu1;
       end;
       if ((ctrl is TMemo))  then begin
        (ctrl as TMemo).PopupMenu := Popupmenu1;
       end;
     end;
   end;
end;

Это перехватит щелчок правой кнопкой мыши, и если в это время под курсором мыши будет TEdit или TMemo, он свяжет всплывающее меню с этим компонентом и запустит его.

Answer 5

Вы можете выполнить назначение всплывающего окна непосредственно на установленном хуке в методе TEdit или TMemo Class 'NewInstance. С этой техникой вам нужно будет только включить дополнительный блок с установкой крючка. Код ловушки назначит ваш пользовательский объект TPopupMenu свойству PopupMenu каждого компонента класса TEdit и TMemo, созданного в вашем приложении.

Сначала удалите объект TPopupMenu в глобальном модуле TDatamodule или в вашей основной форме. Ключевым моментом здесь является то, что родитель PopupMenu должен быть всегда доступен и быть первым, созданным при инициализации вашего приложения, или, по крайней мере, до установки хука.

Затем создайте новый пустой блок. Называй как хочешь. В моем случае popup_assignment.pas. Источник такой:

unit popup_assignment;

interface

uses Windows, StdCtrls;


implementation

uses globaldatamodule; // Unit of global TPopupMenu parent

{------------------------------------------------------------------------------}

function TEditNewInstance(AClass: TClass): TObject;
begin
    Result := TEdit.NewInstance;
    TEdit(Result).PopupMenu := global_datamodule.customedit_popupmenu; // <- your global TPopupMenu component !!!
end;

function TMemoNewInstance(AClass: TClass): TObject;
begin
    Result := TMemo.NewInstance;
    TMemo(Result).PopupMenu := global_datamodule.customedit_popupmenu; // <- your global TPopupMenu component !!!
end;

function GetVirtualMethod(AClass: TClass; const VmtOffset: Integer): Pointer;
begin
    Result := PPointer(Integer(AClass) + VmtOffset)^;
end;

procedure SetVirtualMethod(AClass: TClass; const VmtOffset: Integer; const Method: Pointer);
var
    WrittenBytes: DWORD;
    PatchAddress: PPointer;
begin
    PatchAddress := Pointer(Integer(AClass) + VmtOffset);
    WriteProcessMemory(GetCurrentProcess, PatchAddress, @Method, SizeOf(Method), WrittenBytes);
end;


{$IFOPT W+}{$DEFINE WARN}{$ENDIF}{$WARNINGS OFF} // no compiler warning
const
    vmtNewInstance = System.vmtNewInstance;
{$IFDEF WARN}{$WARNINGS ON}{$ENDIF}

var
    orgTEditNewInstance: Pointer;
    orgTMemoNewInstance: Pointer;

initialization
    orgTEditNewInstance := GetVirtualMethod(TEdit, vmtNewInstance);
    orgTMemoNewInstance := GetVirtualMethod(TMemo, vmtNewInstance);

    SetVirtualMethod(TEdit, vmtNewInstance, @TEditNewInstance);
    SetVirtualMethod(TMemo, vmtNewInstance, @TMemoNewInstance);

finalization
    SetVirtualMethod(TEdit, vmtNewInstance, OrgTEditNewInstance);
    SetVirtualMethod(TMemo, vmtNewInstance, orgTMemoNewInstance);

end.

Answer 6

Другие возможности:

1. Используйте доступные функциональные возможности экспертов:

   • Используйте CnPack Property Corrector и определите действие, которое предложит вам сбросить указанный компонент.
   • Использование GExperts Rename / Replace Components futures (требуется реализация ваших пользовательских элементов управления)
     
     

2. Самое сложное - реализовать потомок TForm время разработки, перетащить и отпустить и изменить свойство PupupMenu удаленных элементов управления.

3. Уродливый, но гибкий и без какой-либо последующей реализации элементов управления - используйте следующую процедуру:
   

   • CustomizePopupMenu (Форма, [TEdit, TMemo], MyPopupMenu)
     
   • CustomizePopupMenu (AnyForm, [TEdit, TMemo], AnyPopupMenu)
     

---

procedure CustomizePopupMenu(
  const aCtrl: TWinControl;
  const aClasses: array of TControlClass;
  const aPopUp: TPopupMenu);

  procedure Process(const aCtrl: TWinControl;
    const aClasses: array of TControlClass; const aPopUp: TPopupMenu);

    procedure Match(const aCtrl: TControl;
      const aClasses: array of TControlClass; const aPopUp: TPopupMenu);
    var
      Ix: Integer;
    begin
      for Ix := Low(aClasses) to High(aClasses) do
      begin
        if aCtrl.InheritsFrom(aClasses[Ix]) then
           aCtrl.PopupMenu:= aPopUp;
      end;
    end;

  var
    Ix: Integer;
    Ctrl: TControl;
  begin
    for Ix := 0 to Pred(aCtrl.ControlCount) do
    begin

      if aCtrl.Controls[Ix] is TWinControl then
         Process(TWinControl(aCtrl.Controls[Ix]), aClasses, aPopUp);
      Match(aCtrl.Controls[Ix], aClasses, aPopUp)

    end;
  end;


begin
  if (aCtrl <> nil) and (Length(aClasses) > 0) and (aPopUp <> nil) then
     Process(aCtrl, aClasses, aPopUp)
end;