Обычно, это нужно для того, чтобы запихнуть в буфер обмена данные собственного формата. Сначала необходимо зарегистрировать этот формат при помощи функции RegisterClipboardFormat():

 

CF_MYFORMAT := RegisterClipboardFormat('My Format Description');

 

Затем необходимо проделать следующие шаги:

1. Создать поток (stream) и записать в него данные.

2. Создать в памяти глобальный буфер и скопировать в него поток (stream).

3. При помощи Clipboard.SetAsHandle() поместить глобальный буфер в буфер обмена.

 

Буфер обмена имеет методы GetComponent и SetComponent, но нам нужно

для потоковой передачи нескольких компонентов в буфер обмена, чтобы включить тип вставки копирования

функции.

 

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

f: THandle;

buffer: array [0..MAX_PATH] of Char;

i, numFiles: Integer;

begin

if not Clipboard.HasFormat(CF_HDROP) then Exit;

Clipboard.Open;

try

   f := Clipboard.GetAsHandle(CF_HDROP);

   if f <> 0 then

   begin

     numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);

     memo1.Clear;

     for i := 0 to numfiles - 1 do

     begin

       buffer[0] := #0;

       DragQueryFile(f, i, buffer, SizeOf(buffer));

       memo1.Lines.Add(buffer);

     end;

   end;

finally

   Clipboard.Close;

end;

end;

 

 

 

Code:

uses

  clipbrd;

 

procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);

var

  hMem: THandle;

  pMem: Pointer;

begin

  Assert(Assigned(S));

  S.Position := 0;

  hMem       := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);

  if hMem <> 0 then

  begin

    pMem := GlobalLock(hMem);

    if pMem <> nil then

    begin

      try

        S.Read(pMem^, S.Size);

        S.Position := 0;

      finally

        GlobalUnlock(hMem);

      end;

      Clipboard.Open;

      try

        Clipboard.SetAsHandle(fmt, hMem);

      finally

        Clipboard.Close;

      end;

    end { If }

    else

    begin

      GlobalFree(hMem);

      OutOfMemoryError;

    end;

  end { If }

  else

    OutOfMemoryError;

end; { CopyStreamToClipboard }

 

procedure CopyStreamFromClipboard(fmt: Cardinal; S: TStream);

var

  hMem: THandle;

  pMem: Pointer;

begin

  Assert(Assigned(S));

  hMem := Clipboard.GetAsHandle(fmt);

  if hMem <> 0 then

  begin

    pMem := GlobalLock(hMem);

    if pMem <> nil then

    begin

      try

        S.Write(pMem^, GlobalSize(hMem));

        S.Position := 0;

      finally

        GlobalUnlock(hMem);

      end;

    end { If }

    else

      raise Exception.Create('CopyStreamFromClipboard: could not lock global handle ' +

        'obtained from clipboard!');

  end; { If }

end; { CopyStreamFromClipboard }

 

procedure SaveClipboardFormat(fmt: Word; writer: TWriter);

var

  fmtname: array[0..128] of Char;

  ms: TMemoryStream;

begin

  Assert(Assigned(writer));

  if 0 = GetClipboardFormatName(fmt, fmtname, SizeOf(fmtname)) then

    fmtname[0] := #0;

  ms := TMemoryStream.Create;

  try

    CopyStreamFromClipboard(fmt, ms);

    if ms.Size > 0 then

    begin

      writer.WriteInteger(fmt);

      writer.WriteString(fmtname);

      writer.WriteInteger(ms.Size);

      writer.Write(ms.Memory^, ms.Size);

    end; { If }

  finally

    ms.Free

  end; { Finally }

end; { SaveClipboardFormat }

 

procedure LoadClipboardFormat(reader: TReader);

var

  fmt: Integer;

  fmtname: string;

  Size: Integer;

  ms: TMemoryStream;

begin

  Assert(Assigned(reader));

  fmt     := reader.ReadInteger;

  fmtname := reader.ReadString;

  Size    := reader.ReadInteger;

  ms      := TMemoryStream.Create;

  try

    ms.Size := Size;

    reader.Read(ms.memory^, Size);

    if Length(fmtname) > 0 then

      fmt := RegisterCLipboardFormat(PChar(fmtname));

    if fmt <> 0 then

      CopyStreamToClipboard(fmt, ms);

  finally

    ms.Free;

  end; { Finally }

end; { LoadClipboardFormat }

 

procedure SaveClipboard(S: TStream);

var

  writer: TWriter;

  i: Integer;

begin

  Assert(Assigned(S));

  writer := TWriter.Create(S, 4096);

  try

    Clipboard.Open;

    try

      writer.WriteListBegin;

      for i := 0 to Clipboard.formatcount - 1 do

        SaveClipboardFormat(Clipboard.Formats[i], writer);

      writer.WriteListEnd;

    finally

      Clipboard.Close;

    end; { Finally }

  finally

    writer.Free

  end; { Finally }

