unit1.pas

delphi写的关于PPT显示的程序,稍微修改下可用

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TSpeedButton;
    ppts: TPowerPointSlide;
    ppta: TPowerPointApplication;
    pptp: TPowerPointPresentation;
    Button2: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(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: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);
begin

end;

procedure TForm1.Button1Click(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(155);
   end;
    ssWin.View.Exit;
    pptA.Disconnect;

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

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

procedure TForm1.Button2Click(Sender: TObject);
begin
   close;
end;

end.