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

Code:

Var

  CF_RTF : Word;

  CF_RTF := RegisterClipboardFormat('Rich Text Format');

{

The format name has to appear as typed above, this is the name used by MS

Word for Windows and similar MS products.

NOTE: The Richedit Unit declares a constant CF_RTF, which is NOT the

clipboard format handle but the string you need to pass to RegisterClipboard

format! So you can place Richedit into your uses clause and change the line

above to

}

  CF_RTF := RegisterClipboardFormat(Richedit.CF_RTF);

{

The next step is to build a RTF string with the embedded format information.

You will get a shock if you inspect the mess of RTF stuff W4W will put into

the clipboard if you copy just a few characters (the app below allows you to

inspect the clipboard), but you can get away with a lot less. The bare

minimum would be something like this (inserts an underlined 44444):

}

const

  testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}';

{

The correct balance of opening and closing braces is extremely important, one

mismatch and the target app will not be able to interpret the text

correctly. If you want to control the font used for the pasted text you need

to add a fonttable (the default font is Tms Rmn, not the active font in the

target app!). See example app below, testtext2. If you want more info, the

full RTF specs can be found on www.microsoft.com, a subset is also described

in the Windows help compiler docs (hcw.hlp, comes with Delphi).

}

unit Clipfmt1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    MemFormats: TMemo;

    label1: TLabel;

    BtnShowFormats: TButton;

    BtnGetRTF: TButton;

    BtnSetRTF: TButton;

    MemExample: TMemo;

    procedure FormCreate(Sender: TObject);

    procedure BtnShowFormatsClick(Sender: TObject);

    procedure BtnGetRTFClick(Sender: TObject);

    procedure BtnSetRTFClick(Sender: TObject);

  private

  public

    CF_RTF: Word;

  end;

var

  Form1: TForm1;

implementation

uses Clipbrd;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

  // register clipboard format rtf

CF_RTF := RegisterClipboardFormat('Rich Text Format');

  if CF_RTF = 0 then

  begin

    ShowMessage('Unable to register the Rich Text clipboard format!');

    Application.Terminate;

  end;

  BtnShowFormats.Click;

end;

// show clipboard formats

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 := 'private format';

        $0300..$03FF: Name := 'GDI object';

        else

          Name := 'unknown format';

      end;

      MemFormats.Lines.Add(Name);

    end;

  end;

end;

// get rtf code from clipboard

procedure TForm1.BtnGetRTFClick(Sender: TObject);

var

  MemHandle: THandle;

begin

  with Clipboard do

  begin

    Open;

    try

      if HasFormat(CF_RTF) then

      begin

        MemHandle := GetAsHandle(CF_RTF);

        MemExample.SetTextBuf(GlobalLock(MemHandle));

        GlobalUnlock(MemHandle);

      end

      else

        MessageDlg('The clipboard contains no RTF text!',

          mtError, [mbOK], 0);

    finally

      Close;

    end;

  end;

end;

// set rtf code to the clipboard

procedure TForm1.BtnSetRTFClick(Sender: TObject);

const

  testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}';

  testtext2: PChar = '{\rtf1\ansi' +

    '\deff4\deflang1033{\fonttbl{\f4\froman\fcharset0\fprq2 Times New Roman;}}' +

    '\pard\plain 12{\ul 44444}}';

  flap: Boolean = False;

var

  MemHandle: THandle;

  rtfstring: PChar;

begin

  with Clipboard do

  begin

    if flap then

      rtfstring := testtext2

    else

      rtfstring := testtext;

    flap := not flap;

    MemHandle := GlobalAlloc(GHND or GMEM_SHARE, StrLen(rtfstring) + 1);

    if MemHandle <> 0 then

    begin

      StrCopy(GlobalLock(MemHandle), rtfstring);

      GlobalUnlock(MemHandle);

      Open;

      try

        AsText := '1244444';

        SetAsHandle(CF_RTF, MemHandle);

      finally

        Close;

      end;

    end

    else

      MessageDlg('Global Alloc failed!',

        mtError, [mbOK], 0);

  end;

end;

end.