Буфер обмена

Буфер обмена (Clipboard) и TMemoryStream

2017-10-19T21:09:31+07:00

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

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

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

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

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

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

Подробнее...

Как скопировать содержимое строки в буфер обмена?

2017-10-19T21:22:45+07:00

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;

Подробнее...

Как скопировать файл в Windows clipboard?

2017-10-19T21:20:13+07:00

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;

// Example, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

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

end;

Копирование большого файла в буфер обмена

2017-10-19T21:21:17+07:00

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

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

Подробнее...

Копирование потока компонент в буфер обмена

2017-10-19T21:13:01+07:00

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

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

функции.

Подробнее...

Копировать RTF-текст в буфер обмена

2017-10-19T21:29:09+07:00

Вам придется копаться в Формат rtf, если вы хотите скопировать текст буфер обмена, который имеет встроенную информацию формата. Приложение, которое вы вставляете

этот текст в должен понимать RTF, или форматирование не будет отображаться.

ОК, первый шаг-это зарегистрировать Формат буфера обмена в формате rtf, так как это не предопределенный формат:

Подробнее...

Копировать буфер в поток и обратно

2017-10-19T21:13:45+07:00

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;

Копируем русский текст в буфер обмена в Windows2000

2017-10-19T21:23:31+07:00

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

Подробнее...

Получаем имена файлов, скопированных в буфер обмена

2017-10-19T21:21:50+07:00

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;

finally

Clipboard.Close;

end;

Поместить/получить строку из буфера обмена (Заплатка к стандартным)

2017-10-19T21:27:32+07:00

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

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

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

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

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

Удачи!

Подробнее...

Сохранение всего содержимого буфера обмена в файл

2017-10-19T21:19:34+07:00

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

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

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

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

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

Подробнее...

Указание языка помещенного в clipboard текста

2017-10-19T21:25:25+07:00

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

Подробнее...

TPaintBox в буфер обмена

2017-10-20T00:14:40+07:00

Code:

var

pbRect: TRect;

begin

pbRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);

BitMap := TBitMap.Create;

try

Bitmap.Width := PaintBox1.Width;

Bitmap.Height := PaintBox1.Height;

BitMap.Canvas.CopyRect(pbRect, PaintBox1.Canvas, pbRect);

ClipBoard.Assign(BitMap);

finally

BitMap.Free;

end;

Вставка содержимого буфера как картинку в RTF

2017-10-20T00:15:51+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

b : tbitmap;

fr: TFormatRange;

r : TRect;

begin

b:=tbitmap.create;

b.width:=rxrichedit1.width;

b.height:=rxrichedit1.height;

r:=rect(0,0,RXRichEdit1.Width*screen.Pixelsperinch,

RXRichEdit1.Height*screen.Pixelsperinch);

fr.hdc:=b.Canvas.handle;

fr.hdctarget:=b.Canvas.handle;

fr.rc:=r;

fr.rcpage:=r;

fr.chrg.cpMin:=0;

fr.chrg.cpMax:=-1;

Sendmessage(RXRichEdit1.handle,EM_FORMATRANGE,1,longint(@fr));

image1.Picture.assign(b);

b.free;

end;

Встроенные форматы буфера обмена

2017-10-20T00:16:41+07:00

Code:

procedure TForm1.BtnShowFormatsClick(Sender: TObject);

var

buf: array[0..60] of Char;

n: Integer;

fmt: Word;

name: string[30];

begin

MemFormats.Clear;

for n := 0 to Clipboard.FormatCount - 1 do

begin

fmt := Clipboard.Formats[n];

if GetclipboardFormatName(fmt, buf, Pred(Sizeof(buf))) <> 0 then

MemFormats.Lines.Add(StrPas(buf))

else

begin

case fmt of

1: name := 'CF_TEXT';

2: name := 'CF_BITMAP';

3: name := 'CF_METAFILEPICT';

4: name := 'CF_SYLK';

5: name := 'CF_DIF';

6: name := 'CF_TIFF';

7: name := 'CF_OEMTEXT';

8: name := 'CF_DIB';

9: name := 'CF_PALETTE';

10: name := 'CF_PENDATA';

11: name := 'CF_RIFF';

12: name := 'CF_WAVE';

13: name := 'CF_UNICODETEXT';

14: name := 'CF_ENHMETAFILE';

15: name := 'CF_HDROP (Win 95)';

16: name := 'CF_LOCALE (Win 95)';

17: name := 'CF_MAX (Win 95)';

$0080: name := 'CF_OWNERDISPLAY';

$0081: name := 'CF_DSPTEXT';

$0082: name := 'CF_DSPBITMAP';

$0083: name := 'CF_DSPMETAFILEPICT';

$008E: name := 'CF_DSPENHMETAFILE';

$0200..$02FF: name := 'частный формат';

$0300..$03FF: name := 'Объект GDI';

else

name := 'неизвестный формат';

end;

MemFormats.Lines.Add(name);

end;

Добавление текста в буфер обмена без использования модуля Clipbrd

2017-10-20T00:08:14+07:00

Пример использования:

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

SetClipboardText(Handle, 'qwerty');

end;

Подробнее...

Как копировать векторное изображение?

2017-10-20T00:09:17+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

mf: TMetaFile;

mfc: TMetaFileCanvas;

i: integer;

ClipBrdFormat: word;

data: cardinal;

palette: hPalette;

p: array [0..90] of TPoint;

begin

mf := TMetaFile.Create;

mf.Width := 100;

mf.Height := 100;

mfc := TMetafileCanvas.Create(mf, 0);

with mfc do

begin

Pen.Color := clBlack;

FrameRect(ClipRect);

MoveTo(0, 50);

LineTo(100, 50);

LineTo(95, 48);

MoveTo(100, 50);

LineTo(95, 52);

MoveTo(50, 100);

LineTo(50, 0);

LineTo(48, 5);

MoveTo(50, 0);

LineTo(52, 5);

Brush.Style := bsClear;

Font.name := 'arial';

Font.Size := 6;

TextOut(55, 0, 'Y');

TextOut(95, 38, 'X');

Pen.Color := clRed;

for i := low(p) to high(p) do

p[i] := Point(i, round(50 - 30 * sin((i - 50) / 5)));

Polyline(p);

end;

mfc.Free;

mf.SaveToClipboardFormat(ClipBrdFormat, data, palette);

OpenClipboard(Application.Handle);

EmptyClipboard;

SetClipboardData(ClipBrdFormat, data);

CloseClipboard;

mf.Inch := 200;

Form1.Canvas.Draw(0, 0, mf);

mf.Free;

end;

Как копировать и вставлять картинки через буфер обмена?

2017-10-20T00:13:17+07:00

Как копировать и вставлять картинки через буфер обмена?

Previous Top Next

Некоторые функции для копирования и вставки Bitmap-объектов через буфер обмена.

Подробнее...

Как копировать/менять Clipboard text без использования VCL?

2017-10-20T00:01:58+07:00

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;

Подробнее...

Копирование и вставка данных своего формата из буфера обмена

2017-10-20T00:21:21+07:00

TClipboard обеспечивает легкий доступ к буферу обмена. Но что делать, если вы хотите добавить (несколько) определенных элементов в буфер обмена?

Для всех действий требуется unit Clipboard.

Подробнее...

Скопировать изображение формы

2017-10-20T00:15:13+07:00

Code:

uses clipbrd;

procedure TShowVRML.Kopieren1Click(Sender: TObject);

var

bitmap: tbitmap;

begin

bitmap := tbitmap.create;

bitmap.width := clientwidth;

bitmap.height := clientheight;

try

with bitmap.Canvas do

CopyRect(clientrect, canvas, clientrect);

clipboard.assign(bitmap);

finally

bitmap.free;

end;

Hook на буфер обмена

2017-10-19T20:23:39+07:00

*Просто создайте новую форму и назовите его ClipFormats.

*Поместите TButton и вызывай его btnUpdate.

*Поместите лист бокс и вызывай его lbFormats.

Затем просто добавьте приведенный ниже код и подключить все обработчики событий.

Все это делает дисплей в настоящее время все форматы в буфере обмена и

обновления как только изменения буфера обмена.

Подробнее...

Использование интерфейса OLE

