作者:原创

方案:

1. 将PowerPoint程序创建到自己程序的一个面板A中来
2. 确定PPT播放区以外区域的大小,主要是为移动并隐藏这些不必要的区域做准备
3. 移动PowerPoint程序主窗口并调整其大小,以便将PowerPoint主窗口的边框,菜单,工具条,滚动条,状态条等不必要的区域隐藏到面板A的可视范围以外
4. 这样在面板A的范围内就只剩下PPT播放区了,就好像PPT是在自己的程序内容播放一样,如下图所示:

   

关键:

1. 将PowerPoint程序放到自己的程序中,使用WINAPI函数:SetParent(p_handle, p_ParentHandle);
2. 计算播放区以外区域的大小,首先要确定那里是播放区,播放区与其他区域的区别是什么?这里我用的方法是将整个PowerPoint窗口显示在面板A中,然后默认中心点位置的窗口类是播放区,并取出这个窗口类的类名:B,然后沿横竖两个中轴,由四个方向逐像素扫描PowerPoint主窗口,直到找到窗口类B,而这是的位置应该是B的上下左右四个边沿,从而确定播放区与PowerPoint主窗口四个边所距的像素数.其中用到的API函数有:ClientToScreen(p_Handle: hwnd; var p_Point: TPoint),客户区坐标转化为屏幕坐标;
   HWND WindowFromPoint( POINT Point); 取坐标点上窗口的句柄;
   GetClassName(HWND hWnd,LPTSTR lpClassName,int nMaxCount);取句柄指定的类的名称;

问题:

PPT播放区的定义过程中需要主程序始终在系统中的最前面,PowerPoint主窗口也要总是显示出来,这样在整个调入过程中会有闪烁的感觉,不太完美,如果能做到像IE内嵌PPT那样就好了.

附录:源代码

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
  PowerPointXP, //
  OfficeXP, //
  OleServer, //
  StdCtrls,
  ComCtrls, //
  ShellAPI, //
  TLHelp32, //
  ExtCtrls,
  ActiveX; //

type
  TPPTWinState = record
    State: PpWindowState;
    Width,
      Height,
      Left,
      Top: Single;
  end;

TClassInfo = record
    Handle: Hwnd;
    ClassName: string;
  end;

TPlayAreaMargin = record
    Left: integer; //左边框
    Right: integer; //右边框 + 滚动条
    Top: integer; //上边框 + 窗口标题栏 + 菜单 + 工具条
    Bottom: integer; //底边框 + 状态栏
  end;

TForm1 = class(TForm)
    pptp: TPowerPointPresentation;
    Panel1: TPanel;
    Panel2: TPanel;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

FPPTParentWinHandle: HWnd;
    FPPTWinHandle: HWnd;
    PPTA: TPowerPointApplication;
    FOldPPTWinState: TPPTWinState;
    FPlayAreaHandle: HWnd;
    FPlayAreaClassName: string;
    FPlayAreaMargin: TPlayAreaMargin;
    FPlayAreaOk : Boolean; //用来标记播放区是否第一次初始化完成,以防止在没有完成的情况就对它进行其他操作
    procedure GetMousePosHwndAndClassName(p_Pos: TPoint; var r_ClassInfo: TClassInfo);
    procedure GetProcessList(var r_List: TStrings);
    procedure GetWindowList(var r_List: TStrings);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure _SetParent(p_handle, p_ParentHandle: Hwnd); //为避免与控件自身的 SetParent冲突,另写一个
begin
  SetParent(p_handle, p_ParentHandle);
end;

procedure _ClientToScreen(p_Handle: hwnd; var p_Point: TPoint); //为避免与控件自身的ClientToScreen冲突,另写一个
begin
  ClientToScreen(p_Handle, p_Point);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tmpProcList: TStrings;
  tmpWinList: TStrings;
  tmpkilled: Boolean;
  tmpPPTProcID, tmpPPTProcID2: DWORD;
  tmpWinHandle: HWnd;
  tmpIndex: integer;
  i: integer;

tmpPoint: TPoint;
  tmpStr: Pchar; //String;
  tmpRect: TRect;

tmpCClassInfo: TClassInfo;
  tmpClassInfo: TClassInfo;
  //tmpLeft, tmpTop, tmpRight, tmpBottom: integer;

