Link to home
Start Free TrialLog in
Avatar of adamcable
adamcable

asked on

Convert html URLs to jpeg screenshots

Hi all,
I'm trying to write a vb app to convert a URL to a jpg screenshot (i would expect to run this as a batch job via a command line at some point).
I think I need to open up an IE window invisibly, wait for the page to load, then to get a screenshot and save it to disk. However, I'm completely unsure about how to start this.

I've offered the full 500 points for this, so some code and info to help me to get started would be very useful here.

Thanks in anticipation.
Cheers,
Adam
Avatar of aelatik
aelatik
Flag of Netherlands image

I once did this for fun but i encountered many problems with it.

The way i had done it was using the Internet Object to navigate to a given website and wait for it to load.
After that i did a sreenshot > saved the clipboard content to file > and closed the internet session.

The problems i had was that it did not work when navigation happened invisble. The screenshot then becomes black.
Another problem was with the screensaver etc. If your app is visible on screen then it will work. Otherwise it wont. ( In this method ofcourse, i can't figure out another way of doing it )


Here you go, this basically does the JOB. maybe it gives you better ideas. ( Add a picture control to your form and paste the following )

Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub Form_Load()
    TakePicture "https://www.experts-exchange.com", "c:\ee.jpg"
End Sub

Private Function TakePicture(URL As String, Filename As String)
    Dim IE As Object
    Set IE = CreateObject("internetexplorer.application")
        IE.fullscreen = True
        IE.AddressBar = False
       
        IE.navigate URL
        While IE.busy: DoEvents: Wend
        IE.Visible = True
        IE.StatusBar = False
        IE.ToolBar = False
        While IE.busy: DoEvents: Wend
        keybd_event &H2C, 0, 0, 0
        keybd_event &H2C, 1, 0, 0
        keybd_event &H2C, 1, 0, 0
        DoEvents
        Picture1.Picture = Clipboard.GetData
        IE.Quit
    Set IE = Nothing
        SavePicture Picture1.Picture, Filename
End Function
Avatar of sokolovsky
sokolovsky

Hmm...
1)Use WebBrowser control to navigate to desired URL.
2)Capture the content of WebBrowser when download completes.
3)Save as JPG.
Nice JPEG class is here:
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=50065&lngWId=1

If you need help using WebBrowser control, ask here.
Avatar of adamcable

ASKER

aelatik,
Thanks for that code - it does do the job, although ideally I am looking for something that can run in the background, and without the need for screenshots.

Sokolovksy,
Can you explain (in code?) how this would work using the WebBrowser control?
Would this require a screenshot mechanism, or could it be done a different way?

Thanks to both of you.
Adam

Check into this, how to capture the form, I'm not sure whether it can caption if the form is not visible, you can try it out. Use  aelatik' method and this

https://www.experts-exchange.com/questions/20356130/Print-Form.html
Eddykt, the one i did build contained that code. Unfortunately it doesn't work in invisible mode :-(
This is my code:
'You need form frmTest with WebBrowser1 control (Microsoft Internet Controls)
'and PictureBox "Picture1"
'And class clsCapture (not mine, was posted in Q_20356130)

' Start of Form Code
Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Function GetIEWindow(ByVal ParentHwnd As Long) As Long
    Dim hWnd As Long
    hWnd = FindWindowEx(ParentHwnd, ByVal 0&, "Shell Embedding", vbNullString)
    GetIEWindow = hWnd
End Function
Private Sub Form_Activate()
    Dim CW As clsCapture
    'Me.WindowState = vbMinimized
    Me.Visible = False
    WebBrowser1.Visible = True
    WebBrowser1.Navigate "http://www.google.com"
    While WebBrowser1.Busy
        DoEvents
    Wend
    Set CW = New clsCapture
    Me.Visible = True
    Me.Picture1.Visible = True
    'Me.WindowState = vbNormal
    DoEvents
    Dim dx, dy, dw, dh
    Picture1.PaintPicture CW.CaptureClientfromHwnd(GetIEWindow(Me.hWnd)), 1, 1
    'If previous line dosn't work, uncomment next line
    'Picture1.PaintPicture CW.CaptureClient(Me), 1, 1
    'Picture1.PaintPicture CW.CaptureWindow(Me.hWnd, True, 1, 1, Me.ScaleWidth, Me.ScaleHeight), 1, 1
    Me.Visible = False
    Set Picture1.Picture = Picture1.Image
    SavePicture Picture1.Picture, "c:\11.bmp"
    Me.Visible = False
    Call MsgBox("Check c:\11.bmp")
    'Check "c:\11.bmp"
    'You may exit there
    Set CW = Nothing
    Unload Me
