我这也有个简单的
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.
