How to get event from OLE-automation

[kyaoga]

I ' m using  olevariant to run  powerpoint.   

as Code

Code: [Select]

    oPPt := CreateOleObject('PowerPoint.Application');

    oPPt.Visible := True;
    oPPt.Presentations.Open(filenameLoad, True, False, True);


    screenClasshWnd := FindWindow('screenClass', nil);
    Windows.SetParent(screenClasshWnd, Panel1.Handle);
    oPPt.ActivePresentation.SlideShowSettings.Run;  //  Slide show
    Self.Show;




I need method that get thing when  this powerpoint changed their  slide.


Somebody help me.


//////////////   note  that   //////////////////////////////////
/////////////////////////////////////////////////////////////
***** 
Link of Microsoft reference is
[ "https://msdn.microsoft.com/en-us/library/aa271939(v=office.11).aspx"]   *****

////////////////////////////////////////////////////////////////

[Mike.Cornflake]

Short answer: No idea :-(

Longer answer: 
The second answer posted here tells me this is probably a nightmare task if you want to persist with CreateOleObject
http://stackoverflow.com/questions/14581459/handling-quit-event-from-word-in-delphi

Although I've never done this, suspect an easier solution is to use LazActiveX
http://wiki.lazarus.freepascal.org/LazActiveX

In particular, this example includes an event hookup...
http://wiki.lazarus.freepascal.org/LazActiveX#TActiveXContainer_early_binding

Hope this helps, but please bear in mind my answer contains only guesses :-)

[kyaoga]

Dear  Mike.Cornflake

I have  try this http://stackoverflow.com/questions/14581459/handling-quit-event-from-word-in-delphi but I cannot compile on

Code: [Select]

  TEventSink = class(TObject, IUnknown, IDispatch) <-- 

in lazarus already has  TEventSink / TAbstractEventSink  in unit EventSink. 
I don't know how to use TEventSink for asynchronous task programming or on Invoke  event. 
Please help me  how to implement it


However I ' ll try LazActiveX later.

[Timewarp]

I have  try this http://stackoverflow.com/questions/14581459/handling-quit-event-from-word-in-delphi but I cannot compile

It compiles here with these changes (I use FPC trunk)

Rename unit. Change QueryInterface: const -> constref. Add mode delphi. Cast FCookie to longword

[kyaoga]

Thank you so much.    Timewarp



I 'll try more code.   

[kyaoga]

Now , I have tried
http://stackoverflow.com/questions/14581459/handling-quit-event-from-word-in-delphi
It works when I follows   Timewarp's Advise  for   Compile on  Ms-Word ,  However   When I  implement to Powerpoint   it dosen't work   becaouse  of   Wrong  TGUID   ,


So  Which      TGUID    is matching   to Ms-PPT ???

[ChrisF]

