VB 6 - How make screenshot of webbrowser and save to jpg

See http://stackoverflow.com/questions/3433259/vb6-capture-entire-web-page

My friend i am need code for VB6, i am trying this and not function, this is vor vb.net.
I am need for vb6.

Stand By....

There are many examples of code to do this but they are all written in DELPHI.

I am not really a Delphi programmer, but I have come across some VB modules that have a lot of functionality for manipulating Bitpamps and seem to have similar subroutines to the ones written in Delphi, so I am attempting top write some VB6 modules using that code.

It may take a little while so please be patient...I will keep you posted...Please stand by

Cheers
Chris
(craisin)

ok, i am waiting.

It is about 1am here now (Australia) - I have to play in a bridge (card game) competition tomorrow [i.e. today :-) ] but I can work on it later after I get home.

It is quite involved but I think I may be able to do this using VB6 code. I need to find VB6 equivalent actions to those used in Delphi code I have found (not every one is possible). I think the use of CLASS modules will be required, and I have quite a few I can use, all associated with capturing screens and saving JPG images.

If we solve this, it will be a first,, since I cannot see elsewhere where anybody has done this using VB6.  Fingers crossed!  :-)

Be back in about 17 hours to concentrate on the work I have already prepared.

Cheers
Chris

ok, i am waiting for solution of this problem. thanks

I have come up with thje following code, but it is having several problems, so I am testing ways to get it to work.

For the record I post the code below.

Stand by.......

(By the way, see my comments in your duplicated question on this matter).

Thanks
Chris

'PLace the following code inside a Form named Form1
Option Explicit
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Sub cmdCommand1_Click()
Dim cDib As New cDIBSection
Dim alTempPicture() As Long
Screen.MousePointer = vbHourglass
With WebBrowser1
   .Width = Me.ScaleX(800, vbPixels, Me.ScaleMode)
   .Height = Me.ScaleX(1100, vbPixels, Me.ScaleMode)
   .Navigate2 "http://www.ecbc.net.au"
   Do While Me.WebBrowser1.ReadyState <> READYSTATE_COMPLETE
      DoEvents
   Loop
End With
With Form1.Picture1
  .Visible = False
  .BorderStyle = vbBSNone
  .AutoRedraw = True
  .Height = WebBrowser1.Height
  .Width = WebBrowser1.Width
End With
'copy Webbrowser image to picturebox
SaveWebBrowserToPictureBox Me, Me.WebBrowser1, Me.Picture1

''Create a cDIBSection from the PictureBox
bPutPictureInLongArray Me.Picture1, alTempPicture
SetBitmapBits Me.Picture1, (UBound(alTempPicture) + 1) * 4, alTempPicture(0)

cDib.CreateFromPicture Me.Picture1

''Copy the converted image to the Clipboard as an Image
cDib.CopyToClipboard False

''Copy the newly converted image back in the PictureBox
Picture1.Picture = Clipboard.GetData()

'Save the image to a file
SavePicture Picture1.Image, CKRTempFile("C:\Temp", ".jpg")

'clear the clipboard (to free memory)
Clipboard.Clear
Screen.MousePointer = vbDefault
MsgBox "Image Created"
End Sub

Private Sub Form_Unload(Cancel As Integer)
  End
End Sub

'====================================================================

Select allOpen in new window

