unit1.pas

delphi中操纵powerpoint演示

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,  Controls, Forms,
  Dialogs, MSPpt2000, OleServer,Office2000, stdctrls,wintypes,winprocs,
  Buttons;

type
  TForm1 = class(TForm)
    ppts: TPowerPointSlide;
    ppta: TPowerPointApplication;
    pptp: TPowerPointPresentation;
    SpeedButton1: TSpeedButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 

  private
    { Private declarations }
    procedure Moveme(var m:TMSG;var handled:boolean);

    public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
  ssSet: SlideShowSettings;
  ssWin: SlideShowWindow;
  connected,disable:boolean;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    try
    pptA.Disconnect;
    pptA.Quit;
    if assigned(pptA) then pptA.Free;
  except
    showmessage('PowerPoint has already closed!');
  end;

end;

procedure TForm1.Moveme(var m:TMSG;var handled:boolean);
var pos:Dword;
posx,posy,px,py,px1,py1,lx,ly,lx1,ly1:word;
begin

     pos:=getmessagepos;
     posx:=loword(pos);
     posy:=hiword(pos);
     px:=speedbutton1.clienttoscreen(point(speedbutton1.Left,speedbutton1.top)).X;
     py:=speedbutton1.clienttoscreen(point(speedbutton1.Left,speedbutton1.top)).y;
     px1:=speedbutton1.clienttoscreen(point(speedbutton1.left+speedbutton1.Width,speedbutton1.top+speedbutton1.height)).X;
     py1:=speedbutton1.clienttoscreen(point(speedbutton1.left+speedbutton1.Width,speedbutton1.top+speedbutton1.height)).y;


     if not ((posx>px) and (posx<px1) and (posy>py) and (posy<py1))  then

    begin
     inherited;

     sendmessage(handle,wm_nclbuttondown,htcaption,getmessagepos);
     handled:=true;
     end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var d:Topendialog;
    i:integer;
    filename:string;
begin
     try
       d:=topendialog.Create(self);
       d.Filter:='PowerPoint演示文稿（*.ppt）|*.ppt';
       if d.Execute then
       filename:=d.FileName;
     if not connected then
  begin
    pptA.Connect;
    connected := True;
  end;
  if filename<>'' then
  begin
  pptA.Visible := msoTrue;
  PPtP.ConnectTo(pptA.Presentations.Open(filename, msoFalse, msoFalse, msoTrue));
  ssSet := PPtP.SlideShowSettings;
  ssSet.LoopUntilStopped := msoFalse;
  ssSet.ShowType := ppShowTypeSpeaker;
  ssSet.Run;
  ssWin := PPtP.SlideShowWindow;
  PPts.ConnectTo(PPtP.Slides.Item(1));
  for i:=0 to pptp.Slides.Count-1 do
   begin
     ssWin.View.Next;
     sleep(55);
   end;
    ssWin.View.Exit;
    pptA.Disconnect;

  end;
   finally
   pptA.Quit;
   application.Terminate
   end;

end;
procedure TForm1.FormCreate(Sender: TObject);
begin
      application.OnMessage:=moveme;
end;

end.