麻烦热心人帮忙调试段代码 ( 积分: 200 )

  • 主题发起人 主题发起人 edren
  • 开始时间 开始时间
E

edren

Unregistered / Unconfirmed
GUEST, unregistred user!
这是个网页快照的代码,我调试不过
停在IViewObject过不去,IViewObject是什么?麻烦热心人帮忙用D6调试一下,并给出整个代码(我需要从unit Unit1;开头到end.的整个PAS代码)
同时麻烦告诉我除了用到WebBrowser还用到什么控件,我加了MSHTML,jpeg一样是到ViewObject: IViewObject;就过不去
var
Doc: IHTMLDocument2;
ViewObject: IViewObject;
sourceDrawRect: TRect;
a, getjpg: TBitMap;
i, m: integer;
pdest, psour: hbitmap;
jpg: tjpegimage;
begin
Doc := WebBrowser.Document as IHTMLDocument2;
if Webbrowser.Document < > nil then
try
webbrowser.Document.QueryInterface(IViewObject, ViewObject);
if ViewObject < > nil then
try
Doc.Get_ParentWindow.Scroll(0, 0); //跳到网页头
getjpg := TBitMap.Create();
getjpg.PixelFormat := pf24bit;
getjpg.Height := doc.Body.getAttribute( &amp;apos;scrollHeight &amp;apos;, 0);
getjpg.Width := doc.Body.getAttribute( &amp;apos;scrollwidth &amp;apos;, 0);
pdest := getjpg.Canvas.Handle;
m := Trunc(doc.Body.getAttribute( &amp;apos;ScrollHeight &amp;apos;, 0) / (doc.Body.getAttribute( &amp;apos;offsetHeight &amp;apos;, 0) - 20));
i := Trunc(doc.Body.getAttribute( &amp;apos;Scrollwidth &amp;apos;, 0) / (doc.Body.getAttribute( &amp;apos;offsetwidth &amp;apos;, 0) - 20));
for i := 0 to i do
begin
for m := 0 to m + 1 do
begin
a := TBitMap.Create();
a.Height := doc.Body.getAttribute( &amp;apos;offsetHeight &amp;apos;, 0);
a.Width := doc.Body.getAttribute( &amp;apos;offsetwidth &amp;apos;, 0);
psour := a.Canvas.handle;
sourceDrawRect := Rect(0, 0, a.Width, a.Height);
ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle, a.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
bitblt(pdest, doc.Body.getAttribute( &amp;apos;scrollLeft &amp;apos;, 0), doc.Body.getAttribute( &amp;apos;Scrolltop &amp;apos;, 0), a.Width, a.Height, psour, 2, 2, srccopy);
Doc.Get_ParentWindow.Scroll(doc.Body.getAttribute( &amp;apos;scrollLeft &amp;apos;, 0), doc.Body.getAttribute( &amp;apos;offsetHeight &amp;apos;, 0) + doc.Body.getAttribute( &amp;apos;Scrolltop &amp;apos;, 0) - GetSystemMetrics(SM_CXVSCROLL) - 24);
a.Free;
end;
Doc.Get_ParentWindow.Scroll(doc.Body.getAttribute( &amp;apos;offsetwidth &amp;apos;, 0) + doc.Body.getAttribute( &amp;apos;scrollLeft &amp;apos;, 0) - GetSystemMetrics(SM_CXVSCROLL) - 24, 0);
end;
jpg := tjpegimage.Create;
jpg.Assign(getjpg);
getjpg.Free;
jpg.SaveToFile( &amp;apos;c:/test.jpg &amp;apos;);
jpg.Free;
finally
ViewObject._Release;
end;
except
end;
end;
 
uses MSHTML_TLB;
 
我D6里没有MSHTML_TLB啊
 
D7里也没有 file not found:'MSHTML_TAB.dcu
 
uses ActiveX
 
代码还需要别人帮你调试,服了.你可以考虑转行了.
 
QQ 87797301
 
sky1001,那么好调试吗,你调试成功来看看.不让有人要问候你家人了
 
代码超烂,懒得看。
 
唉,你这种人哪.真的不适合搞软件,至于问候,你就留着给你自己家里人吧.
随便给你一个完整的代码,看你这么可怜.
unit MainForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, OleCtrls, SHDocVw, StdCtrls, MSHTML;

type
TForm1 = class(TForm)
Edit1 : TEdit;
Button1 : TButton;
Button2 : TButton;
WebBrowser1: TWebBrowser;
Image1 : TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses
JPEG, ActiveX, ComObj;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(Edit1.Text)
end;


procedure GenerateJPEGfromBrowser(browser: iWebBrowser2;
jpegFQFilename: string; srcHeight:
integer; srcWidth: integer;
tarHeight: integer; tarWidth: integer);
var
sourceDrawRect: TRect;
targetDrawRect: TRect;
sourceBitmap : TBitmap;
targetBitmap : TBitmap;
aJPG : TJPEGImage;
aViewObject : IViewObject;
begin
sourceBitmap := TBitmap.Create;
targetBitmap := TBitmap.Create;
aJPG := TJPEGImage.Create;
try
try
sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
sourceBitmap.Width := srcWidth;
sourceBitmap.Height := srcHeight;
aViewObject := browser as IViewObject;
if aViewObject=nil then
Exit;
OleCheck(aViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil,
Form1.Handle,
sourceBitmap.Canvas.Handle,
@sourceDrawRect, nil, nil, 0));
targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
targetBitmap.Height := tarHeight;
targetBitmap.Width := tarWidth;
targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);
aJPG.Assign(targetBitmap);
aJPG.SaveToFile(jpegFQFilename)
finally
aJPG.Free;
sourceBitmap.Free;
targetBitmap.Free
end;
except
raise Exception.Create('failed to capture the webpage!');
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
IDoc : IHTMLDocument2;
IWeb : iWebBrowser2;
tmpX : integer;
tmpY : integer;
begin
with WebBrowser1 do
begin
Document.QueryInterface(IHTMLDocument2, IDoc);
IWeb := ControlInterface;
tmpX := Height;
tmpY := Width;
Height := OleObject.Document.ParentWindow.Screen.Height;
Width := OleObject.Document.ParentWindow.Screen.Width;
GenerateJPEGfromBrowser(IWeb, './page1.jpg',Height, Width,Height, Width);
Height := tmpX;
Width := tmpY;
Image1.Picture.LoadFromFile('./page1.jpg')
end;
end;


end.
 
接受答案了.
 
后退
顶部