Delphi控制PowerPoint完整的例子
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