{91493441-5A91-11CF-8700-00AA0060263B}   (Sorry, I can't test it) ?

Anyway, have you tried instead to get it from the COM Class APIs ?
https://support.microsoft.com/en-us/kb/196776

Something like :

Code: [Select]

uses Windows, ActiveX, ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var myResult: HResult;
var myCLSID: TCLSID;
var ProgID: widestring;
var myCLSIDStr: widestring;
begin
//  CoInitialize(nil);    // Done inside ComObj

  ProgID := 'PowerPoint.Application';
//  ProgID := 'Word.Application';
//  ProgID := 'InternetExplorer.Application';
  myResult := CLSIDFromProgID(PWideChar(progID), myCLSID);
  if myResult <> S_OK then
    begin
      Showmessage('** ERROR CLSIDFromProgID **  ( Error: '+IntToHex(myResult,8)+')');
      Exit;
    end;
  myCLSIDStr := GUIDToString(myCLSID);
  Showmessage('CLSID = ' + UTF8Encode(myCLSIDStr));

//  CoUninitialize;    // Done inside ComObj
end;

Or from the registry (I guess this should give the same answer) ?
https://support.microsoft.com/en-us/kb/240794


*** EDIT ***

Eventually, make a try too with 'PowerPoint.Slide' as a ProgID for only a show ?

See: https://support.microsoft.com/en-us/kb/228995

[kyaoga]

Thank you so much ChrisF.


I have tried Your code, It works to get GUID.

when I implement to my Code, It doesn't work.
maybe I have misunderstand about  programming with using EventSink , OLE Object , IDispatch .   

[Mike.Cornflake]

Um...

I didn't post that Word code as I thought it could be used verbatim :-(   I posted it as an example of how tricky this would be to implement.

Longer answer: 
The second answer posted here tells me this is probably a nightmare task if you want to persist with CreateOleObject
http://stackoverflow.com/questions/14581459/handling-quit-event-from-word-in-delphi

However, I've now spent 30 minutes playing with LazActiveX, and I can't produce a compilable _TLB for PowerPoint.  For some reason, a dependent _TLB is required "VBIDE_5_3_TLB" that I seem to lack the DLL's for.

Has anyone successfully used LazActiveX for PowerPoint 14 (well, specifically Import Type Library)? (Office 2010) 

In the meantime then:  @kyaoga  Can you please post your code to date?  Might be easier just to see if we can get that working...

[ChrisF]

If your test was working for Word (apparently, it was the case, considering one of your former post), there is a good chance it's also working for PowerPoint.

But of course you must use the correct ProgID and CLSID.

For instance, in the link given by Mike.Cornflake, Nono's answer (i.e. code) is working only for Word 2010+:

Code: [Select]

...
  IApplicationEvents = interface(IDispatch)
    ['{000209F7-0000-0000-C000-000000000046}']
...
  // instantiate Word
    FWordApp := CreateOleObject('Word.Application.14');
...

Unless I'm wrong, it won't work with an older version of Word (i.e. before Word 2010), which uses Word.Application.8 or Word.Application.12 (I'm not sure to remember the correct versions and numbers). The ProgIDs are different and the corresponding CLSIDs too.

That's why it's more preferable to use a 'generic' ProgID, like 'Word.Application' or 'PowerPoint.Application', and to use also the corresponding CLSID to these 'generic' ProgIDs.

So, what have used on your code ?  Which CLSID and which ProgID exactly ? Do you have the correct answers from your OLE API calls ?



*** EDIT ***

Mike.Cornflake has given some other advises to you (during my own post writing), and as for him, I'd like to see your own test code.

[kyaoga]

This is my Code that success for word is version ms-word 2003 but not Success for Ms-PPT 2003

unit__   Object_EventSink

Code: [Select]

unit UeventsSink_PPT;

interface

{$mode objfpc}

uses
   Dialogs,
   ActiveX, windows, ComObj, SysUtils;

type

   ////  I Changed ProgID and CLSID.
   IApplicationEvents = interface(IDispatch)
      ['{64818D11-4F9B-11CF-86EA-00AA00B929E8}']// PPt - Slide    <--  Get from ChrisF Code
      //['{91493441-5A91-11CF-8700-00AA0060263B}']// PPt - Application  <-- Get from ChrisF Code
      //['{91493463-5A91-11CF-8700-00AA0060263B}']//IID_PresEvents  <-- from Import Type Library
      //['{9149346D-5A91-11CF-8700-00AA0060263B}']//IID_SldEvents <-- from Import Type Library
      //['{914934C1-5A91-11CF-8700-00AA0060263B}']//IID_OCXExtenderEvents <-- from Import Type Library
      //['{914934D2-5A91-11CF-8700-00AA0060263B}']//IID_MasterEvents <-- from Import Type Library

      //['{000209F7-0000-0000-C000-000000000046}'] // <-- MS-Word Application   [From Mike.Cornflake  Link]

      //procedure Quit; safecall;
   end;

   TApplicationEventsQuitEvent = procedure (Sender : TObject) of object;
   TPowerPointApplicationWindowSelectionChange = procedure(ASender: TObject; const Sel: variant) of object;

   TPowerpointEventSink = class(TObject, IUnknown, IDispatch)
      private
         FCookie : integer;
         FSinkIID : TGUID;
         FQuit : TApplicationEventsQuitEvent;
         FSlideChanged : TPowerPointApplicationWindowSelectionChange;
         // IUnknown methods
         function _AddRef: Integer; stdcall;
         function _Release: Integer; stdcall;
         function QueryInterface(constref IID: TGUID; out Obj): HResult; stdcall;
         // IDispatch methods
         function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
         function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;     stdcall;
     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
           NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flag: Word;
           var Params; VarResult, ExceptInfo, ArgErr: Pointer): HResult; stdcall;
  protected
     FCP : IConnectionPoint;
     FSource : IUnknown;
     procedure DoQuit; stdcall;
     procedure DoChangeSlide; stdcall;
  public
     constructor Create;

     procedure Connect (pSource : IUnknown);
     procedure Disconnect;

     property Quit : TApplicationEventsQuitEvent read FQuit write FQuit;
     property SlideChanged : TPowerPointApplicationWindowSelectionChange read FSlideChanged write FSlideChanged;
   end;


implementation

function TPowerpointEventSink.QueryInterface(constref IID: TGUID; out Obj): HResult; stdcall;
begin
  if GetInterface(IID, Obj) then
      Result:= S_OK
  else if IsEqualIID(IID, FSinkIID) then
     Result:= QueryInterface(IDispatch, Obj)
  else
   Result:= E_NOINTERFACE;
end;

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

// GetTypeInfo
//
function TPowerpointEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
begin
  Result := E_NOTIMPL;
  pointer (TypeInfo) := NIL;
end;

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

function TPowerpointEventSink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
   Flag: Word; var Params; VarResult, ExceptInfo, ArgErr: Pointer): HResult; stdcall;
