Mega Code Archive
Prevent copy-paste-cut in tedit
<![CDATA[
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.
]]>