Code:

procedure TForm1.Cut1Click(Sender: TObject);

begin

SendMessage (ActiveControl.Handle, WM_Cut, 0, 0);

end;

procedure TForm1.Copy1Click(Sender: TObject);

begin

SendMessage (ActiveControl.Handle, WM_Copy, 0, 0);

end;

procedure TForm1.Paste1Click(Sender: TObject);

begin

SendMessage (ActiveControl.Handle, WM_Paste, 0, 0);

end;

Code:

uses

  Clipbrd;

//Copy

procedure TForm1.Button1Click(Sender: TObject);

var

  S: string;

  GRect: TGridRect;

  C, R: Integer;

begin

  GRect := StringGrid1.Selection;

  S  := '';

  for R := GRect.Top to GRect.Bottom do

  begin

    for C := GRect.Left to GRect.Right do

    begin

      if C = GRect.Right then S := S + (StringGrid1.Cells[C, R])

      else

        S := S + StringGrid1.Cells[C, R] + #9;

    end;

    S := S + #13#10;

end;

  ClipBoard.AsText := S;

end;

// Paste

procedure TForm1.Button2Click(Sender: TObject);

var

  Grect: TGridRect;

  S, CS, F: string;

  L, R, C: Byte;

begin

  GRect := StringGrid1.Selection;

  L := GRect.Left;

  R := GRect.Top;

  S := ClipBoard.AsText;

  R := R - 1;

  while Pos(#13, S) > 0 do

  begin

    R  := R + 1;

    C  := L - 1;

    CS := Copy(S, 1,Pos(#13, S));

    while Pos(#9, CS) > 0 do

    begin

      C := C + 1;

      if (C <= StringGrid1.ColCount - 1) and (R <= StringGrid1.RowCount - 1) then

        StringGrid1.Cells[C, R] := Copy(CS, 1,Pos(#9, CS) - 1);

      F := Copy(CS, 1,Pos(#9, CS) - 1);

      Delete(CS, 1,Pos(#9, CS));

    end;

    if (C <= StringGrid1.ColCount - 1) and (R <= StringGrid1.RowCount - 1) then

      StringGrid1.Cells[C + 1,R] := Copy(CS, 1,Pos(#13, CS) - 1);

    Delete(S, 1,Pos(#13, S));

    if Copy(S, 1,1) = #10 then

      Delete(S, 1,1);

  end;

end;

Code:

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.

Code:

unit ClipStrm;

interface uses Classes, Windows;

type

TClipboardStream = class(TStream)

private

   FMemory : pointer;

   FSize : longint;

   FPosition : longint;

   FFormat : word;

public

   constructor Create(fmt : word);

   destructor Destroy; override;

   function Read(var Buffer; Count : Longint) : Longint; override;

   function Write(const Buffer; Count : Longint) : Longint; override;

   function Seek(Offset : Longint; Origin : Word) : Longint; override;

end;

implementation uses SysUtils;

constructor TClipboardStream.Create(fmt : word);

var

tmp : pointer;

FHandle : THandle;

begin

FFormat := fmt;

OpenClipboard(0);

FHandle := GetClipboardData(FFormat);

FSize := GlobalSize(FHandle);

FMemory := AllocMem(FSize);

tmp := GlobalLock(FHandle);

MoveMemory(FMemory, tmp, FSize);

GlobalUnlock(FHandle);

FPosition := 0;

CloseClipboard;

end;

destructor TClipboardStream.Destroy;

begin

FreeMem(FMemory);

end;

function TClipboardStream.Read(var Buffer; Count : longint) : longint;

begin

if FPosition + Count > FSize then

Result := FSize - FPosition

else

Result := Count;

MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);

Inc(FPosition, Result);

end;

function TClipboardStream.Write(const Buffer; Count : longint) : longint;

var

FHandle : HGlobal;

tmp : pointer;

begin

ReallocMem(FMemory, FPosition + Count);

MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);

FPosition := FPosition + Count;

FSize := FPosition;

FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);

try

tmp := GlobalLock(FHandle);

try

   MoveMemory(tmp, FMemory, FSize);

   OpenClipboard(0);

   SetClipboardData(FFormat, FHandle);

finally

   GlobalUnlock(FHandle);

end;

CloseClipboard;

except

GlobalFree(FHandle);

end;

Result := Count;

end;

function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;

begin

case Origin of

0 : FPosition := Offset;

1 : Inc(FPosition, Offset);

2 : FPosition := FSize + Offset;

end;

Result := FPosition;

end;

end.

Code:

procedure CopyButtonClick(Sender: TObject);

begin

if ActiveControl is TMemo then

   TMemo(ActiveControl).CopyToClipboard;

if ActiveControl is TDBMemo then

   TDBMemo(ActiveControl).CopyToClipboard;

if ActiveControl is TEdit then

   TEdit(ActiveControl).CopyToClipboard;

if ActiveControl is TDBedit then

   TDBedit(ActiveControl).CopyToClipboard;

end;

procedure PasteButtonClick(Sender: TObject);

begin

if ActiveControl is TMemo then

   TMemo(ActiveControl).PasteFromClipboard;

if ActiveControl is TDBMemo then

   TDBMemo(ActiveControl).PasteFromClipboard;

if ActiveControl is TEdit then

   TEdit(ActiveControl).PasteFromClipboard;

if ActiveControl is TDBedit then

   TDBedit(ActiveControl).PasteFromClipboard;

end;

Code:

uses

  Clipbrd;

procedure ListBoxToClipboard(ListBox: TListBox;

  BufferSize: Integer;

  CopyAll: Boolean);

var

  Buffer: PChar;

  Size: Integer;

  Ptr: PChar;

  I: Integer;

  Line: string[255];

  Count: Integer;

begin

  if not Assigned(ListBox) then

    Exit;

  GetMem(Buffer, BufferSize);

  Ptr   := Buffer;

  Count := 0;

  for I := 0 to ListBox.Items.Count - 1 do

  begin

    Line := ListBox.Items.strings[I];

    if not CopyAll and ListBox.MultiSelect and (not ListBox.Selected[I]) then

      Continue;

    { Check buffer overflow }

    Count := Count + Length(Line) + 3;

    if Count = BufferSize then

      Break;

    { Append to buffer }

    Move(Line[1], Ptr^, Length(Line));

    Ptr    := Ptr + Length(Line);

    Ptr[0] := #13;

    Ptr[1] := #10;

    Ptr    := Ptr + 2;

  end;

  Ptr[0] := #0;

  ClipBoard.SetTextBuf(Buffer);

  FreeMem(Buffer, BufferSize);

end;

procedure ClipboardToListBox(ListBox: TListbox);

begin

  if not Assigned(ListBox) then

    Exit;

  if not Clipboard.HasFormat(CF_TEXT) then

    Exit;

  Listbox.Items.Text := Clipboard.AsText;

end;

//Copy all items from Listbox1 to the clipboard

procedure TForm1.Button1Click(Sender: TObject);

begin

  ListBoxToClipboard(ListBox1, 1024, True);

end;

//Paste items in clipboard to Listbox2

procedure TForm1.Button2Click(Sender: TObject);

begin

  ClipboardToListBox(Listbox2);

end;

//Copy only selected items from Listbox1 to the clipboard

procedure TForm1.Button3Click(Sender: TObject);

begin

  ListBoxToClipboard(Listbox1, 1024, False);

end;