begin
  tmpProcList := TStringList.Create; //系统中所有进程的列表
  tmpWinList := TStringList.Create; //系统中所有窗口的列表
  try
    GetProcessList(tmpProcList); //系统系统进程
    tmpIndex := tmpProcList.IndexOf('POWERPNT.EXE'); //查找PowerPoint程序
    if tmpIndex >= 0 then //如果系统有POWERPOINT在运行
    begin //则关闭它,因为它不是程序打开的,在程序操作中可能会出错
      tmpPPTProcID := Dword(tmpProcList.Objects[tmpIndex]);
      tmpkilled := TerminateProcess(OpenProcess(PROCESS_TERMINATE, False, tmpPPTProcID), $FFFFFFFF); //杀死进程
      if not tmpkilled then //没杀掉?
      begin
        messagebox(self.handle, pchar('POWERPNT.EXE 无法被杀死！请手动关闭PowerPoint程序.'), '提示', MB_OK or MB_ICONWARNING);
        exit; //
      end;
    end;

if Assigned(ppta) then //初始PPA变化
    begin
      ppta.Disconnect;
      ppta.Quit;
      ppta.Free;
    end;
    ppta := TPowerPointApplication.Create(self); //这个PPA为什么要手动建立呢?不清楚,只是直接放在FROM中的有时会出错,手动建立的好像没有.
    ppta.Connect; //连接POWERPOINT,这里最好加一个错误处理,以防止系统中没有安装POWERPOINT

FOldPPTWinState.State := ppta.WindowState; //保存PPA窗口的状态,大小及位置,以便将来退出程序时还原.
    FOldPPTWinState.Width := ppta.width;
    FOldPPTWinState.Height := ppta.Height;
    FOldPPTWinState.Left := ppta.Left;
    FOldPPTWinState.Top := ppta.Top;

ppta.ShowWindowsInTaskbar := msoFalse; //决定是否每一个打开的演示文稿都有单独的 Windows 任务栏按钮。 可读写。MsoTriState 类型。
{
MsoTriState 可以是下列 MsoTriState 类型常数之一。
msoCTrue
msoFalse
msoTriStateMixed
msoTriStateToggle
msoTrue 默认值。每个打开的演示文稿都有单独的 Windows 任务栏按钮。
}

GetProcessList(tmpProcList); //再取一次系统进程列表
    tmpIndex := tmpProcList.IndexOf('POWERPNT.EXE'); //这次这个POWERPOINT进程应该是自己创建了的.
    if tmpIndex < 0 then //居然没创建出来!!!
    begin
      messagebox(self.handle, pchar('启动PowerPoint程序出错.'), '提示', MB_OK or MB_ICONWARNING);
      exit; //没办法,退出吧.
    end;
    tmpPPTProcID := Dword(tmpProcList.Objects[tmpIndex]); //取PPA的进程ID

FPPTWinHandle := 0; //初始PPT主窗口句柄变量
    GetWindowList(tmpWinList); //取系统所有窗口的变量
    for i := 0 to tmpWinList.Count - 1 do //循环处理所有窗口
    begin
      if pos('MICROSOFT POWERPOINT', uppercase(tmpWinList[i])) > 0 then //碰到标题包含 :MICROSOFT POWERPOINT的窗口
      begin
        tmpWinHandle := Hwnd(tmpWinList.Objects[i]); //记下窗口句柄
        GetWindowThreadProcessId(tmpWinHandle, @tmpPPTProcID2); //根据窗口句柄取窗口所在的进程ID
        if tmpPPTProcID = tmpPPTProcID2 then //如果窗口所在进程ID与POWERPOINT进程ID一致.两个会不一致吗?有可能,万一那个哥们自己创建一个标题包含:MICROSOFT POWERPOINT的窗口呢
        begin
          FPPTWinHandle := tmpWinHandle; //记下PPT主窗口的句柄
          break;
        end;
      end;
    end;

if FPPTWinHandle > 0 then //如果PPT主窗口存在
    begin
      FPPTParentWinHandle := GetParent(FPPTWinHandle); //保存原PPT父级窗口句柄,以备将来还原
      _SetParent(FPPTWinHandle, Panel1.Handle); //将PPT主窗口的父级窗口设置为我们的Panel1,哈哈,这下PPT就到咱自己的程序中来,而且还多系统任务栏中消失了!