End Sub
Private Sub Form_Load()
    Me.ScaleMode = vbPixels
    Me.ScaleHeight = 500
    Me.ScaleWidth = 500
    Me.AutoRedraw = True
    Picture1.AutoRedraw = True
    Call WebBrowser1.Move(1, 1, 500, 500)
    Call Picture1.Move(1, 1, 500, 500)
End Sub
' End of Form Code
' Start of clsCapture code
Option Explicit
Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type Size
        cx As Long
        cy As Long
End Type

Private Type PALETTEENTRY
   peRed As Byte
   peGreen As Byte
   peBlue As Byte
   peFlags As Byte
End Type

Private Type LOGPALETTE
   palVersion As Integer
   palNumEntries As Integer
   palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors.
End Type

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104
         
Private Type PicBmp
   Size As Long
   Type As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
Private Type SystemInfo
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type
Private Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type
Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" _
                        (ByVal hWnd As Long, _
                         lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" _
                        (ByVal hWnd As Long, _
                         lpPoint As POINTAPI)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, _
                          ByVal X As Long, _
                          ByVal Y As Long)
'Declare Function WNetGetUser Lib "user32" (ByVal USER As String, BufSize As Long) As Long
Private Declare Function GetFreeSpace Lib "kernel32" Alias "GetFreeSpaceA" (ByVal flag As Integer) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer _
    As String, ByVal nSize As Long) As Long
'the GetSystemInfo sub (following) replaces the GetWinFlags function in the Win16 API
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SystemInfo)
'the GlobalMemoryStatus sub (following) substitutes for GetFreeSystemResources in the Win16 API
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree As Long) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, _
    ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, _
    ByVal hWnd As Long, lpReserved As Any) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, _
    ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hdc As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long
' Private dECLARE Function GetDeviceCaps Lib "GDI32" ( _
'    ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" ( _
    ByVal hdc As Long, ByVal wStartIndex As Long, _
    ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) _
    As Long
Private Declare Function CreatePalette Lib "gdi32" ( _
    lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
    ByVal hdc As Long, ByVal hObject As Long) As Long
