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.