Недавно добавленные исходники

•  TDictionary Custom Sort  522

•  Fast Watermark Sources  884

•  3D Designer  1 816

•  Sik Screen Capture  1 461

•  Patch Maker  1 470

•  Айболит (remote control)  1 393

•  ListBox Drag & Drop  1 168

•  Доска для игры Реверси  21 454

•  Графические эффекты  1 343

•  Рисование по маске  1 283

•  Перетаскивание изображений  1 094

•  Canvas Drawing  965

•  Рисование Луны  806

•  Поворот изображения  763

•  Рисование стержней  805

•  Paint on Shape  491

•  Генератор кроссвордов  755

•  Головоломка Paletto  662

•  Теорема Монжа об окружностях  846

•  Пазл Numbrix  611

•  Заборы и коммивояжеры  839

•  Игра HIP  552

•  Игра Go (Го)  525

•  Симулятор лифта  544

•  Программа укладки плитки  506

•  Генератор лабиринта  561

•  Проверка числового ввода  521

•  HEX View  597

•  Физический маятник  523

•  Задача коммивояжера  557

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Как отследить открытие и закрытие документов в приложении Microsoft Word



Автор: Nomadic

Новости геральдики: Барон Билл Гейтс, виконт Редмондский по прозвищу Мелкомягкий. В гербе на зеленом поле четыре окна лежащие пофигообразно. Щит поддерживается двумя фигурами ламеров с мышами в зубах. В тэмборе - виртуальный шлем SFX-1.

В копилку. Исходный код, FAQ - желающие могут взять с Internet сами (информация взята с http://www.softmosis.ca, проверено - работает).

Основной модуль, регистрация и вызов


...
public
  { Public declarations }
  FWordApp: _Application;
  FWordDoc: _Document;
  FWordSink: TWordConnection;
...

procedure StartWordConnection(WordApp: _Application;
  WordDoc: _Document;
  var WordSink: TWordConnection);
var
  PointContainer: IConnectionPointContainer;
  Point: IConnectionPoint;
begin
  try
    // TWordConnection is the COM object which receives the
    // notifications from Word. Make sure to free WordSink when
    // you are done with it.
    WordSink := TWordConnection.Create;
    WordSink.WordApp := WordApp;
    WordSink.WordDoc := WordDoc;

    // Sink with a Word application
    OleCheck(WordApp.QueryInterface(IConnectionPointContainer, PointContainer));
    if Assigned(PointContainer) then
    begin
      OleCheck(PointContainer.FindConnectionPoint(ApplicationEvents, Point));
      if Assigned(Point) then
        Point.Advise((WordSink as IUnknown), WordSink.AppCookie);
    end;

    // Sink with a Word document advise
    OleCheck(WordDoc.QueryInterface(IConnectionPointContainer, PointContainer));
    if Assigned(PointContainer) then
    begin
      OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, Point));
      if Assigned(Point) then
        Point.Advise((WordSink as IUnknown), WordSink.DocCookie);
    end;

  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

procedure TmainForm.btnStartClick(Sender: TObject);
begin
  FWordApp := CoApplication_.Create;
  FWordDoc := FWordApp.Documents.Add(EmptyParam, EmptyParam);
  FWordApp.Visible := True;
  StartWordConnection(FWordApp, FWordDoc, FWordSink);
end;

procedure TmainForm.btnExitClick(Sender: TObject);
begin
  FWordApp.Quit(EmptyParam, EmptyParam, EmptyParam);
end;

Модуль отслеживания линков


unit ConnectionObject;

interface

uses Word_TLB, dialogs;

type
  TWordConnection = class(TObject, IUnknown, IDispatch)
  protected
    {IUnknown}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    { IDispatch }
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
      stdcall;
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
        stdcall;

  public
    WordApp: _Application;
    WordDoc: _Document;
    AppCookie, DocCookie: Integer;
  end;

implementation

{ IUnknown Methods }

uses windows, activex, main;

procedure LogComment(comment: string);
begin
  Form1.Memo1.Lines.Add(comment);
end;

function TWordConnection._AddRef: Integer;
begin
  Result := 2;
end;

function TWordConnection._Release: Integer;
begin
  Result := 1;
end;

function TWordConnection.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  Result := E_NOINTERFACE;
  Pointer(Obj) := nil;
  if (GetInterface(IID, Obj)) then
    Result := S_OK;
  if not Succeeded(Result) then
    if (IsEqualIID(IID, DocumentEvents) or IsEqualIID(IID, ApplicationEvents))
      then
      if (GetInterface(IDispatch, Obj)) then
        Result := S_OK;
end;

{ IDispatch Methods }

function TWordConnection.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWordConnection.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Pointer(TypeInfo) := nil;
  Result := E_NOTIMPL;
end;

function TWordConnection.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Count := 0;
  Result := E_NOTIMPL;
end;

function TWordConnection.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  //This is the entry point for Word event sinking
  Result := S_OK;
  case DispID of
    1: ; // Startup
    2: ShowMessage('quit'); // Quit
    3: ; // Document change
    4: ; // New document
    5: ; // Open document
    6: ShowMessage('close'); // Close document
  else
    Result := E_INVALIDARG;
  end;
end;

end.





Похожие по теме исходники

Circle Word Wrap

Word List 1.5

Word Search in Text

Конвертер Word - HTML

 

Create document in Word

Golden Passwords

Work with Word and Excel

Grid Word Highlight

 



Copyright © 2004-2022 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter   Ссылка на Telegram