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; 

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;

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

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

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