'Private dECLARE Function BitBlt Lib "GDI32" ( _
'   ByVal hDCDest As Long, ByVal XDest As Long, _
'   ByVal YDest As Long, ByVal nWidth As Long, _
'   ByVal nHeight As Long, ByVal hDCSrc As Long, _
'   ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) _
'  As Long
Private Declare Function DeleteDC Lib "gdi32" ( _
           ByVal hdc As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () _
         As Long
Private Declare Function SelectPalette Lib "gdi32" ( _
            ByVal hdc As Long, ByVal hPalette As Long, _
           ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" ( _
            ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "user32" ( _
               ByVal hWnd As Long) As Long
'Private dECLARE Function GetDC Lib "USER32" ( _
'   ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hWnd As Long, lpRect As RECT) As Long
'Private dECLARE Function ReleaseDC Lib "USER32" ( _
'   ByVal hWnd As Long, ByVal hDC As Long) As Long
'Private dECLARE Function GetDesktopWindow Lib "USER32" () As Long
Private Declare Function OleCreatePictureIndirect _
  Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
  ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function GetWindowExtEx Lib "gdi32" (ByVal hdc As Long, lpSize As Size) As Long
Private Declare Function GetWindowOrgEx Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Public Function CaptureClientfromHwnd(hWnd As Long) As Picture
Dim DocPlacement As RECT
Dim h As Long
Dim w As Long
GetClientRect hWnd, DocPlacement
h = DocPlacement.Bottom - DocPlacement.Top
w = DocPlacement.Right - DocPlacement.Left
' H & w should now have what we need but the did go through some metric conversion but I think that GetClientRect may give us what we need.
        Set CaptureClientfromHwnd = CaptureWindow(hWnd, True, 0, 0, w, h)

End Function
      ' CreateBitmapPicture
      '    - Creates a bitmap type Picture object from a bitmap and
      '      palette.
      ' hBmp
      '    - Handle to a bitmap.
      ' hPal
      '    - Handle to a Palette.
      '    - Can be null if the bitmap doesn't use a palette.
      ' Returns
      '    - Returns a Picture object containing the bitmap.
         Public Function CreateBitmapPicture(ByVal hBmp As Long, _
            ByVal hPal As Long) As Picture

            Dim r As Long

         Dim pic As PicBmp
         ' IPicture requires a reference to "Standard OLE Types."
         Dim IPic As IPicture
         Dim IID_IDispatch As GUID

         ' Fill in with IDispatch Interface ID.
         With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
         End With

         ' Fill Pic with necessary parts.
         With pic
            .Size = Len(pic)          ' Length of structure.
            .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
            .hBmp = hBmp              ' Handle to bitmap.
            .hPal = hPal              ' Handle to palette (may be null).
         End With

         ' Create Picture object.
         r = OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)

         ' Return the new Picture object.
         Set CreateBitmapPicture = IPic
      End Function
      ' CaptureWindow
      '    - Captures any portion of a window.
      ' hWndSrc
      '    - Handle to the window to be captured.
      ' Client
      '    - If True CaptureWindow captures from the client area of the
      '      window.
      '    - If False CaptureWindow captures from the entire window.
      ' LeftSrc, TopSrc, WidthSrc, HeightSrc
      '    - Specify the portion of the window to capture.
      '    - Dimensions need to be specified in pixels.
      ' Returns
      '    - Returns a Picture object containing a bitmap of the specified
      '      portion of the window that was captured.
         Public Function CaptureWindow(ByVal hWndSrc As Long, _
            ByVal Client As Boolean, ByVal LeftSrc As Long, _
            ByVal TopSrc As Long, ByVal WidthSrc As Long, _
            ByVal HeightSrc As Long) As Picture

            Dim hDCMemory As Long
            Dim hBmp As Long
            Dim hBmpPrev As Long
            Dim r As Long
            Dim hDCSrc As Long
            Dim hPal As Long
            Dim hPalPrev As Long
            Dim RasterCapsScrn As Long
            Dim HasPaletteScrn As Long
            Dim PaletteSizeScrn As Long
     
         Dim LogPal As LOGPALETTE

         ' Depending on the value of Client get the proper device context.
         If Client Then
            hDCSrc = GetDC(hWndSrc) ' Get device context for client area.
         Else
            hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire
                                          ' window.
         End If

         ' Create a memory device context for the copy process.
         hDCMemory = CreateCompatibleDC(hDCSrc)
         ' Create a bitmap and place it in the memory DC.
         hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
         hBmpPrev = SelectObject(hDCMemory, hBmp)

         ' Get screen properties.
         RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
                                                            ' capabilities.
         HasPaletteScrn = RasterCapsScrn And RC_PALETTE       ' Palette
                                                              ' support.
         PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
                                                              ' palette.

         ' If the screen has a palette make a copy and realize it.
         If HasPaletteScrn And (PaletteSizeScrn = 256) Then
            ' Create a copy of the system palette.
            LogPal.palVersion = &H300
            LogPal.palNumEntries = 256
            r = GetSystemPaletteEntries(hDCSrc, 0, 256, _
                LogPal.palPalEntry(0))
            hPal = CreatePalette(LogPal)
            ' Select the new palette into the memory DC and realize it.
            hPalPrev = SelectPalette(hDCMemory, hPal, 0)
            r = RealizePalette(hDCMemory)
         End If

         ' Copy the on-screen image into the memory DC.
         r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
            LeftSrc, TopSrc, vbSrcCopy)

      ' Remove the new copy of the  on-screen image.
         hBmp = SelectObject(hDCMemory, hBmpPrev)

         ' If the screen has a palette get back the palette that was
         ' selected in previously.
         If HasPaletteScrn And (PaletteSizeScrn = 256) Then
            hPal = SelectPalette(hDCMemory, hPalPrev, 0)
         End If

         ' Release the device context resources back to the system.
         r = DeleteDC(hDCMemory)
         r = ReleaseDC(hWndSrc, hDCSrc)

         ' Call CreateBitmapPicture to create a picture object from the
         ' bitmap and palette handles. Then return the resulting picture
         ' object.
         Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
      End Function
      ' CaptureScreen
      '    - Captures the entire screen.
      ' Returns
      '    - Returns a Picture object containing a bitmap of the screen.
      Public Function CaptureScreen() As Picture
            Dim hWndScreen As Long
         ' Get a handle to the desktop window.
         hWndScreen = GetDesktopWindow()
         ' Call CaptureWindow to capture the entire desktop give the handle
         ' and return the resulting Picture object.
         Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, _
            Screen.Width \ Screen.TwipsPerPixelX, _
            Screen.Height \ Screen.TwipsPerPixelY)
      End Function
      ' CaptureForm
      '    - Captures an entire form including title bar and border.
      ' frmSrc
      '    - The Form object to capture.
      ' Returns
      '    - Returns a Picture object containing a bitmap of the entire
      '      form.
      Public Function CaptureForm(frmSrc As Form) As Picture
         ' Call CaptureWindow to capture the entire form given its window
         ' handle and then return the resulting Picture object.
         Set CaptureForm = CaptureWindow(frmSrc.hWnd, False, 0, 0, _
            frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), _
            frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
      End Function

      ' CaptureClient
      '    - Captures the client area of a form.
      ' frmSrc
      '    - The Form object to capture.
      ' Returns
      '    - Returns a Picture object containing a bitmap of the form's
      '      client area.
      Public Function CaptureClient(frmSrc As Object) As Picture
         ' Call CaptureWindow to capture the client area of the form given
         ' its window handle and return the resulting Picture object.
         Set CaptureClient = CaptureWindow(frmSrc.hWnd, True, 0, 0, _
            frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels), _
            frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels))
      End Function
      ' CaptureActiveWindow
      '    - Captures the currently active window on the screen.
      ' Returns
      '    - Returns a Picture object containing a bitmap of the active
      '      window.
      Function CaptureActiveWindow() As Picture
        Dim hWndActive As Long
        Dim r As Long
        Dim RectActive As RECT
         ' Get a handle to the active/foreground window.
         hWndActive = GetForegroundWindow()
         ' Get the dimensions of the window.
         r = GetWindowRect(hWndActive, RectActive)
         ' Call CaptureWindow to capture the active window given its
         ' handle and return the Resulting Picture object.
      Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, _
            RectActive.Right - RectActive.Left, _
            RectActive.Bottom - RectActive.Top)
      End Function