ppta.WindowState := ppWindowNormal; //设置窗口状态
      setwindowpos(FPPTWinHandle, HWND_TOP, 0, 0, panel1.Width
        , panel1.Height, SWP_NOSENDCHANGING); //先将PPT窗口初始为与Panel1大小一样
      pptp.ConnectTo(ppta.Presentations.Open('c:\aa.ppt', 0, 0, 0)); //打开PPT文件
      pptp.SlideShowSettings.LoopUntilStopped := msoTrue;
      pptp.SlideShowSettings.ShowType := ppShowTypeWindow; //设置播放模式为:窗口播放
      pptp.SlideShowSettings.Run; //开始播放

//ppta.Visible := msoTrue; //PPA窗口可见

{PPT窗口中的菜单,工具条,状态条,滚动条怎么办????
      别急,下面马上处理它们.}

//计算PPT窗口大小,及位置
      FPlayAreaMargin.Left := 0;
      FPlayAreaMargin.Top := 0;
      FPlayAreaMargin.Right := 0;
      FPlayAreaMargin.Bottom := 0;

tmpPoint.X := panel1.Width div 2; //以Panel1的中心点为基础
      tmpPoint.Y := panel1.Height div 2;
      _ClientToScreen(panel1.Handle, tmpPoint);
      GetMousePosHwndAndClassName(tmpPOint, tmpCClassInfo); //取Panel1中心点位置上的类信息,这个类应该就是播放PPT的区域

for i := 1 to panel1.Width div 2 - 1 do //从左向右,逐像素的取类信息,(左侧窗口边框的宽度)
      begin
        tmpPoint.X := i;
        tmpPoint.Y := panel1.Height div 2;
        _ClientToScreen(panel1.Handle, tmpPoint);
        GetMousePosHwndAndClassName(tmpPOint, tmpClassInfo);
        if tmpClassInfo.Handle = tmpCClassInfo.Handle then //直到找到PPT播放区域
        begin
          FPlayAreaMargin.Left := i; //记下这个位置,这个位置就是将来PPT主窗口要向左移动的位置.
          break;
        end;
      end;

for i := 1 to panel1.Height div 2 - 1 do //同理,计算顶端 位置 (标题栏+菜单+工具条的高度)
      begin
        tmpPoint.X := panel1.Width div 2;
        tmpPoint.Y := i;
        _ClientToScreen(panel1.Handle, tmpPoint);
        GetMousePosHwndAndClassName(tmpPOint, tmpClassInfo);
        if tmpClassInfo.Handle = tmpCClassInfo.Handle then
        begin
          FPlayAreaMargin.Top := i;
          break;
        end;
      end;

for i := 1 to panel1.Width div 2 - 1 do //同理,计算右侧位置(右侧边框+滚动条宽度)
      begin
        tmpPoint.X := panel1.Width - i;
        tmpPoint.Y := panel1.Height div 2;
        _ClientToScreen(panel1.Handle, tmpPoint);
        GetMousePosHwndAndClassName(tmpPOint, tmpClassInfo);
        if tmpClassInfo.Handle = tmpCClassInfo.Handle then
        begin
          FPlayAreaMargin.Right := i;
          break;
        end;
      end;

for i := 1 to panel1.Height div 2 - 1 do //计算底部位置(边框+状态栏的高度)
      begin
        tmpPoint.X := panel1.Width div 2;
        tmpPoint.Y := panel1.Height - i;
        _ClientToScreen(panel1.Handle, tmpPoint);
        GetMousePosHwndAndClassName(tmpPOint, tmpClassInfo);
        if tmpClassInfo.Handle = tmpCClassInfo.Handle then
        begin
          FPlayAreaMargin.Bottom := i;
          break;
        end;
      end;
      setwindowpos(FPPTWinHandle, HWND_TOP
        , -1 * FPlayAreaMargin.Left
        , -1 * FPlayAreaMargin.Top
        , panel1.Width + FPlayAreaMargin.Right + FPlayAreaMargin.Left
        , panel1.Height + FPlayAreaMargin.Bottom + FPlayAreaMargin.top
        , SWP_NOSENDCHANGING);

{再次设置PPT主窗口的大小及位置,这下好了,什么菜单,工具条,滚动条,状态栏统统看不到了吧}
    end;
    FPlayAreaOk := true;
  finally
    freeandnil(tmpProcList); //释放两个列表
    freeandnil(tmpWinList);
  end;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  pptp.SlideShowWindow.View.First; //定位到第一個幻燈片

