VPF::Как вставить RTF в Word? - Форум программистов

Poseidon

Дата 19.5.2005, 02:24 (ссылка)

(нет голосов)

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: нет
Всего: 133

Код

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;

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »