delphiclipboardonchangecopy-pastetmemo

How to interfere when user presses CTRL+X and still keep TMemo's default CTRL+X behavior?


I have a TMemo on the form and I've set an OnChange event for it. I hope the OnChange event not to be triggered when the user presses Ctrl+X in the memo. But Ctrl+X just cuts the text selection, which will for sure trigger the OnChange event. How can I prevent that?

I've tried to detect Ctrl+X in the KeyUp event, and if the user pressed Ctrl+X I unbind the memo's OnChange event and programmatically cut the text again. But this doesn't work, and I don't how to programmatically send Ctrl+X.

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = Ord('X')) and (Shift = [ssCtrl]) then
  begin
    Memo1.OnChange := nil;
    // programmatically cut the text here, which I don't know how to do
    Memo1.OnChange := Memo1Change;
  end;
end;

Solution

  • Don't rely on keyboard events (They are not executed for example when you cut something by using the popupmenu), rely on windows messages instead.

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
    
    type
      TForm1 = class(TForm)
        Memo1: TMemo;
        procedure Memo1Change(Sender: TObject);
        procedure FormCreate(Sender: TObject);
      private
        FPrevMemoWindowProc : TWndMethod;
        procedure MemoWindowProc(var AMessage: TMessage);
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    uses
      Clipbrd;
    
    procedure TForm1.MemoWindowProc(var AMessage: TMessage);
    begin
      if(AMessage.Msg = WM_CUT) then
      begin
        if(Memo1.SelLength > 0) then
        begin
          Memo1.OnChange := nil;
          try
            Clipboard.AsText := Memo1.SelText;
            Memo1.ClearSelection();
            Exit;
          finally
            Memo1.OnChange := Memo1Change;
          end;
        end;
      end;
    
      FPrevMemoWindowProc(AMessage);
    end;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      FPrevMemoWindowProc := Memo1.WindowProc;
      Memo1.WindowProc := MemoWindowProc;
    end;
    
    procedure TForm1.Memo1Change(Sender: TObject);
    begin
      ShowMessage('Change');
    end;