Как вставить RTF в Word?

Previous  Top  Next

    
 

 

 

Code:

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;

 

procedure WriteToMSWord(const RTFText: String);

var

WordDoc: _Document;

WordApp: _Application;

DataObj : IDataObject;

Formats : IEnumFormatEtc;

RTFFormat: TFormatEtc;

Medium : TStgMedium;

pGlobal : Pointer;

begin

   try

     GetActiveOleObject('Word.Application').QueryInterface(_Application, WordApp);

   except

     WordApp := CoWordApplication.Create;

   end;

   WordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);

   WordApp.Visible := True;

   WordDoc := WordApp.ActiveDocument;

   OleCheck(WordDoc.QueryInterface(IDataObject,DataObj));

   GetRTFFormat(DataObj, RTFFormat);

   FillChar(Medium,SizeOf(Medium),0);

   Medium.tymed := RTFFormat.tymed;

   Medium.hGlobal := GlobalAlloc(GMEM_MOVEABLE, Length(RTFText)+1);

   try

    pGlobal := GlobalLock(Medium.hGlobal);

    CopyMemory(PGlobal,PChar(RTFText),Length(RTFText)+1);

    GlobalUnlock(Medium.hGlobal);

    OleCheck(DataOBJ.SetData(RTFFormat,Medium,True));

   finally

     GlobalFree(Medium.hGlobal);

     ReleaseStgMedium(Medium);

   end;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

WriteToMSWord(Memo1.Text); // may be rtf-formatted text

end;

 

 

©Drkb::04434

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