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;

 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;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.