Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как получить RTF из Word без буффера обмена?

01.01.2007
uses
  Word_TLB
, ActiveX, ComObj;
 
function GetRTFFormat(DataObject: IDataObject; var RTFFormat: TFormatEtc): Boolean;
var
 
Formats: IEnumFORMATETC;
 
TempFormat: TFormatEtc;
  pFormatName
: PChar;
 
Found: Boolean;
begin
 
try
   
OleCheck(DataObject.EnumFormatEtc(DATADIR_GET, Formats));
   
Found := False;
   
while (not Found) and (Formats.Next(1, TempFormat, nil) = S_OK) do
   
begin
      pFormatName
:= AllocMem(255);
     
GetClipBoardFormatName(TempFormat.cfFormat, pFormatName, 254);
     
if (string(pFormatName) = 'Rich Text Format') then
     
begin
       
RTFFormat := TempFormat;
       
Found := True;
     
end;
     
FreeMem(pFormatName);
   
end;
   
Result := Found;
 
except
   
Result := False;
 
end;
end;
 
function GetRTF: string;
var
 
DataObject: IDataObject;
 
RTFFormat: TFormatEtc;
 
ReturnData: TStgMedium;
 
Buffer: PChar;
 
WordDoc: _Document;
 
WordApp: _Application;
begin
 
Result := '';
 
try
   
GetActiveOleObject('Word.Application').QueryInterface(_Application, WordApp);
 
except
   
ShowMessage('Error: MSWord is not running');
   
Exit;
 
end;
 
if (WordApp <> nil) then
   
try
     
WordDoc := WordApp.ActiveDocument;
     
WordDoc.QueryInterface(IDataObject, DataObject);
     
if GetRTFFormat(DataObject, RTFFormat) then
     
begin
       
OleCheck(DataObject.GetData(RTFFormat, ReturnData));
       
//RTF is passed through global memory
       
Buffer := GlobalLock(ReturnData.hglobal);
       
//Buffer is a pointer to the RTF text
       
Result := StrPas(Buffer);
       
GlobalUnlock(ReturnData.hglobal);
       
ReleaseStgMedium(ReturnData);
     
end;
   
except
     
// Error occured...
   
end;
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
var
  ss
: TStringstream;
  rtfText
: string;
begin
  rtfText
:= GetRTF;
  ss
:= TStringStream.Create(rtfText);
 
try
    ss
.Position := 0;
    Memo1
.Text := rtfText;
    RichEdit1
.Lines.LoadFromStream(ss);
 
finally
    ss
.Free
 
end;
end;

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php