Question

谁有Delphi控制PowerPoint完整的例子

Answer 1

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
begin
if Shapes.item(i).Type_<>msoTextBox then
begin
Shapes.Item(i).Copy;
PptPic.Assign(Clipboard);
PptPic.SaveToFile('d:\dd.jpg');
end
end;
finally
PptPic.Free;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
try
PowerPointApplication1.Connect;
except on E: Exception do
begin
E.Message := 'PowerPoint does not appear to be installed';
raise;
end;
end;
PowerPointApplication1.Visible := 1;
PowerPointPresentation1.ConnectTo(PowerPointApplication1.Presentations.Add(1));
//PowerPointApplication1.ActiveWindow.ViewType :=1;
except
on E: Exception do
begin
Showmessage(E.Message);
PowerPointApplication1.Disconnect;
end;
end;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
i:integer;
begin
with PowerPointSlide1 do
begin
for i:=1 to Shapes.Count do
begin
//Shapes.TextEffect.Text
if Shapes.item(i).Type_=msoTextBox then
begin
Shapes.Item(i).copy;
{Shapes.Item(i).TextFrame.TextRange.Select;
Shapes.Item(i).TextFrame.TextRange.Copy;
RichEdit1.PasteFromClipboard;}
RichEdit1.Lines.Assign(Clipboard);
//RichEdit1.Lines.Add(Shapes.Item(1).TextFrame.TextRange.Text);
//ActiveWindow.Selection.ShapeRange.Item(1).TextEffect.Text
end
else
begin
Shapes.Item(i).Copy;
//Image1.Picture.Bitmap.;
//if Clipboard.HasFormat(CF_BITMAP) then
Image1.Picture.Assign(Clipboard);
//PaintBox1.Assign(Clipboard);
//GetPicture;
end;
end;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
AddSlide('C:\WINNT\CIBAB.BMP');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
AddText(RichEdit2);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
AddPicture('C:\WINNT\CIBAS.BMP');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//PaintBox1.
//DBImage1.CopyToClipboard
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
GetPicture;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
with PowerPointPresentation1.PageSetup do
begin
SlideSize := ppSlideSizeCustom;
SlideWidth := 680.38;
SlideHeight := 510.25;
FirstSlideNumber := 1;
SlideOrientation := msoOrientationHorizontal;
NotesOrientation := msoOrientationVertical;
//Showmessage(Floattostr(PowerPointPresentation1.PageSetup.SlideWidth));
end;
end;

end.