Delphi控制PowerPoint完整的例子

Delphi控制PowerPoint完整的例子

www.edusrc.com

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 msppt8, OleServer, office97, StdCtrls, ComCtrls, ExtCtrls, DBCtrls,
 Clipbrd;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Button3: TButton;
   PowerPointPresentation1: TPowerPointPresentation;
   PowerPointApplication1: TPowerPointApplication;
   PowerPointSlide1: TPowerPointSlide;
   Button4: TButton;
   Button5: TButton;
   Button6: TButton;
   Button7: TButton;
   Button8: TButton;
   RichEdit1: TRichEdit;
   RichEdit2: TRichEdit;
   Image1: TImage;
   Button9: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button7Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Button8Click(Sender: TObject);
   procedure Button9Click(Sender: TObject);
 private
   { Private declarations }
   {插入新幻灯片}
   Procedure AddSlide(BackPicFile: TFileName);
   {添加文本}
   Procedure AddText(RichEdit: TRichEdit);
   {添加图片}
   Procedure AddPicture(PicFile: TFileName);
   {得到文本}
   Procedure GetText;
   {得到图片}
   Procedure GetPicture;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

{插入新幻灯片}
procedure TForm1.AddSlide(BackPicFile: TFileName);
var
 i: integer;
begin
 With PowerPointPresentation1 do
 begin
   Slides.Add(Slides.Count + 1, 1).select;
   //PowerPointApplication1.ActiveWindow.View.gotoSlide(Slides.Count);
   //Slides.Add(Slides.Count + 1, 1).
   PowerPointSlide1.ConnectTo(Slides.Item(Slides.Count));
 end;
 with PowerPointSlide1 do
 begin
   {Set background}
   FollowMasterBackground := 0;
   Background.Fill.Visible := msoTrue;
   Background.Fill.ForeColor.RGB := RGB(255, 255, 255);
   Background.Fill.BackColor.SchemeColor := ppAccent1;
   Background.Fill.Transparency := 0;
   Background.Fill.UserPicture(BackPicFile);
   for i:=1 to Shapes.Count do
   begin
     Shapes.Item(1).Delete;
   end;
 end;
end;

{添加文本}
procedure TForm1.AddText(RichEdit: TRichEdit);
begin
 with PowerPointSlide1 do
 begin
   //expression.AddTextbox(Orientation, Left, Top, Width, Height)
   Shapes.AddTextbox(msoTextOrientationHorizontal,100, 100, 500,
     200).TextFrame.TextRange.Text:=RichEdit.Lines.Text;
   {RichEdit.SelectAll;
   RichEdit.CopyToClipboard;
   Shapes.Item(Shapes.Count).TextFrame.TextRange.Paste; }
   Shapes.Item(Shapes.Count).TextFrame.TextRange.Select;
   With Shapes.Item(Shapes.Count).TextFrame.TextRange.Font do
   begin
     NameAscii := 'Arial';
     NameFarEast := '宋体';
     NameOther := 'Arial';
     Size := 30;
   end;
 end;
end;

{添加图片}
procedure TForm1.AddPicture(PicFile: TFileName);
begin
 with PowerPointSlide1 do
 begin
   Shapes.AddPicture (PicFile,1, 1, 100, 100, 150, 70);
 end;
end;

{得到文本}
procedure TForm1.GetText;
var
 i: integer;
begin
 with PowerPointSlide1 do
 begin
   for i:=1 to Shapes.Count do
   begin
     if Shapes.item(i).Type_=msoTextBox  then
     begin
       Shapes.Item(i).TextFrame.TextRange.Select;
       Shapes.Item(i).TextFrame.TextRange.Copy;
       RichEdit1.PasteFromClipboard;
     end
   end;
 end;
end;

{得到图片}
procedure TForm1.GetPicture;
var
 i: integer;
 PptPic: TPicture;
begin
 with PowerPointSlide1 do
 begin
   try
     PptPic := TPicture.Create;
     for i:=1 to Shapes.Count do