'PLace the following code in a module
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
  Alias "GetClassNameA" (ByVal hwnd As Long, _
  ByVal lpClassName As String, ByVal nMaxCount As Long) _
  As Long
Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CHILDREN = &H10&
Private Const PRF_CLIENT = &H4&
Private Const PRF_OWNED = &H20&
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Public Sub SaveWebBrowserToPictureBox(Form1 As Form, WebBrowser1 As WebBrowser, Picture1 As PictureBox)
  Dim myWindow As Long
  Dim childWindow As Long
  Dim myClass As String
  Dim className As String * 256

  'Picture1.Width = WebBrowser1.Width
  'Picture1.Height = WebBrowser1.Height
  Picture1.Width = Screen.Width
  Picture1.Height = Screen.Height
  Picture1.Cls
  myClass = "Shell Embedding"
  childWindow = GetWindow(Form1.hwnd, GW_CHILD)
  Do
    GetClassName childWindow, className, 256
    If Left$(className, Len(myClass)) = myClass Then
      myWindow = childWindow
      Exit Do
    End If
    childWindow = GetWindow(childWindow, GW_HWNDNEXT)
  Loop While childWindow <> 0
  If myWindow <> 0 Then
    SendMessage myWindow, WM_PAINT, Picture1.hdc, 0
    SendMessage myWindow, WM_PRINT, Picture1.hdc, _
                          PRF_CHILDREN + PRF_CLIENT + PRF_OWNED
  End If
  Picture1.Picture = Picture1.Image
End Sub

Select allOpen in new window

'Place the following code in another module
Option Explicit
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Public PicInfo As BITMAP

Public Function bPutPictureInLongArray(ByRef picPicture As PictureBox, _
                                       ByRef alPicture() As Long) As Boolean
  Dim BytesPerLine As Long
  Dim Size As Long
'
  GetObject picPicture.Image, Len(PicInfo), PicInfo
'  BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC
  Size = (BytesPerLine * PicInfo.bmHeight * 3)
  ReDim alPicture(0 To (Size / 4))
  GetBitmapBits picPicture.Image, Size, alPicture(0)
End Function

Select allOpen in new window

By the way, on the form you must place inside a "Frame" the webbrowser WHICH MUST BE VISIBLE (WebBrowser1)  as well as a PictureBox called "{Picture1" WHICH ALSO MUST BE VISIBLE.

You then change the frame to NOT VISIBLE which hides the browser and picturebox from view.

You cannot save the contents of an invisible webbrowser, because once you make it invisible all its functionality is turned off internally by the VB6 engine. YTo avoid users seeing the browser, you use the trick of placing it in an invisible frame.

The contents of the browser is always as a bitmap and saving as a JPG is tricky. There has to be manipulation of the bits to confoirm with JPEG standards. This is supposed to work using methods stored in the class called  CDIBSection, but I am having problems, hopefully I can work around.


If you were using VB.Net there would be no worries since the webbrowser in VB.Net is much more powerful and open in architecture, allowing direct coding to save images etc.

One possibility is for me to write a DLL in VB.NET but I am not sure whether the DLL can then be used in VB6. I will resort to this if nothing else succeeds just to see if it is an option.

Could you please confirm two things:
     1. This solution must be in VB6 and use of VB.NET at the frontend is not a
        solution
      2. You want only JPEG.  If other image types are an option, which ones?
          BMP, GIF, ICO, PNG, SNAG?

Oops....

PLease remove the line

    .Visible = False

from the code block referring to Picture1. (Line 18 in first listing of code)

Cheers
Chris

Some more code that is referenced. Place in seperate modules.

Option Explicit

Public Function CKRTempFile(Optional cDir As String, Optional cExt As String)
  Dim nRand As Integer
  Dim cRand As String

  If Len(Trim(cDir)) = 0 Then
    cDir = "c:\"

  End If
  If Dir(cDir + "\*.*", vbDirectory) = "" Then
    MkDir cDir
  End If
  If Len(Trim(cExt)) = 0 Then
    cExt = ".txt"

  End If

  Do While True
    nRand = CKRRandom(1000)
    cRand = CStr(nRand)

    If Right(cDir, 1) <> "\" Then
      cDir = cDir + "\"

    End If

    CKRTempFile = cDir + "Temp" + cRand + cExt

    If Not CKRFileExists(CKRTempFile) Then
      Exit Do

    End If

  Loop

End Function

Select allOpen in new window

Option Explicit

