Взять RTF-текст из запущенного MS Word без использования буфера обмена

Delphi , Технологии , OLE Automation MSOffice

Оформил: 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;

 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;

Рецензия на код:

Функция GetRTFFormat Эта функция предназначена для извлечения формата RTF из объекта IDataObject. Она делает это, итерируя через все доступные форматы в объекте и проверяя, если какой-либо из них соответствует 'Rich Text Format'. Если она находит совпадение, она возвращает соответствующую структуру TFormatEtc.

Функция использует метод EnumFormatEtc для перечисления всех форматов в объекте, а затем итерирует через каждый формат с помощью метода Next. Для каждого формата она вызывает GetClipBoardFormatName для получения имени формата и проверяет, если оно соответствует 'Rich Text Format'. Если это так, она устанавливает переменную RTFFormat и возвращает True. В противном случае она продолжает итерацию до тех пор, пока не находит совпадение или не exhausted всех форматов.

Функция GetRTF Эта функция предназначена для извлечения текста RTF из активного документа MS Word. Она делает это следующим образом: 1. Получает текущий экземпляр MS Word с помощью GetActiveOleObject. 2. Проверяет объект приложения на наличие интерфейса _Document и получает ссылку на активный документ. 3. Проверяет объект документа на наличие интерфейса IDataObject и получает ссылку на него. 4. Вызывает функцию GetRTFFormat для извлечения формата RTF из объекта данных. 5. Если формат RTF найден, вызывает метод GetData для получения фактического текста RTF в виде объекта TStgMedium. 6. Закрывает глобальную память объекта TStgMedium и копирует текст RTF в буфер. 7. Открывает глобальную память и освобождает объект TStgMedium.

Функция возвращает текст RTF в виде строки.

Процедура Button1Click Эта процедура вызывается при клике кнопки и делает следующее: 1. Вызывает функцию GetRTF для извлечения текста RTF из активного документа MS Word. 2. Создает объект TStringStream с полученным текстом RTF. 3. Устанавливает текст в контроле Memo (Memo1) на полученный текст RTF. 4. Загружает текст RTF в rich edit control (RichEdit1).

Альтернативное решение Код quite сложен и использует несколько низкоуровневых интерфейсов COM. Еще более простым альтернативным решением будет использовать компонент TWordApp из пакета Delphi Word Automation Components, который предоставляет более высокоуровневый интерфейс для работы с документами MS Word.

Например, вы можете использовать следующий код для извлечения текста RTF из активного документа MS Word:

uses
  WordAutomationComponents;

procedure TForm1.Button1Click(Sender: TObject);
var
  WordApp: TWordApplication;
  Doc: TDocument;
begin
  WordApp := TWordApplication.Create(nil);
  try
    WordApp.Connect;
    Doc := WordApp.ActiveDocument;
    Memo1.Text := Doc.RTFText;
  finally
    WordApp.Disconnect;
    FreeAndNil(WordApp);
  end;
end;

Этот код создает экземпляр компонента TWordApplication, подключается к приложению MS Word, получает ссылку на активный документ и извлекает текст RTF из документа. Затем он отключается от приложения MS Word и освобождает компонент.

В статье описывается способ извлечения RTF-текста из запущенного MS Word без использования буфера обмена, используя делифо-центр.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: OLE Automation MSOffice ::