Буфер обмена

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

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;

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;

end;

end;

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;