Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB.NET 0351: Bilder von Webseiten anfertigen

 von 

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Grafik
  • Internet und Netzwerke
  • Steuerelemente

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Webseite, Vorschaubilder, WebBrowser, Screenshot, Thumbnail

Der Vorschlag wurde erstellt am: 21.02.2009 21:32.
Die letzte Aktualisierung erfolgte am 03.03.2009 04:57.

Zurück zur Übersicht

Beschreibung  

Ermöglicht das Anfertigen von Bildern einer Webseite.

Schwierigkeitsgrad

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

Download:

Download des Beispielprojektes [25,13 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ---------- Anfang Projektgruppe WebsiteImages.sln ----------
' --------- Anfang Projektdatei WebsiteImages.vbproj ---------
' ------------------ Anfang Datei Form1.vb  ------------------
Public Class Form1

    ' Klassenobject erzeugen.
    Private WithEvents _wP As New WebsitePicture()

    ' Zum Prüfen, ob schon fertig geladen ist. Wegen den NumericUpDowns.
    Private _loadingFlag As Boolean = True

    Private Sub btnGetImage_Click(ByVal sender As Object, ByVal e As EventArgs) Handles _
        btnGetImage.Click

        ' Wartebild anzeigen.
        Me.pBxPicture.Image = My.Resources.warten

        Me.Text = "WebsitePicture - working"

        ' uriString festlegen.
        _wP.uriString = txtAdress.Text

        ' Fullimage anfordern.
        _wP.GetFullImage()

    End Sub

    Private Sub btnSave_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnSave.Click

        ' Angezeigtes Bild speichern.
        If sFD.ShowDialog = Windows.Forms.DialogResult.OK Then
            Me.pBxPicture.Image.Save(sFD.FileName)

            Me.lLlPath.Text = sFD.FileName
            Me.lLlPath.Visible = True
        End If

    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load

        txtAdress.Text = "http://www.activevb.de"

        Me.nUDWidth.Value = _wP.imageSize.Width
        Me.nUDHeight.Value = _wP.imageSize.Height

        _loadingFlag = False

    End Sub

    Private Sub lLlPath_LinkClicked(ByVal sender As Object, ByVal e As _
        LinkLabelLinkClickedEventArgs) Handles lLlPath.LinkClicked

        ' Pfad zu Bild öffnen.
        If System.IO.File.Exists(Me.lLlPath.Text) Then
            Process.Start(Me.lLlPath.Text)

        Else

            MessageBox.Show("Die gewünschte Datei ist nicht vorhanden!", "Fehler", _
                MessageBoxButtons.OK, MessageBoxIcon.Error)

        End If

    End Sub

    Private Sub nUDWidth_ValueChanged(ByVal sender As Object, ByVal e As EventArgs) Handles _
        nUDWidth.ValueChanged, nUDHeight.ValueChanged

        If Not _loadingFlag Then
            _wP.imageSize = New Size(CInt(Me.nUDWidth.Value), CInt(Me.nUDHeight.Value))
        End If

    End Sub

    ''' <summary>
    ''' Event abfangen.
    ''' </summary>
    Private Sub _wP_ImageReady(ByVal sender As Object, ByVal e As WebsitePictureEventArgs) _
        Handles _wP.ImageReady

        Me.pBxPicture.Image = e.Bmp

        Me.Text = "WebsitePicture - ready"

        Me.Label2.Text = "Dauer: " & e.Duration.TotalSeconds.ToString().Substring(0, 4) & " s"

        Me.btnSave.Enabled = True

    End Sub

    ''' <summary>
    ''' Abfangen, wenn sich der Ladestatus ändert.
    ''' </summary>
    Private Sub _wP_ProgressChanged(ByVal sender As Object, ByVal e As _
        WebsitePicutureProgressEventArgs) Handles _wP.ProgressChanged

        Me.Label2.Text = "Dauer: " & e.Elapsed.TotalSeconds.ToString().Substring(0, 4) & " s"

    End Sub

    ''' <summary>
    ''' Auf Entertaste reagieren.
    ''' </summary>
    Private Sub txtAdress_KeyDown(ByVal sender As System.Object, ByVal e As _
        System.Windows.Forms.KeyEventArgs) Handles txtAdress.KeyDown

        If e.KeyCode = Keys.Enter Then
            btnGetImage.PerformClick()
        End If

    End Sub

End Class

' ------------------- Ende Datei Form1.vb  -------------------
' -------------- Anfang Datei WebsitePicture.vb --------------
Imports System.Drawing
Imports System.Windows.Forms

Public Class WebsitePicture

    Private _uriString As String

    ''' <summary>
    ''' Legt die Adresse der Seite fest.
    ''' </summary>
    Public Property uriString() As String
        Get
            Return _uriString

        End Get

        Set(ByVal value As String)
            _uriString = value

            If Not value.StartsWith("http://") Then
                _uriString = "http://" & value

            Else

                _uriString = value
            End If

        End Set

    End Property

    ''' <summary>
    ''' Die uriString im Uri-Format.
    ''' </summary>
    Public ReadOnly Property uri() As Uri
        Get
            Return New Uri(Me.uriString)

        End Get

    End Property

    Private _imageSize As Size

    ''' <summary>
    ''' Legt die Grösse des Bildes fest.
    ''' </summary>
    Public Property imageSize() As Size
        Get
            Return _imageSize

        End Get

        Set(ByVal value As Size)
            _imageSize = value

            ' Browser vergrössern.
            _wB.Size = value

        End Set

    End Property

    ' Neues WebBrowser-Control.
    Private WithEvents _wB As New WebBrowser

    ' Die Stopuhr.
    Private _sW As New Stopwatch

    ' Variable zum Speichern vom Status.
    Private _status As Status

    ' Das Bitmap.
    Private _b As Bitmap

    ' Die Events :-) Danke Spatzenkanonier!
    Public Event ImageReady As EventHandler(Of WebsitePictureEventArgs)
    Public Event ProgressChanged As EventHandler(Of WebsitePicutureProgressEventArgs)

    ''' <summary>
    ''' Status festlegen.
    ''' </summary>
    Private Enum Status
        Active = 0
        Idle = 1
    End Enum

    ''' <summary>
    ''' Konstruktor mit Defaultwerten. uriString = "", imageSize = 1024*768.
    ''' </summary>
    Public Sub New()

        Me.New("", New Size(1024, 768))

    End Sub

    ''' <summary>
    ''' Konstruktor mit URL. imageSize = 1024*768.
    ''' </summary>
    Public Sub New(ByVal url As String)

        Me.New(url, New Size(1024, 768))

    End Sub

    ''' <summary>
    ''' Konstruktor mit URL und definierter imageSize.
    ''' </summary>
    Public Sub New(ByVal url As String, ByVal previewSize As Size)

        Me.uriString = url
        Me.imageSize = previewSize

        _wB.ScriptErrorsSuppressed = True
        _wB.ScrollBarsEnabled = False
        _wB.Size = previewSize

    End Sub

    ''' <summary>
    ''' Löst das Event FullImageCreated aus.
    ''' </summary>
    Public Sub GetFullImage()

        ' Aktivieren.
        _status = Status.Active

        ' Stopuhr zurücksetzen und neu starten.
        _sW.Reset()
        _sW.Start()

        ' Navigation wieder erlauben.
        _wB.AllowNavigation = True

        ' WebBrowser laden lassen.
        _wB.Navigate(Me.uri)

    End Sub

    ''' <summary>
    ''' Wird ausgelöst, wenn die Webseite fertig geladen ist.
    ''' </summary>
    Private Sub _wB_DocumentCompleted(ByVal sender As Object, ByVal e As _
        WebBrowserDocumentCompletedEventArgs) Handles _wB.DocumentCompleted

        ' Wenn idle, nix machen.
        If _status = Status.Idle Then Exit Sub

        ' Stopuhr anhalten.
        _sW.Stop()

        ' Browser anhalten.
        _wB.Stop()

        ' Automatische Weiterleitungen verhindern.
        _wB.AllowNavigation = False

        ' Das _wB-Control zu Control casten, da _wB kein DrawToBitmap besitzt.
        Dim tempCtrl As Control = CType(_wB, Control)

        ' Bitmap erzeugen.
        _b = New Bitmap(Me.imageSize.Width, Me.imageSize.Height)

        ' Das _wB-Control in das Bitmap zeichnen.
        tempCtrl.DrawToBitmap(_b, New Rectangle(0, 0, _b.Width, _b.Height))

        ' Event auslösen.
        OnImageReady(New WebsitePictureEventArgs(_b, _sW.Elapsed))

        _b = Nothing
        tempCtrl = Nothing

        ' Benötigt, um nicht unbeabsichtigt ein Event auszulösen.
        _status = Status.Idle

    End Sub

    ''' <summary>
    ''' Erzeugt das Event.
    ''' </summary>
    Protected Overridable Sub OnImageReady(ByVal e As WebsitePictureEventArgs)

        RaiseEvent ImageReady(Me, e)

    End Sub

    ''' <summary>
    ''' Erzeugt das Changed-Event.
    ''' </summary>
    Protected Overridable Sub OnProgressChanged(ByVal e As WebsitePicutureProgressEventArgs)

        RaiseEvent ProgressChanged(Me, e)

    End Sub

    Private Sub _wB_ProgressChanged(ByVal sender As Object, ByVal e As _
        System.Windows.Forms.WebBrowserProgressChangedEventArgs) Handles _wB.ProgressChanged

        OnProgressChanged(New WebsitePicutureProgressEventArgs(_sW.Elapsed))

    End Sub

End Class

' --------------- Ende Datei WebsitePicture.vb ---------------
' --------- Anfang Datei WebsitePictureEventArgs.vb  ---------
Public Class WebsitePictureEventArgs

    Inherits EventArgs

    Public ReadOnly Bmp As Bitmap
    Public ReadOnly Duration As TimeSpan

    Public Sub New(ByVal b As Bitmap, ByVal duration As TimeSpan)

        Me.Bmp = b
        Me.Duration = duration

    End Sub

End Class

' ---------- Ende Datei WebsitePictureEventArgs.vb  ----------
' ----- Anfang Datei WebsitePicutureProgressEventArgs.vb -----
Public Class WebsitePicutureProgressEventArgs

    Inherits EventArgs

    Public ReadOnly Elapsed As TimeSpan

    Public Sub New(ByVal elapsed As TimeSpan)

        Me.elapsed = elapsed

    End Sub

End Class

' ------ Ende Datei WebsitePicutureProgressEventArgs.vb ------
' ---------- Ende Projektdatei WebsiteImages.vbproj ----------
' ----------- Ende Projektgruppe WebsiteImages.sln -----------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.