begin
  Result:= DISP_E_MEMBERNOTFOUND;
  case DispID of
  2: begin
       ////////////////////////////////////////////////////
       //Interact when  window Form Sent_Program
       //ShowMessage('Invoke--IID==' + IntToStr(LocaleID));
       /////////////////////////////////////////////////////
       DoQuit;
       Result:= S_OK;
    end;
  end
end;

// DoQuit
//
procedure TPowerpointEventSink.DoQuit; stdcall;
begin
  if not Assigned (Quit) then Exit;
  Quit (Self);
end;

// DoQuit
//
procedure TPowerpointEventSink.DoChangeSlide; stdcall;
begin
  if not Assigned (SlideChanged) then Exit;
  SlideChanged(Self,Nil);
end;


// Create
//
constructor TPowerpointEventSink.Create;
begin
   FSinkIID := IApplicationEvents;
end;

// Connect
//
procedure TPowerpointEventSink.Connect (pSource : IUnknown);
var
  pcpc : IConnectionPointContainer;
begin
  Assert (pSource <> NIL);
  Disconnect;

  try
    OleCheck (pSource.QueryInterface (IConnectionPointContainer, pcpc));
    OleCheck (pcpc.FindConnectionPoint (FSinkIID, FCP));  ///  <--  Finding Matching ID
    OleCheck (FCP.Advise (Self, longword(FCookie)));
    FSource := pSource;
  except
    raise Exception.Create (Format ('Unable to connect %s.'#13'%s',
      ['Ms-Office App', Exception (ExceptObject).Message]
    ));
  end;
end;

// Disconnect
//
procedure TPowerpointEventSink.Disconnect;
begin
  if (FSource = NIL) then Exit;
  try
    OleCheck (FCP.Unadvise(FCookie));
    FCP := NIL;
    FSource := NIL;
  except
    pointer (FCP) := NIL;
    pointer (FSource) := NIL;
  end;
end;

// _AddRef
//
function TPowerpointEventSink._AddRef: Integer; stdcall;
begin
   Result := 2;
end;

// _Release
//
function TPowerpointEventSink._Release: Integer; stdcall;
begin
   Result := 1;
end;


end.


and   Code that Implement Form

Code: [Select]

unit UnitMainForm;

...

var
  Form1: TForm1;

  //Part Control PPT Slide
  MsOfficeApp   : Variant; //OLEVariant;

  screenClasshWnd : HWND;
  TmpDis : IDispatch;

implementation

uses comobj;

{ TForm1 }

procedure Test_InitWord();
begin
  try
    MsOfficeApp := CreateOleObject('Word.Application');
  except
    ShowMessage('Error...');
    Exit;
  end;

  Form1.FEventSink    := TPowerpointEventSink.Create();

  try
    if Form1.FEventSink = nil then
    begin
      ShowMessage('No Event');
    end
    else
    begin
      Form1.FEventSink.Quit := @(Form1._PowerpointOnClose);
    end;
  except
    ShowMessage('Error');
  end;

  Form1.FEventSink.Connect(MsOfficeApp);

  // Make Powerpoint visible
  MsOfficeApp.Visible := True;
  //Set Window Stage
  MsOfficeApp.WindowState := ppWindowMinimized;