2017-10-19T20:10:37+07:00

Использование интерфейса OLE

Значение, которое придается сегодня внедрению интерфейса OLE, трудно переоценить. Фирма Microsoft извещает о том, что на получение логотипа "Windows 95 Compatible" будут сертифицированы только те приложения, которые имеют средства работы с OLE.

Разъяснять суть механизмов OLE с точки зрения пользователя здесь не имеет смысла; кратко опишем их с точки зрения программиста.

Подробнее...

Как программно реализовать Cut, Copy и Paste?

2017-10-19T19:28:31+07:00

Следущие операции производятся с активным контролом на форме:

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;

Если Вы разрабатываете приложение MDI, то необходимо отправлять сообщение в активное дочернее окно, т.е. использовать: ActiveMDIChild.ActiveControl.Handle

Как работать с буфером обмена (clipboard)?

2017-10-19T18:58:30+07:00

Этот пример использует картинку, кнопку и компонент shape на форме. Когда пользователь кликает по кнопке, то изображение формы сохраняется в в переменной FormImage и копируется в буфер обмена (Clipboard). Затем изображение формы копируется обратно в компонент картинки, тем самым создавая интересный эффект, особенно, если кнопку понажимать несколько раз.

Подробнее...

Как удобнее работать с буфером обмена как с последовательностью байт?

2017-10-19T19:36:06+07:00

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.

Alexey Mahotkin alexm@hsys.msk.ru (2:5020/433)

Взято из FAQ: Delphi and Windows API Tips'n'Tricks

olmal@mail.ru

Контроль за изменением содержимого буфера обмена

2017-10-19T19:49:06+07:00

Приложение может быть уведомлено об изменениях в данных, хранящихся в

Буфер обмена Windows, зарегистрировавшись как средство просмотра буфера обмена.

Подробнее...

Копирование в буфер обмена

2017-10-19T19:27:51+07:00

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;

Копировать и вставлять ячейки TStringGrid в буфер обмена

2017-10-19T20:33:07+07:00

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;

Подробнее...

Предотвратить работу с командами буфера обмена в TEdit

2017-10-19T20:31:36+07:00

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;

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;

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;

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.

Просмотр буфера обмена

2017-10-19T20:17:02+07:00

Просмотр буфера обмена.

Пример на основе простого модуля-класса, осуществляющего просмотр буфера обмена.

Подробнее...

Скопировать HTML-код в буфер обмена

2017-10-19T20:29:27+07:00

Если вы когда-нибудь пробовали вставлять html в буфер обмена, используя обычный CF_TEXT

формате, то вы, возможно, были разочарованы, обнаружив, что визуальный HTML-код

редакторы вставляют ваше предложение, как если бы это был только текст,

вместо того, чтобы распознавать его как html. Для этого нужен формат CF_HTML.

CF_HTML полностью текстовый формат и использует формат преобразования UTF-8.

Он включает в себя описание контекста, и в контексте фрагмента.

Подробнее...

Скопировать строки TListBox в буфер обмена

2017-10-19T20:32:11+07:00

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;

Сохранение данных в Clipboard

2017-10-19T20:30:45+07:00

Мне нужно использовать clipboard для сохранения данных в собственном формате и я хочу для этого написать набор процедур ввода/вывода с использованием потоков (streams). Возможно ли создать объект TMemoryStream, эаполнить его и поместить в Clipboard?

Hе только возможно, именно так поступают функции Clipboard.GetComponent и Clipboard.SetComponent. Сначала вы должны зарегистрировать свой собственный формат данных для Clipboard с помощью функции RegisterClipboardFormat:

Подробнее...

Сэмулировать нажатие клавиш для копии и вставки из буфера

2017-10-19T20:26:02+07:00

Code:

//Ctrl+C, Strg+C:

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);

keybd_event(Ord('C'), MapVirtualKey(Ord('C'), 0), 0, 0);

keybd_event(Ord('C'), MapVirtualKey(Ord('C'), 0), KEYEVENTF_KEYUP, 0);

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0)

//Ctrl+V, Strg+V:

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);

keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), 0, 0);

keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), KEYEVENTF_KEYUP, 0);

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0)