Solved

lock and unlock clipboard

Posted on 2001-09-15
3
1,550 Views
Last Modified: 2007-12-19
how can i lock and unlock the clipboard in code?

thanx

marc
0
Comment
Question by:marksmall
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 9

Accepted Solution

by:
ginsonic earned 50 total points
ID: 6495701
Read this tip . Hope to help you .

How to block pasting of text from the clipboard into an enabled TEdit
-----------------------------------------------------------

I have a TEdit on a form. How do I prevent someone from pasting text from the clipboard into it? The control has to be enabled, so please don't tell me to disable it.

Try this component, which blocks Cut, Copy and Paste:

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.
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 6503322
Or ........

To copy something there has to be a selection, otherwise there is nothing to copy. So attach a handler to the controls OnSelectionChange event. This handler contains the line:

with Sender as TRichEdit do // put here your component
  SelLength := 0;


something like :

var
yourLock:Boolean;

if yourLock then
 with Sender as TEdit do
  SelLength := 0;
0
 

Author Comment

by:marksmall
ID: 6628352
SORRY ABOUT DELAY, BEEN POORLY AND COULD GET ACCESS TO MY COMPUTER!
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Can Viruses spread while transferring Binary data with Winsock 2 107
firemonkey keyboard covers the controls 1 83
Twebbrowser add css to the header 3 54
MS Access from Delphi 31 104
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question