end;

procedure TForm1._PowerpointOnClose(Sender : TObject);
begin
  FEventSink.Disconnect;
  MsOfficeApp := Unassigned;
  caption := 'Powerpoint OnClose--Event';
end;

procedure InitPpt();
begin
  try
    MsOfficeApp := CreateOleObject('PowerPoint.Application');
  except
    ShowMessage('Error...');
    Exit;
  end;

  Form1.FEventSink    := TPowerpointEventSink.Create();

  try
    if Form1.FEventSink = nil then
    begin
      ShowMessage('No Event');
    end
    else
    begin
      Form1.FEventSink.Quit := @(Form1._PowerpointOnClose);
    end;
  except
    ShowMessage('Error');
  end;

  try
    if Form1.FEventSink = nil then
    begin
      ShowMessage('No Event');
    end
    else
    begin
      Form1.FEventSink.SlideChanged := @(Form1._OnPresentationChangeSlide);
    end;
  except
    ShowMessage('Error');
  end;

  try
    Form1.FEventSink.Connect(MsOfficeApp);
  except
    ShowMessage('Connection To PPT Error');
  end;

  // Make Powerpoint visible
  MsOfficeApp.Visible := True;
  //Set Window Stage
  MsOfficeApp.WindowState := ppWindowMinimized;
end;

...

procedure TForm1.OpenFilePresentationClick(Sender: TObject);
var tmpint       : Integer;
    TotalSlide   : Integer;
    filenameLoad : WideString;
begin
  if not OpenDialog1.Execute then Exit;
  filenameLoad := OpenDialog1.FileName;
  if not FileExistsUTF8(filenameLoad) then Exit;


  // Show powerpoint version
  //ShowMessage(Format('Powerpoint version: %s',[MsOfficeApp.Version]));

  // Open a presentation
  //MsOfficeApp.Presentations.Open('E:\Feather_Presernt_MAM2012.ppt', False, False, True);

  try
    //MsOfficeApp.Presentations.Open(filenameLoad, True, False, True);
    MsOfficeApp.Presentations.Open(filenameLoad, True, False, True);
  except
    ShowMessage('Error Load OLE');
    Application.Terminate;
    Exit;
  end;


  CurrentPPt := MsOfficeApp.ActivePresentation;
  ComboBoxPageSlide.Items.Clear;
  TotalSlide :=  CurrentPPt.Slides.Count;
  for tmpint := 1 to TotalSlide do
  begin
    ComboBoxPageSlide.Items.Add(IntToStr(tmpint));
  end;
  ComboBoxPageSlide.ItemIndex  := 0;
  ComboBoxPageSlide.Enabled    := True;
  ButtonFirstSlide.Enabled     := False;
  ButtonPreviouseSlide.Enabled := False;
  ButtonNextSlide.Enabled      := True;
  ButtonLastSlide.Enabled      := True;

  // Show number of slides
  //ShowMessage(Format('%s slides.',[CurrentPPt.Slides.Count]));

  //MsOfficeApp.OnPresentationClose := @Self.StatePPTShowExit;

  CurrentPPt.SlideShowSettings.Run.Width  := Trunc(Panel1.Width  * 0.75);
  CurrentPPt.SlideShowSettings.Run.Height := Trunc(Panel1.Height * 0.75);

  screenClasshWnd := FindWindow('screenClass', nil);
  Windows.SetParent(screenClasshWnd, Panel1.Handle);

  // Run the presentation
  CurrentPPt.SlideShowSettings.Run;
  Self.Show;
  Self.SetFocus;


  //if MsOfficeApp = Nil then ShowMessage('Object is not Assigned');


  ButtonOpenFilesPresenation.Enabled   := False;
  ButtonCloseSlideShow.Enabled         := True;

end;

...

procedure TForm1.ButtonGetGUIDClick(Sender: TObject);
var myResult: HResult;
var myCLSID: TCLSID;
var ProgID: widestring;
var myCLSIDStr: widestring;
begin
//  CoInitialize(nil);    // Done inside ComObj

  //ProgID := 'PowerPoint.Application';
  ProgID :=  'PowerPoint.Slide';
