Delphi World - Вставить RTF-текст в документ MS Word
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Вставить RTF-текст в документ MS Word

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования