Tipp-Upload: VB.NET 0351: Bilder von Webseiten anfertigen
von Samael
Ü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.
Beschreibung
Ermöglicht das Anfertigen von Bildern einer Webseite.
Schwierigkeitsgrad |
Verwendete API-Aufrufe: |
Download: |
' 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.