//  ProgID := 'Word.Application';
//  ProgID := 'InternetExplorer.Application';
  myResult := CLSIDFromProgID(PWideChar(progID), myCLSID);
  if myResult <> S_OK then
    begin
      Showmessage('** ERROR CLSIDFromProgID **  ( Error: '+IntToHex(myResult,8)+')');
      Exit;
    end;
  myCLSIDStr := GUIDToString(myCLSID);
  Showmessage('CLSID = ' + UTF8Encode(myCLSIDStr));
  Edit1.Text  := myCLSIDStr;

//  CoUninitialize;    // Done inside ComObj
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MsOfficeApp := UnAssigned;
  CurrentPPt  := Unassigned;

  ComboBoxPageSlide.Items.Clear;
  ComboBoxPageSlide.Enabled           := False;
  ButtonCloseSlideShow.Enabled        := False;
  ButtonOpenFilesPresenation.Enabled  := True;
  ButtonFirstSlide.Enabled            := False;
  ButtonPreviouseSlide.Enabled        := False;
  ButtonNextSlide.Enabled             := False;
  ButtonLastSlide.Enabled             := False;
  ShowMessage('Test --BeginInit');
  //InitPpt;
  Test_InitWord();
  ShowMessage('Test--StopInit');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FEventSink.Disconnect;
  FEventSink.Free;
  MsOfficeApp.Quit;
  MsOfficeApp := UnAssigned;

end;


{$R *.lfm}

end.



 

[ChrisF]

Sorry, I've not checked all your code (but I'll have a deeper look at it a bit later...).

But on a first glance, your current code is showing and OLE interface for 'PowerPoint.Slide' and a Create OLE object for 'PowerPoint.Application'.

Have you made a simple try first, just for PowerPoint.Application (i.e. with {91493441-5A91-11CF-8700-00AA0060263B}) ?


Furthermore, I'm not sure you can use PowerPoint.Slide exactly as for Word.Application or PowerPoint.Application (or any other xxxxx.Application).

[kyaoga]

I 've tried {91493441-5A91-11CF-8700-00AA0060263B}  and all of them

Code: [Select]

['{64818D11-4F9B-11CF-86EA-00AA00B929E8}']// PPt - Slide    <--  Get from ChrisF Code
      //['{91493441-5A91-11CF-8700-00AA0060263B}']// PPt - Application  <-- Get from ChrisF Code
      //['{91493463-5A91-11CF-8700-00AA0060263B}']//IID_PresEvents  <-- from Import Type Library
      //['{9149346D-5A91-11CF-8700-00AA0060263B}']//IID_SldEvents <-- from Import Type Library
      //['{914934C1-5A91-11CF-8700-00AA0060263B}']//IID_OCXExtenderEvents <-- from Import Type Library
      //['{914934D2-5A91-11CF-8700-00AA0060263B}']//IID_MasterEvents <-- from Import Type Library



I 've already tried ,
It get Errors on

Code: [Select]


 Form1.FEventSink.Connect(MsOfficeApp);  <--  Error on Connect



[ChrisF]

You've added an event connection for PowerPoint which is not present for Word.

So, have you tried first without this additional event with PowerPoint ?

Furthermore, I can't see in your code the corresponding event part:

Code: [Select]

  try
    if Form1.FEventSink = nil then
    begin
      ShowMessage('No Event');
    end
    else
    begin
      //  ???????????????
      //  Form1:  OnPresentationChangeSlide  ???
      //  ???????????????
      Form1.FEventSink.SlideChanged := @(Form1._OnPresentationChangeSlide);         
    end;
  except
    ShowMessage('Error');
  end;



[ChrisF]

My mistake...

It seems that, according to the Microsoft documentation, the correct CLSID to use should be in fact:
91493442-5A91-11CF-8700-00AA0060263B

Links to the documentation (Office 2010):
Word: https://msdn.microsoft.com/en-us/library/microsoft.office.interop.word.application%28v=office.14%29.aspx
PowerPoint: https://msdn.microsoft.com/en-us/library/microsoft.office.interop.powerpoint.application.aspx

While these one seems different (Office 2010):
Word: https://msdn.microsoft.com/en-us/library/microsoft.office.interop.word.applicationclass%28v=office.14%29.aspx
PowerPoint:
https://msdn.microsoft.com/en-us/library/microsoft.office.interop.powerpoint.applicationclass%28v=office.14%29.aspx