end; { SaveClipboard }

 

procedure LoadClipboard(S: TStream);

var

  reader: TReader;

begin

  Assert(Assigned(S));

  reader := TReader.Create(S, 4096);

  try

    Clipboard.Open;

    try

      clipboard.Clear;

      reader.ReadListBegin;

      while not reader.EndOfList do

        LoadClipboardFormat(reader);

      reader.ReadListEnd;

    finally

      Clipboard.Close;

    end; { Finally }

  finally

    reader.Free

  end; { Finally }

end; { LoadClipboard }

 

 

 

// Examples:

 

{ Save Clipboard }

 

procedure TForm1.Button1Click(Sender: TObject);

var

  ms: TMemoryStream;

begin

  ms := TMemoryStream.Create;

  try

    SaveClipboard(ms);

    ms.SaveToFile('c:\temp\ClipBrdSaved.dat');

  finally

    ms.Free;

  end; { Finally }

end;

 

{ Clear Clipboard }

 

procedure TForm1.Button2Click(Sender: TObject);

begin

  clipboard.Clear;

end;

 

{ Restore Clipboard }

 

procedure TForm1.Button3Click(Sender: TObject);

var

  fs: TfileStream;

begin

  fs := TFilestream.Create('c:\temp\ClipBrdSaved.dat',

    fmopenread or fmsharedenynone);

  try

    LoadClipboard(fs);

  finally

    fs.Free;

  end; { Finally }

end;

 

 

Code:

procedure CopyStringToClipboard(s: string);

var

hg: THandle;

P: PChar;

begin

hg:=GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, Length(S)+1);

P:=GlobalLock(hg);

StrPCopy(P, s);

GlobalUnlock(hg);

OpenClipboard(Application.Handle);

SetClipboardData(CF_TEXT, hg);

CloseClipboard;

GlobalFree(hg);

end;

 

Сохранение буфера обмена в файл

 Процедура позволяет сохранить содержимое буфера обмена в заданый файл.

 P.S. На всякий случай: я не претендую на авторство  данного кода, я его просто привёл к виду, который мне больше подходил.

В эту базу я его выложил исходя из предположения, что не каждый, кому понадобится такая процедура знает вышеуказанный адрес или

обратится туда (сам долго искал иные способы).

У меня Windows NT/2000. Когда копирую текст на русском языке, скажем, из TMemo в Ворд 97/2000, то получаю в результате каракули. Эти каракули исправляются, если перед копированием насильно переключить клавиатуру пользователя на русский язык. Но если у него нет этой клавиатуры, или если лучше не переключать ее, то как можно сообщить системе, что мы будем копировать РУССКИЙ текст. На форме создается невидимый TRichEdit (я обозвал его TRE в коде). Далее текст копируется в клипборд как обычно, после чего вызывается следующая процедура

 

 

Code:

uses

ShlObj, ClipBrd;

 

procedure CopyFilesToClipboard(FileList: string);

var

DropFiles: PDropFiles;

hGlobal: THandle;

iLen: Integer;

begin

iLen := Length(FileList) + 2;

FileList := FileList + #0#0;

hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,

   SizeOf(TDropFiles) + iLen);

if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');

begin

   DropFiles := GlobalLock(hGlobal);

   DropFiles^.pFiles := SizeOf(TDropFiles);

   Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);

   GlobalUnlock(hGlobal);

   Clipboard.SetAsHandle(CF_HDROP, hGlobal);

end;

end;

 

// Example, Beispiel:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

CopyFilesToClipboard('C:\Bootlog.Txt'#0'C:\AutoExec.Bat');

end;

 

Столкнулся с проблемой вставки в Clipboard русского текста в Win2K, WinXP. Залез в DRKB.. Ну да, там вариант предложен довольно смешной (создать TRichEdit, вставить в него clipboard, весь текст пометить русским, и вернуть в clipboard)... Всё бы ничего, но если у меня программа без форм, да и без окон вообще, то TRichEdit не создаётся ('Control has no parent window') . Почитал хелп, посмотрел, что именно Вынь сует в буфер на разных языках, и нашёл простой и красивый способ. Имхо, ему там и место - в разделе "Буфер обмена".
 

Вот общее решение, которое будет работать, даже если у вас размер файла превышает 64Кб:

 Надо пробовать.

Под Win2k попытка вставить русскую строку в Clipboard  ClipBoard.AsText:='Проба' с последующей вставкой в Word'е

показывает кракозябрики.. Расследование показало, что  виноваты мелкомягкие (как обычно :) ) С целью нивелирования различий между

всеми Win-платформами были написаны эти 2 ф-ции.. Принимают на вход/возвращают строку в Unicode - WideString..

но не надо беспокоиться, Дельфи сам вставит при необходимости конвертацию в/из AnsiString.

 

Если платформа поддерживает уникод (NT), то используется этот формат, иначе вызываются стандартные процедуры/ф-ции.

Удачи!