Export RTF-Textformat <> Word

Das folgende Beispiel zeigt, wie man das RTF-Textformat eines RichEdit am Word übermitteln kann.

Dazu müssen hier erst drei Librarys heruntergeladen werden.
https://github.com/kedkod999/Word_Lab/blob/master/VBIDE_TLB.pas

1. Word_TLB.pas
2. Office_TLB.pas
3. VBIDE_TLB.pas

uses ExtCtrls, Word_TLB, ActiveX, ComObj, Vcl.ComCtrls

//


// RTF to Word
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.Button1Click(Sender: TObject);
begin
  WriteToMSWord(RichEdit1.Text);
end;

Word to RTF:

uses ExtCtrls, Word_TLB, ComObj, Vcl.ComCtrls

//

function ConvertDoc2Rtf(var FileName: string) : Boolean;
var
  oWord: OleVariant;
  oDoc: OleVariant;
begin
  Result := False;
  try
    oWord := GetActiveOleObject('Word.Application');
  except
    oWord := CreateOleObject('Word.Application');
  end;
  oWord.Documents.Open(FileName);
  oDoc  := oWord.ActiveDocument;
  FileName := ChangeFileExt(FileName, '.rtf');
  oDoc.SaveAs(FileName);
  oWord.ActiveDocument.Close(wdDoNotSaveChanges, EmptyParam, EmptyParam);
  oWord.Quit(EmptyParam, EmptyParam, EmptyParam);
  oDoc := VarNull;
  oWord := VarNull;
  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var FileName : string;
begin
  if OpenDialog1.Execute then begin
  FileName := OpenDialog1.FileName;
    if ConvertDoc2Rtf(FileName) then
      begin
      ShowMessage('Word document has been converted to .rtf');
      RichEdit1.Lines.LoadFromFile(FileName);
    end;
  end;
end;