Предотвратить работу с командами буфера обмена в TEdit

Delphi , ОС и Железо , Буфер обмена

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

unit MyEdit;

 interface

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, stdctrls, clipbrd;

 type
   TPreventNotifyEvent = procedure(Sender: TObject; Text: string; var Accept: Boolean) of object;

 type
   TMyEdit = class(TCustomEdit)
   private
     FPreventCut: Boolean;
     FPreventCopy: Boolean;
     FPreventPaste: Boolean;
     FPreventClear: Boolean;

     FOnCut: TPreventNotifyEvent;
     FOnCopy: TPreventNotifyEvent;
     FOnPaste: TPreventNotifyEvent;
     FOnClear: TPreventNotifyEvent;

     procedure WMCut(var Message: TMessage); message WM_CUT;
     procedure WMCopy(var Message: TMessage); message WM_COPY;
     procedure WMPaste(var Message: TMessage); message WM_PASTE;
     procedure WMClear(var Message: TMessage); message WM_CLEAR;
   protected
     { Protected declarations }
   public
     { Public declarations }
   published
     property PreventCut: Boolean read FPreventCut write FPreventCut default False;
     property PreventCopy: Boolean read FPreventCopy write FPreventCopy default False;
     property PreventPaste: Boolean read FPreventPaste write FPreventPaste default False;
     property PreventClear: Boolean read FPreventClear write FPreventClear default False;
     property OnCut: TPreventNotifyEvent read FOnCut write FOnCut;
     property OnCopy: TPreventNotifyEvent read FOnCopy write FOnCopy;
     property OnPaste: TPreventNotifyEvent read FOnPaste write FOnPaste;
     property OnClear: TPreventNotifyEvent read FOnClear write FOnClear;
   end;

 procedure Register;

 implementation

 procedure TMyEdit.WMCut(var Message: TMessage);
 var
   Accept: Boolean;
   Handle: THandle;
   HandlePtr: Pointer;
   CText: string;
 begin
   if FPreventCut then
     Exit;
   if SelLength = 0 then
     Exit;
   CText := Copy(Text, SelStart + 1, SelLength);
   try
     OpenClipBoard(Self.Handle);
     Accept := True;
     if Assigned(FOnCut) then
       FOnCut(Self, CText, Accept);
     if not Accept then
       Exit;
     Handle := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(CText) + 1);
     if Handle = 0 then
       Exit;
     HandlePtr := GlobalLock(Handle);
     Move((PChar(CText))^, HandlePtr^, Length(CText));
     SetClipboardData(CF_TEXT, Handle);
     GlobalUnlock(Handle);
     CText := Text;
     Delete(CText, SelStart + 1, SelLength);
     Text := CText;
   finally
     CloseClipBoard;
   end;
 end;


 procedure TMyEdit.WMCopy(var Message: TMessage);
 var
   Accept: Boolean;
   Handle: THandle;
   HandlePtr: Pointer;
   CText: string;
 begin
   if FPreventCopy then
     Exit;
   if SelLength = 0 then
     Exit;
   CText := Copy(Text, SelStart + 1, SelLength);
   try
     OpenClipBoard(Self.Handle);
     Accept := True;
     if Assigned(FOnCopy) then
       FOnCopy(Self, CText, Accept);
     if not Accept then
       Exit;
     Handle := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(CText) + 1);
     if Handle = 0 then
       Exit;
     HandlePtr := GlobalLock(Handle);
     Move((PChar(CText))^, HandlePtr^, Length(CText));
     SetClipboardData(CF_TEXT, Handle);
     GlobalUnlock(Handle);
   finally
     CloseClipBoard;
   end;
 end;


 procedure TMyEdit.WMPaste(var Message: TMessage);
 var
   Accept: Boolean;
   Handle: THandle;
   CText: string;
   LText: string;
   AText: string;
 begin
   if FPreventPaste then
     Exit;
   if IsClipboardFormatAvailable(CF_TEXT) then
   begin
     try
       OpenClipBoard(Self.Handle);
       Handle := GetClipboardData(CF_TEXT);
       if Handle = 0 then
         Exit;
       CText := StrPas(GlobalLock(Handle));
       GlobalUnlock(Handle);
       Accept := True;
       if Assigned(FOnPaste) then
         FOnPaste(Self, CText, Accept);
       if not Accept then
         Exit;
       LText := '';
       if SelStart > 0 then
         LText := Copy(Text, 1, SelStart);
       LText := LText + CText;
       AText := '';
       if (SelStart + 1) < Length(Text) then
         AText := Copy(Text, SelStart + SelLength + 1, Length(Text) - SelStart + SelLength + 1);
       Text := LText + AText;
     finally
       CloseClipBoard;
     end;
   end;
 end;


 procedure TMyEdit.WMClear(var Message: TMessage);
 var
   Accept: Boolean;
   CText: string;
 begin
   if FPreventClear then
     Exit;
   if SelStart = 0 then
     Exit;
   CText  := Copy(Text, SelStart + 1, SelLength);
   Accept := True;
   if Assigned(FOnClear) then
     FOnClear(Self, CText, Accept);
   if not Accept then
     Exit;
   CText := Text;
   Delete(CText, SelStart + 1, SelLength);
   Text := CText;
 end;


 procedure Register;
 begin
   RegisterComponents('Samples', [TMyEdit]);
 end;

 end.

