Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Paste

2 views
Skip to first unread message

Jason

unread,
Jan 8, 2001, 4:03:41 PM1/8/01
to
Hi Friends,

I have Edit1 on a form how do I prevent someone pasting text from the
clipboard into it??

The control has to be enable so no telling me to disable it ;-)

TIA

Jason.


Serdar Guven

unread,
Jan 8, 2001, 5:56:51 PM1/8/01
to
use this companent. Some property add to TEdit


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(TEdit)
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.


"Jason" <ja...@vianet-it.co.uk> wrote in message
news:93daaq$s4...@bornews.inprise.com...

Serdar Guven

unread,
Jan 8, 2001, 5:55:10 PM1/8/01
to
use this companent. Some Property add to TEdit

unit MyEdit;

interface

procedure Register;

implementation

end.

Rick Rogers (TeamB)

unread,
Jan 9, 2001, 10:51:21 AM1/9/01
to
On Mon, 8 Jan 2001 21:03:41 -0000, "Jason" <ja...@vianet-it.co.uk>
wrote:

> I have Edit1 on a form how do I prevent someone pasting text from
> the clipboard into it?

ReadOnly := True;
--
Rick Rogers (TeamB); Fenestra Technologies, http://www.fenestra.com/
Use Borland servers; posts via others are not seen by TeamB.
For more info, see http://www.borland.com/newsgroups/genl_faqs.html

Jason

unread,
Jan 9, 2001, 1:38:32 PM1/9/01
to
Hi Serder,

Thanks, I will try this :-)

Jason


"Serdar Guven" <serd...@superonline.com> wrote in message
news:3a5a45a1_2@dnews...

Jason

unread,
Jan 9, 2001, 1:38:04 PM1/9/01
to
Hi Rick,

They must be able to type into the Edit ;-)

Jason


"Rick Rogers (TeamB)" <ri...@fenestra.com> wrote in message
news:708m5toj58slhtig2...@4ax.com...

Alexander Minchev

unread,
Apr 4, 2001, 2:17:27 AM4/4/01
to
Hi Jason !
I'm new in this newsgroup, but your question was intresting. I find one
suggestion - keep a copy of EDIT1.TEXT ( in a PChar pointed by edit1.tag
for example), and in EDIT1onchange just determine if more than one letter
was changed !
Voila
Alexander Minchew
P.P. Sorry for my poor English.

Jason wrote in message <93daaq$s4...@bornews.inprise.com>...

0 new messages