￥￥##%%**请高手和专家进来，关于webbrowser的一个问题！（高分相送，在线等！）··##%%**￥￥

最近我正在搞一个项目，目的是这样的：用delphi打开IE浏览器（通过webbrowser控件），从数据库中取得HTML代码，让其页面显示后截图，再贴到WORD中（程序自动完成此功能。并使用遍历，一次贴很多这样的图）！现在我遇到了这样的问题：可以显示页面，可如何截图，并如何贴到WORD中，特向高手和专家请教！谢谢！在线等！
￥￥##%%**请高手和专家进来，关于webbrowser的一个问题！（高分相送，在线等！）··##%%**￥￥

5 个解决方案

#1

问题一处理：

全局变量
memoryStream:TMemoryStream;
memoryStream:=TMemoryStream.create;
}

var
image:Timage;
jpgstream:TJPEGImage;
ss:tcanvas;

begin
ss:=tcanvas.Create;
ss.Handle:=getdc(0);
image:=timage.Create(self);
image.width:=Screen.width;
image.Height:=screen.Height ;
image.picture.bitmap.PixelFormat:= pf16bit;
bitblt(image.canvas.handle,0,0,image.width,image.height,ss.handle,0,0,srccopy);

{大大的BMP流
image.picture.bitmap.SaveToStream(memoryStream);
}

{无损压缩BMP流 //uses Zlib.pas
//先定义变量count,DestStream,SourceStream
image.picture.bitmap.SaveToStream(memoryStream);
Count:=memoryStream.Size;
DestStream:=TMemoryStream.Create;
//压缩方式:clnone,clfastest,cldefault,clmax
SourceStream:=TCompressionStream.Create(cldefault, DestStream);
try
memoryStream.SaveToStream(SourceStream);
SourceStream.Free;
memoryStream.Clear;
memoryStream.WriteBuffer(Count, SizeOf(Count));
memoryStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
}
{还原BMP流 //uses Zlib.pas
//先定义变量count,buffer,DestStream,SourceStream
//memoryStream是压缩的BMP流
memoryStream.ReadBuffer(Count, SizeOf(Count));
GetMem(Buffer, Count);
DestStream:=TMemoryStream.Create;
SourceStream:=TDecompressionStream.Create(memoryStream);
Try
SourceStream.ReadBuffer(Buffer^, Count);
  DestStream.WriteBuffer(Buffer^, Count);
  DestStream.Position:=0;
  image.Picture.Bitmap.LoadFromStream(DestStream);
finally
FreeMem(Buffer);
DestStream.Free;
end;
}

{JPG流 //uses jpeg
jpgstream:= TJPEGImage.Create;
jpgstream.Assign(image.picture.bitmap);
jpgstream.CompressionQuality:=50;//压缩质量
jpgstream.Compress;
jpgstream.SaveToStream(memoryStream);//保存为JPG流
//使用JPG流 image.Picture.Assign(jpgstream);
jpgstream.free;
}

ReleaseDC(0,ss.Handle);
image.free;

{发送内存流...}
end;

 

我用的是内存流和timer实现连续抓图！但速度并不行！
这是我的程序
var
DC: HDC;
Canvas: TCanvas;
MyBitmap: TBitmap;
aPicture : TPicture;
jpg:tjpegimage;
begin
DC := GetDC(0);
mybitmap:=tbitmap.Create;
canvas:=tcanvas.Create;
Canvas.Handle := DC;
with Screen do
begin
MyBitmap.Width := Width;
MyBitmap.Height := Height;
Application.ProcessMessages;
MyBitmap.Canvas.CopyRect(Rect(0, 0, Width, Height), Canvas,
Rect(0, 0, Width, Height));
end;
jpg:=tjpegimage.Create ;
aPicture:= TPicture.Create;
apicture.Bitmap:=mybitmap;
Application.ProcessMessages;
jpg.Assign(apicture.Bitmap);
TempStream[zuatu] := TMemoryStream.Create;
Application.ProcessMessages;
jpg.SaveToStream(TempStream[zuatu]);
ReleaseDC(0, DC);
mybitmap.free;
canvas.Free;
jpg.Free;
apicture.Free ;
zuatu:=zuatu-1;
if zuatu<1 then




问题2处理  复制到剪贴板
并写到word:


var

  itemindex,mystart,myend:OleVariant;

  AData : THandle;

  APalette: HPALETTE;

  MyFormat : Word;

begin

  try

    //把剖面图发送到剪贴板，设定句柄。

    TempProfile1.Picture.SaveToClipboardFormat(MyFormat,AData,APalette);

    ClipBoard.SetAsHandle(MyFormat,AData);

  finally

   WordDocument1.Paragraphs.Item(21).Range.paste;//粘贴到Word文档中。

 

Dbimage的粘贴方法参见delphi的demo在activex目录下。





给分吧

#2

up
学习

#3

学习,接分!

#4

学习！
哈哈镜强！

#5

学习，接分