' End of clsCapture code

Can you set the form visible and move out of the screen ?
That will indeed work, it also works when the application doesn't have focus or is in a underlying form
Thanks - both of these options work.
However, I am looking for an option which does not need to display the IE page that it is snap-shotting. Also, I may also run more than one of these at once... any ideas?

btw - thanks for all the help so far!

Adam
Try this

add internet control and 2 times

Option Explicit

' hide window from task manager
Const SW_HIDE = 0
Const GW_OWNER = 4

'Window always on top
Const SWP_NOACTIVATE = &H10
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Private Sub Form_Load()

    ShowWindow GetWindow(hwnd, GW_OWNER), SW_HIDE
    SetWindowPos hwnd, -1, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE
    Me.Visible = False
    Timer1.Interval = 1
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    WebBrowser1.Navigate "http://www.microsoft.com" 'Command
End Sub

Private Sub Timer2_Timer()
    Timer2.Enabled = False
    End
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    If (pDisp = WebBrowser1) Then
        WebBrowser1.ExecWB 6, 2, 0, 0
        Timer2.Interval = 3000
        Timer2.Enabled = True
    End If
End Sub
EDDYKT, this seems to try to print the web page it has gone to... how can this be used to capture the webpage as an image?
You can use my code and as was mentioned in Comment from EDDYKT,
you can set the form visible and move out of the screen (to 2000,2000 for example)

>Also, I may also run more than one of these at once... any ideas
Hmm. Ok, pass the required URL as CommandLine Parameter and run as many instanses of program as you want,
or simply create text file with list of URLS, for example:
http://www.google.com
https://www.experts-exchange.com
...
Read line by line and create snap-shoots as you want.
sokolovsky,

I'm unsure on how I can combine these two pieces of code together.
I have tried using a me.left, and me.top to move the form out of the window, and have tried variations of resizing the objects to get a different browser ratio, but I either got a black bitmap, or a weird screen grab.

Cheers,
Adam
ASKER CERTIFIED SOLUTION
Avatar of modulo
modulo

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial