Imports System.IO
Imports System.Runtime.InteropServices

' Dieses Programmstück ist ein Ausschnitt aus einem VB.NET Projekt, bei dem es darum ging,
' Webseiten im Internet aufrufen und dann in Form eines Snapshots in einer Datei speichern zu können.
' Dabei sollte exakt der Zustand der Ansicht erfasst werden, unabhängig davon ob die Webseite sich 
' via Javascript oder dynamisches HTML clientseitig ändern kann.

' Die gewählte Lösung war, auf das zuständige Webbrowser-Steuerelement über das Interface IViewObject
' zuzugreifen und die Methode Draw() zu nutzen, um das Rendern des Webseiteninhalts auf ein eigenes
' Bitmap zu veranlassen.

Imports IViewObjectImports

' Diese Bibliothek enthält das Interface IViewObject, ich habe sie erstellt mit den Dienstprogrammen
'
'   midl IViewObjectImports.idl 
'   tlbimp IViewObjectImports.tlb 
'
' Ihr Inhalt sieht so aus:
'
' [ uuid(91031b6e-d9de-42b0-80f2-945670c20de9) ] library P4MImports {
'
'     import "MsHtmHst.idl";
'     import "ExDisp.idl";
'     import "MsHTML.Idl";
' 
'     struct _RECTL;
'     enum tagREADYSTATE;
'     enum tagDOCHOSTUIFLAG;
'     interface ICustomDoc;
'     interface IDocHostUIHandler;
'     interface IHTMLDocument2;
'     interface IHTMLDocument3;
'     interface IHTMLElement2;
' };

Public Class MainForm

  Private HorizontalMargin As Integer = 0
  Private VerticalMargin As Integer = 0

  Private Sub MainForm_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

    ContainerWindow.Top = BrowserBar.Bottom + 1
    ContainerWindow.Height = StatusBar.Top - BrowserBar.Bottom - 1
    ContainerWindow.Width = Me.Width

    HorizontalMargin = Me.Width - ContainerWindow.Width
    VerticalMargin = Me.Height - ContainerWindow.Height

    BrowserWindow.Width = ContainerWindow.Width
    BrowserWindow.Height = ContainerWindow.Height

    StatusDate.Text = Now.ToString("dd.MM.yyyy")
    URL.Text = "about:blank"

  End Sub

  Private Sub MainForm_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize

    If HorizontalMargin + VerticalMargin > 0 Then
      ContainerWindow.Width = Me.Width - HorizontalMargin
      ContainerWindow.Height = Me.Height - VerticalMargin

      BrowserWindow.Width = ContainerWindow.Width
      BrowserWindow.Height = ContainerWindow.Height
    End If

  End Sub

  Private Sub MainForm_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Closed

    WindowInfo.SaveView()

  End Sub

  Private Sub URL_Enter(ByVal sender As Object, ByVal e As System.EventArgs) Handles URL.Enter

    URL.SelectAll()

  End Sub

  Private Sub URL_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles URL.KeyDown

    If e.KeyCode = Keys.Enter Then RefreshButton_Click(sender, e)

  End Sub

  Private Sub MenuAnsichtspeichern_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles MenuAnsichtSpeichern.Click

    ScreenCapture()

  End Sub

  Private Sub RefreshButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles RefreshButton.Click

    BrowserWindow.Navigate(URL.Text)

  End Sub

  Private Sub StopButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles StopButton.Click

    BrowserWindow.Stop()

  End Sub

  Private Sub BackButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles BackButton.Click

    BrowserWindow.GoBack()

  End Sub

  Private Sub ForwardButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ForwardButton.Click

    BrowserWindow.GoForward()

  End Sub

  Private Sub MenuBeenden_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles MenuBeenden.Click

    Me.Close()

  End Sub

  Private Sub BrowserWindow_CanGoBackChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles BrowserWindow.CanGoBackChanged

    BackButton.Enabled = BrowserWindow.CanGoBack

  End Sub

  Private Sub BrowserWindow_CanGoForwardChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles BrowserWindow.CanGoForwardChanged

    ForwardButton.Enabled = BrowserWindow.CanGoForward

  End Sub

  Private Sub BrowserWindow_DocumentCompleted(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles BrowserWindow.DocumentCompleted

    Dim OnClickHandler As EventHandler = New EventHandler(AddressOf BrowserWindow_Click)

    BrowserWindow.Document.AttachEventHandler("onclick", OnClickHandler)

  End Sub

  Private Sub BrowserWindow_Navigated(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserNavigatedEventArgs) Handles BrowserWindow.Navigated

    URL.Text = BrowserWindow.Url.ToString

  End Sub

  Private Sub BrowserWindow_StatusTextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles BrowserWindow.StatusTextChanged

    StatusLabel.Text = BrowserWindow.StatusText()

  End Sub

  Public Sub ScreenCapture()

    If BrowserWindow.Document Is Nothing Then Exit Sub

    Dim Document2 As IHTMLDocument2 = CType(BrowserWindow.Document.DomDocument, IHTMLDocument2)
    Dim Document3 As IHTMLDocument3 = CType(BrowserWindow.Document.DomDocument, IHTMLDocument3)

    If Document2 Is Nothing Then Exit Sub

    Dim Element2 As IHTMLElement2 = CType(Document2.body, IHTMLElement2)
    Dim Element3 As IHTMLElement2 = CType(Document3.documentElement, IHTMLElement2)

    If Element2 Is Nothing Then Exit Sub

    Dim CurrentWidth = BrowserWindow.Width
    Dim CurrentHeight = BrowserWindow.Height

    Dim PageWidth As Integer = Math.Max(Element2.scrollWidth, Element3.scrollWidth)
    Dim PageHeight As Integer = Math.Max(Element3.scrollHeight, Element2.scrollHeight)

    Dim FileNameDialog As New SaveFileDialog

    FileNameDialog.Filter = "JPEG-Dateien (*.jpg)|*.jpg"
    FileNameDialog.FileName = "P4M.jpg"
    FileNameDialog.CheckPathExists = True
    FileNameDialog.CheckFileExists = False
    FileNameDialog.Title = "Webseite speichern"

    If FileNameDialog.ShowDialog() = Windows.Forms.DialogResult.OK Then
      BrowserWindow.SetBounds(0, 0, PageWidth, PageHeight)

      ' ACHTUNG: Damit die vollständige Webseite gespeichert werden kann, ist es notwendig,
      ' dass die SetBounds Anweisung korrekt die Größe des Browserfensters anpassen kann.
      ' Um das zu gewährleisten, muß sich das WebBrowser Steuerelement in einem Container 
      ' befinden und darf nicht automatisch an dessen Größe angedockt werden.

      Dim B As Bitmap = New Bitmap(PageWidth, PageHeight)
      Dim G As Graphics = Graphics.FromImage(B)

      Try
        Dim Bounds As _RECTL

        Bounds.left = 0
        Bounds.top = 0
        Bounds.right = PageWidth
        Bounds.bottom = PageHeight

        Dim V As IViewObject = CType(Document2, IViewObject)
        Dim hdc As IntPtr = G.GetHdc

        V.Draw(1, -1, 0, 0, 0, hdc, Bounds, 0, 0, 0)

        G.ReleaseHdc(hdc)

        Dim TimeStamp As String = Now.ToString("dd.MM.yy hh:mm:ss")
        Dim TimeStampSize As New SizeF(G.MeasureString(TimeStamp, Me.Font))

        G.FillRectangle(Brushes.WhiteSmoke, 10, 10, TimeStampSize.Width, TimeStampSize.Height)
        G.DrawString(TimeStamp, Me.Font, Brushes.Black, 10, 10)
      Finally
        B.Save(FileNameDialog.FileName, System.Drawing.Imaging.ImageFormat.Jpeg)

        B.Dispose()
        G.Dispose()
      End Try

      BrowserWindow.SetBounds(0, 0, CurrentWidth, CurrentHeight)
    End If

  End Sub

End Class

<ComImport(), Guid("0000010D-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), ComConversionLoss()> _
Public Interface IViewObject

  Sub Draw( _
    <MarshalAs(UnmanagedType.U4)> ByVal dwDrawAspect As UInt32, _
    ByVal lindex As Integer, _
    ByVal pvAspect As IntPtr, _
    <InAttribute()> ByVal ptd As IntPtr, _
    ByVal hdcTargetDev As IntPtr, _
    ByVal hdcDraw As IntPtr, _
    <MarshalAs(UnmanagedType.Struct)> ByRef lprcBounds As _RECTL, _
    <InAttribute()> ByVal lprcWBounds As IntPtr, _
    ByVal pfnContinue As IntPtr, _
    <MarshalAs(UnmanagedType.U4)> ByVal dwContinue As UInt32)

  Sub RemoteGetColorSet( _
    <InAttribute()> ByVal dwDrawAspect As UInteger, _
    <InAttribute()> ByVal lindex As Integer, _
    <InAttribute()> ByVal pvAspect As UInteger, _
    <InAttribute()> ByRef ptd As tagDVTARGETDEVICE, _
    <InAttribute()> ByVal hicTargetDev As UInteger, _
    <OutAttribute()> ByVal ppColorSet As IntPtr)
  Sub RemoteFreeze( _
   <InAttribute()> ByVal dwDrawAspect As UInteger, _
   <InAttribute()> ByVal lindex As Integer, _
   <InAttribute()> ByVal pvAspect As UInteger, _
   <OutAttribute()> ByVal pdwFreeze As UInteger)
  Sub Unfreeze( _
  <InAttribute()> ByVal dwFreeze As UInteger)
  Sub SetAdvise( _
    <InAttribute()> ByVal aspects As UInteger, _
    <InAttribute()> ByVal advf As UInteger, _
    <InAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal pAdvSink As IAdviseSink)
  Sub RemoteGetAdvise( _
   <OutAttribute()> ByVal pAspects As UInteger, _
   <OutAttribute()> ByVal pAdvf As UInteger, _
   <OutAttribute(), MarshalAs(UnmanagedType.Interface)> ByVal ppAdvSink As IAdviseSink)

End Interface