文章探索:   分类:    关键字:  
  + 栏目导航
  + 相关文章
文本框中光标位置的获得
用VB导入导出你的IE收藏夹
VB应用程序访问SQL Server方法探讨
VB访问SQL Server数据库技术全揭密
自动上网抓数据的机器人
自己的IE——用VB制作浏览器
VB中如何保存Webbrowser中的整个页面..
在VB中该如何控制其它程序的弹出窗口..
保存webbrowser中的HTML内容
破译动网验证码的简单方法
轻松获取QQ密码
VB.NET获取硬盘序列号的方法
WEBBROWSER 技巧一(收藏)
VB自动登陆网络站点详解(二):Inet..
获取webbrowser控件网页的源码
WebBrowser控件说明
关于用VB做更漂亮的窗体的思考
VB中访问存储过程的几种办法
VB6中改变屏幕的分辨率和刷新频率
VB编写一个能显示百分比的自定义进度..
公农历转换VB类
VB.NET窗口渐淡关闭
使用VB实现邮箱自动注册(二):修改..
VB.NET轻松实现任务栏程序
VB.NET启动外部程序
利用vb实现图片上传
VB实现局域网内的文件传输
VB 一个Function传回多个值
在VB中实现多线程
VB 手机号码编码程序


技术教程 -> VB教程 ->  
VB中如何保存Webbrowser中的整个页面到一幅图片
来源:转载   人气:1909   录入时间:2007-11-8
    这个应该可以了,首先picture1.autoredraw=true,visible=false,form1.scalemode=3
   
   Option Explicit
   Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
   Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
   
   Private Sub Command1_Click()
   Dim tDoc As MSHTML.HTMLDocument
   Dim tIV As IViewObject
   
   Dim tRc As RECT
   
   Dim tOw&, tOh&, tSw&, tSh&
   
   tOw = WebBrowser1.Width
   tOh = WebBrowser1.Height
   
   Set tDoc = WebBrowser1.Document
   Set tIV = tDoc
   
   tDoc.body.Scroll = "no"
   
   tSw = tDoc.body.scrollWidth + 4
   tSh = tDoc.body.scrollHeight + 4
   
   Dim tHdl&
   tHdl = GetWebHwnd()
   
   MoveWindow tHdl, 0, 0, tSw, tSh, 0
   
   tRc.Right = tSw
   tRc.Bottom = tSh
   
   Picture1.Cls
   Picture1.Move Picture1.Left, Picture1.Top, tSw, tSh
   
   tIV.Draw DVASPECT_CONTENT, 1, ByVal 0, ByVal 0, _
   0&, Picture1.hDC, tRc, tRc, ByVal 0, ByVal 0
   
   tDoc.body.Scroll = "yes"
   MoveWindow tHdl, 0, 0, tOw, tOh, 1
   SavePicture Picture1.Image, "c:\web.bmp"
   Picture1.Cls
   
   End Sub
   
   
   Private Sub Command2_Click()
   Dim t As New WshShell
   t.Run "msgbox"
   End Sub
   
   Private Sub Form_Load()
   WebBrowser1.Navigate "www.pconline.com.cn"
   End Sub
   
   Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
   Cancel = True
   End Sub
   
   
   Private Function GetWebHwnd() As Long
   Dim tHdl&
   tHdl = FindWindowEx(Me.hwnd, 0, "Shell Embedding", "")
   If tHdl <> 0 Then
   tHdl = FindWindowEx(tHdl, 0, "Shell DocObject View", "")
   If tHdl <> 0 Then
   GetWebHwnd = tHdl
   End If
   End If
   End Function
   




Copyright(C)2007-2021 广州市佳沛数码科技有限公司 版权所有
公司地址: 广州市荔湾区东漖北路560号511室
电话:020-81803473 传真:020-81544987