Image控件怎样得到从Powerpoint复制的图像内容(50分)

如题

Image1.Picture.Assign(ClipBoard)

这样不行呀
procedure TForm1.Button7Click(Sender: TObject);
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
else
begin
//Shapes.Item(i).Select;
Shapes.Item(i).Copy;
Image1.Picture.Bitmap.Assign(Clipboard);
//没有任何内容
end;
end;
end;
end;

我认为也应该使用pastefromclipboard的方法，当然具体参数、及调用方法需要您自己搞搞清楚了。

Image根本就没有pastefromclipboard的方法.

procedure TForm1.Button7Click(Sender: TObject);
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
else
begin
//Shapes.Item(i).Select;
Shapes.Item(i).Copy;
Image1.Picture.Assign(Clipboard);
//没有任何内容
end;
end;
end;
end;

to realLearning 谢谢
能不能跟你交个朋友呀

得到的图像会失真.不知道有没解决方法。
还有就是怎样让程序后台运行，就是不要显示出来。

需要取得ppt中的shape的大小设置image的大小。
Application.ShowMainForm := False;

to realLearning
不是我的应用程序，而是Powerpoint不要显示

这个问题我都问了二三天了，大富翁的高手都哪里去了，不肯帮忙吗

我把的代码发给大家，请大家帮我实现呀
请留下E-mail

我把代码贴出来，请大家帮我解决最后一个问题
让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
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.

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 := msoFalse; //此处改为 :=msoFalse就行了
PowerPointPresentation1.ConnectTo(PowerPointApplication1.Presentations.Add(1));
//PowerPointApplication1.ActiveWindow.ViewType :=1;
except
on E: Exception do
begin
Showmessage(E.Message);
PowerPointApplication1.Disconnect;
end;
end;
end

to wfzha
这样不行呀。

下面的行，他先将图像发送到powerpoint然后再复制回来，powerpoint不显示
var c:TClipboard;
atype,tmplevariant;
i:integer;
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 := msoFalse;
// Form1.SetFocus;
PowerPointPresentation1.ConnectTo(PowerPointApplication1.Presentations.Add(1));
PowerPointSlide1.ConnectTo(PowerPointPresentation1.Slides.Add(PowerPointPresentation1.Slides.Count + 1, 1));

with PowerPointSlide1 do
begin
Layout := 10;
FollowMasterBackground := 0;
Background.Fill.PresetGradient(2, 2, 10);
Shapes.Item(1).TextFrame.TextRange.InsertAfter('test');
c:=TClipboard.Create;
c.Assign(Image1.Picture.Bitmap);
Shapes.Paste;
for i:=1 to Shapes.Count do
begin
if Shapes.item(i).Type_<>msoTextBox then
begin
Shapes.Item(i).Copy;
Image2.Picture.Assign(Clipboard);
//没有任何内容
end;
end;
{Set time displayed for each slide}
SlideShowTransition.AdvanceOnTime := 1;
SlideShowTransition.AdvanceTime := 2;
c.Free;
tmp:=True;
atype:=ppSaveAsPowerPoint7;
caption:=self.PowerPointPresentation1.GetNamePath;
self.PowerPointPresentation1.SaveAs('c:/1.ppt',atype,tmp);

end;

except
on E: Exception do
begin
Showmessage(E.Message);
PowerPointApplication1.Disconnect;
end;
end;
end;

还是不能后台操作呀,难道就没有办法了吗

多人接受答案了。