Code:

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, Clipbrd, ComCtrls;

type

TForm1 = class(TForm)

   memformats: TMemo;

   memexample: TMemo;

   Label1: TLabel;

   BtnShowFormats: TButton;

   btngetrtf: TButton;

   btnsetrtf: TButton;

   RichEdit1: TRichEdit;

   procedure FormCreate(Sender: TObject);

   procedure BtnShowFormatsClick(Sender: TObject);

   procedure btngetrtfClick(Sender: TObject);

   procedure btnsetrtfClick(Sender: TObject);

private

   { Private declarations }

public

   CF_RTF: Word;

end;

var

Form1: TForm1;

implementation

{$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;

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;

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;

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 Cyr;}}' + 

   '\pard\plain 12{\ul апопьт4}}';

var

MemHandle: THandle;

rtfstring: PChar;

begin

with Clipboard do

begin

   rtfstring :=memexample.Lines.GetText;

//    rtfstring :=testtext;

   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.