end;

procedure TForm1.Button5Click(Sender: TObject);
begin

pptp.SlideShowWindow.View.Previous; //定位到上一個幻燈片
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  button6.Enabled := false;
  pptp.SlideShowWindow.View.Next; //定位到下一個幻燈片

self.Caption := inttostr(ppta.ActivePresentation.SlideShowWindow.View.CurrentShowPosition);
  button6.Enabled := true;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  pptp.SlideShowWindow.View.Last; //定位到最后一個幻燈片
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(ppta) then
  begin
    {在退出程序时,千万别忘了把PPT主窗口还级系统哟,要不系统会不答应的. ^!^}
    if (FPPTParentWinHandle <> Panel1.Handle) then
    begin
      _SetParent(FPPTWinHandle, FPPTParentWinHandle); //还原PPT主窗口的父级窗口
    end;
    sleep(500); //稍等一会儿.(为什么?我也不知道,总觉得这样保险一些)
    ppta.Disconnect; //断开
    ppta.Quit; //退出
    ppta.Free; //释放.
  end;

end;

procedure TForm1.GetMousePosHwndAndClassName(p_Pos: TPoint; var r_ClassInfo: TClassInfo);
var
  tmpHandle: THandle;
  tmpClassName: array[0..255] of char;
begin
  tmpHandle := WindowFromPoint(p_Pos);
  if boolean(GetClassName(tmpHandle, tmpClassName, 256)) then
  begin
    r_ClassInfo.Handle := tmpHandle;
    r_ClassInfo.ClassName := string(tmpClassName);
  end else
  begin
    r_ClassInfo.Handle := 0;
    r_ClassInfo.ClassName := '';
  end;
end;

procedure TForm1.GetProcessList(var r_List: TStrings);
var
  tmpHandle: Thandle;
  tmpFp32: tprocessentry32;
  tmpClp: bool;
  tmpProcFile: array[0..MAX_PATH] of char;
begin
  r_List.Clear;
  tmpHandle := CreateToolhelp32Snapshot(th32cs_snapprocess, 0);
  tmpFp32.dwsize := sizeof(tmpFp32);
  tmpClp := process32first(tmpHandle, tmpFp32);
  while integer(tmpClp) <> 0 do
  begin
    if tmpFp32.th32processid <> getcurrentprocessid then
    begin
      StrCopy(tmpProcFile, tmpFp32.szExeFile);
      r_List.AddObject(tmpProcFile, TObject(tmpFp32.th32processid));
    end;
    tmpClp := process32next(tmpHandle, tmpFp32);
  end;
  closehandle(tmpHandle);
end;

procedure TForm1.GetWindowList(var r_List: TStrings);
var
  tmpWinHandle: HWnd; //窗口句柄
  tmpWinCaption: array[0..255] of char; //窗口标题
begin
  r_List.Clear;
  tmpWinHandle := GetWindow(Handle, GW_HWNDFirst); //获取第一个窗口的句柄
  while tmpWinHandle <> 0 do
  begin
    if GetWindowText(tmpWinHandle, @tmpWinCaption, 255) > 0 then //获取窗口的名称
      r_List.AddObject(StrPas(@tmpWinCaption), tobject(tmpWinHandle));
    tmpWinHandle := GetWindow(tmpWinHandle, GW_HWNDNEXT); //获取下一个窗口的句柄
  end;
end;

procedure TForm1.Panel1Resize(Sender: TObject);
begin

if not FPlayAreaOk then exit; //如果播放区没有初始化完成,则退出
  setwindowpos(FPPTWinHandle, HWND_TOP  //变更播放区大小
    , -1 * FPlayAreaMargin.Left
    , -1 * FPlayAreaMargin.Top
    , panel1.Width + FPlayAreaMargin.Right + FPlayAreaMargin.Left
    , panel1.Height + FPlayAreaMargin.Bottom + FPlayAreaMargin.top
    , SWP_NOSENDCHANGING);

{这里有一个小问题：在窗口最大化时，窗口的边框均变为0,而这个过程并没
  有再次触发Panel1的Resize事件,但Panel1的大小却变化了,所以播放窗口的
  滚动条会显示出来,如果能监视到主窗口边框的变化就可以解决这个问题了}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FPlayAreaOk := false;  //初始化变量
end;

end.