Public Function CKRRandom(nUpper As Integer, Optional nLower As Integer) As Integer
  Randomize
  CKRRandom = -1

  Do While CKRRandom < nLower
    CKRRandom = Int(nUpper * Rnd) + 1
  Loop

End Function

Select allOpen in new window

Option Explicit

Public Function CKRFileExists(FileName) As Boolean
  Dim fs As Object
  Set fs = CreateObject("Scripting.FileSystemObject")
  CKRFileExists = fs.FileExists(FileName)

End Function

Select allOpen in new window

Success!

Forget all the earlier code (although a lot of it is used).

We no longer need the Class module or need to manipulate the data.

I think the code is self explanatory, but just ask if there is something you do not understand.

Basically what I have done is make sure the Webbrowser is visible TO THE  VB ENGINE when it loads its url. You cannot refresh a hidden WebBrowser. In order to hide the Browser from the user, I have locked the screen updates, made the browser visible, refreshed the browser with its url, copied the browser image (using its memory handle) to the clipboard, copied the clipboard contents to the PictureBox using the handle of the clipboard which is stored in the picturebox image pointer, then loaded the Picturebox picture calling the pointer in its "Image" property (I hope this makes sense).

Then it was just a matter of saving the Picturebox picture to a file and releasing the lock on the screen updates.


Now the lock on the screen updates would be a problem to you if you are using the program for other functionality (entering data, scrolling through listboxes etc) since it will seem to "freeze" for a short period.

I do not know if that is what you are doing, but if the program is simply running in the background from a list or URL's then it should not be a problem.

The code I have supplied gives you the methodolgy to load a webpage into a webbrowser, and save the contents of the first page (no scrolling....sorry) as a jpg image somewhere on your computer.

I think this is a first for VB6, since I could not find this solution anywhere on the internet (excepot by using VB.Net)

I hope this method will solve uyour problem.

Please let me know  :-)   (I need the points before the month runs out!)

Cheers
Chris

'Place his code inside a form named FORM1
Option Explicit
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Public Sub LockWindow()
  LockWindowUpdate GetDesktopWindow
End Sub

Public Sub UnLockWindow()
  'Releases the desktop lock
  LockWindowUpdate False
End Sub

Private Sub cmdCommand1_Click()

'Turn off any screen updates while the save is in progress
LockWindow

'This must be done to allopw the "Ready_State" to be evaluated
WebBrowser1.Visible = True

With WebBrowser1
   .Width = Me.ScaleX(800, vbPixels, Me.ScaleMode)
   .Height = Me.ScaleX(1100, vbPixels, Me.ScaleMode)
   .Navigate2 "http://www.ecbc.net.au"
   Do While Me.WebBrowser1.ReadyState <> READYSTATE_COMPLETE
      DoEvents
   Loop
End With
With Form1.Picture1
  .BorderStyle = vbBSNone
  .AutoRedraw = True
  .Height = Screen.Height
  .Width = Screen.Width
End With

'copy Webbrowser image to picturebox
SaveWebBrowserToPictureBox Me, Me.WebBrowser1, Me.Picture1

'Save the image to a file
SavePicture Picture1.Image, CKRTempFile("C:\Temp", ".jpg")

'return browser to previous state
WebBrowser1.Visible = False

'allow screen updates to resume now that webbrowser has been re-hidden
UnLockWindow
MsgBox "Image Created"
End Sub

Private Sub Form_Unload(Cancel As Integer)
  End
End Sub

Select allOpen in new window

'Place this code in its own module
Option Explicit

Public Function CKRFileExists(FileName) As Boolean
  Dim fs As Object
  Set fs = CreateObject("Scripting.FileSystemObject")
  CKRFileExists = fs.FileExists(FileName)

End Function

Select allOpen in new window

'Place this code in its own module
Option Explicit

Public Function CKRRandom(nUpper As Integer, Optional nLower As Integer) As Integer
  Randomize
  CKRRandom = -1

  Do While CKRRandom < nLower
    CKRRandom = Int(nUpper * Rnd) + 1
  Loop