Этот компонент редактирования в Delphi предотвращает пользователю выполнение операций cut, copy, paste и clear текста в нем. Компонент предоставляет события для этих операций, чтобы вы могли обработать их программно.

Для использования этого компонента:

1. Добавьте экземпляр TMyEdit на вашу форму.
2. Установите свойства PreventCut, PreventCopy, PreventPaste и PreventClear в значение True, чтобы отключить эти операции.
3. Обработайте соответствующие события (OnCut, OnCopy, OnPaste и OnClear) для выполнения любых custom-операций перед выполнением стандартной операции.

Например, вы можете использовать этот компонент для предотвращения копирования или вставки чувствительной информации.

Альтернативное решение с более современным подходом:

Вместо переопределения сообщений WM_CUT, WM_COPY, WM_PASTE и WM_CLEAR можно подклассить контроль TEdit и обработать события OnCut, OnCopy, OnPaste и OnClear.

Для этого:

1. Добавьте экземпляр TEdit на вашу форму.
2. В Инспекторе объектов установите свойство Class в класс, который наследуется от TEdit.
3. В коде переопределите методы Cut, Copy, Paste и Clear и вызовите метод inherited только если свойства PreventCut, PreventCopy, PreventPaste и PreventClear установлены в значение False.

Пример:

type
  TMyEdit = class(TEdit)
  protected
    procedure Cut; override;
    procedure Copy; override;
    procedure Paste; override;
    procedure Clear; override;

  public
    property PreventCut: Boolean read FPreventCut write FPreventCut default False;
    property PreventCopy: Boolean read FPreventCopy write FPreventCopy default False;
    property PreventPaste: Boolean read FPreventPaste write FPreventPaste default False;
    property PreventClear: Boolean read FPreventClear write FPreventClear default False;

  end;

procedure TMyEdit.Cut;
begin
  if not FPreventCut then
    inherited Cut;
end;

procedure TMyEdit.Copy;
begin
  if not FPreventCopy then
    inherited Copy;
end;

procedure TMyEdit.Paste;
begin
  if not FPreventPaste then
    inherited Paste;
end;

procedure TMyEdit.Clear;
begin
  if not FPreventClear then
    inherited Clear;
end;

Этот подход более гибок и легче поддерживать, чем оригинальный код.

В этой статье описывается способ предотвратить работу с командами буфера обмена в компоненте TEdit для приложений на Delphi.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Буфер обмена ::