Delphi控制PowerPoint完整的例子
www.edusrc.com
unit Unit1;interfaceuses 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