End Function

Select allOpen in new window

'Place this code in its own module
Option Explicit

Public Function CKRTempFile(Optional cDir As String, Optional cExt As String)
  Dim nRand As Integer
  Dim cRand As String

  If Len(Trim(cDir)) = 0 Then
    cDir = "c:\"

  End If
  If Dir(cDir + "\*.*", vbDirectory) = "" Then
    MkDir cDir
  End If
  If Len(Trim(cExt)) = 0 Then
    cExt = ".txt"

  End If

  Do While True
    nRand = CKRRandom(1000)
    cRand = CStr(nRand)

    If Right(cDir, 1) <> "\" Then
      cDir = cDir + "\"

    End If

    CKRTempFile = cDir + "Temp" + cRand + cExt

    If Not CKRFileExists(CKRTempFile) Then
      Exit Do

    End If

  Loop

End Function

Select allOpen in new window

'Place this code in its own module called "SaveWebbrowserToPictureBox"

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
  Alias "GetClassNameA" (ByVal hwnd As Long, _
  ByVal lpClassName As String, ByVal nMaxCount As Long) _
  As Long
Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CHILDREN = &H10&
Private Const PRF_CLIENT = &H4&
Private Const PRF_OWNED = &H20&
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Public Sub SaveWebBrowserToPictureBox(Form1 As Form, WebBrowser1 As WebBrowser, _
                                      ByRef Picture1 As PictureBox)
  Dim myWindow As Long
  Dim childWindow As Long
  Dim myClass As String
  Dim className As String * 256

  WebBrowser1.Width = Screen.Width
  WebBrowser1.Height = Screen.Height
  Picture1.Width = Screen.Width
  Picture1.Height = Screen.Height
  Picture1.Cls
  myClass = "Shell Embedding"
  childWindow = GetWindow(Form1.hwnd, GW_CHILD)
  Do
    GetClassName childWindow, className, 256
    If Left$(className, Len(myClass)) = myClass Then
      myWindow = childWindow
      Exit Do
    End If
    childWindow = GetWindow(childWindow, GW_HWNDNEXT)
  Loop While childWindow <> 0
  If myWindow <> 0 Then
    SendMessage myWindow, WM_PAINT, Picture1.hdc, 0
    SendMessage myWindow, WM_PRINT, Picture1.hdc, _
                          PRF_CHILDREN + PRF_CLIENT + PRF_OWNED
  End If
  Picture1.Picture = Picture1.Image
End Sub

Select allOpen in new window

On the form, have a command button called "cmdButton1"

Place a picturebox called "Picture1" and a Webbrowser control called "WebBrowser1"

Set both the Webbrowser and picturebox properties for Visible to "False"

Run the program, and the form shoudl appear with just the button on it.

Click on the button and then shortly after a message "Image saved" will appear.

Go to the folder "C:\Temp" on your computer and a jpg file should be there with a "random" name (such as "Temp618.jpg"). When you click on that you will see a full screen image of the saved page from the browser.

Of course you will not use this exact code for what you are doing, but the module "SaveWebBrowserToPictureBox" is the critical module.

If you do not ant the screen to "lock" during the process, then we have a problem, beciuse the Webbrowser MUST be visible to enable the update of the browsers screen to finish before the code contunies, therie there may only be partial screen captures.

I have tried many things, but basically the Webbrowser is NOT FUNCTIONAL if it is invisible. The only way you can go to a webpage and save it is having the webbrowser visible. Locking the screen, making it visible, doing the processing, returning it to invisible and then unlocking the screen is the only way you can do it with an invisible Webbrowser.

Please let me know if that solves your dilemma...

Cheers
Chris
(craisin)

thankss

I notice that the accepted solution was comment 36599279, but I cannot believe that was the correct solution.

Please confirm that the comment 36600486 should be the correct answer.

I will then ask the moderator to adjust the records.

Many thanks
Chris
(craisin)