Dump af kontrol på userform

Jeg er med på en lytter :-)
/fobian

Hvordan gør man i VB-net ?

Jeg fandt en løsning i VBA, men sjovt nok forsvinder en del funktionalitet efter koden er kørt. f.eks. virker alt+F11 ikke mere. weird

Option Explicit

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

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12


Private Sub UserForm_Activate()
    dim URL as string
    URL = "www.eksperten.dk"
    WebBrowser1.Navigate URL
   
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    timerRoutine
End Sub

Sub timerRoutine()
    Dim PauseTime, Start
   
    PauseTime = 0.8 ' Set duration.
    Start = Timer ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents ' Yield to other processes.
    Loop
   
    'Laver et dump af skærmen til et bitmap, og smider det på clipboard
    keybd_event VK_MENU, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
   
    PauseTime = 0.4 ' Set duration.
    Start = Timer ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents ' Yield to other processes.
    Loop
   
    Unload Me
End Sub

Her kommer lige koden fra VB.NET:


Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer. 
    'Do not modify it using the code editor.
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents AxWebBrowser1 As AxSHDocVw.AxWebBrowser
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
        Me.Button1 = New System.Windows.Forms.Button()
        Me.AxWebBrowser1 = New AxSHDocVw.AxWebBrowser()
        CType(Me.AxWebBrowser1, System.ComponentModel.ISupportInitialize).BeginInit()
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Location = New System.Drawing.Point(8, 8)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(48, 64)
        Me.Button1.TabIndex = 0
        Me.Button1.Text = "Button1"
        '
        'AxWebBrowser1
        '
        Me.AxWebBrowser1.Enabled = True
        Me.AxWebBrowser1.Location = New System.Drawing.Point(64, 32)
        Me.AxWebBrowser1.OcxState = CType(resources.GetObject("AxWebBrowser1.OcxState"), System.Windows.Forms.AxHost.State)
        Me.AxWebBrowser1.Size = New System.Drawing.Size(928, 600)
        Me.AxWebBrowser1.TabIndex = 1
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(1000, 645)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.AxWebBrowser1, Me.Button1})
        Me.Name = "Form1"
        Me.Text = "Form1"
        CType(Me.AxWebBrowser1, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        AxWebBrowser1.Navigate2("http://www.jp.dk")
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim bmp As Bitmap
        bmp = Hardcopy.CreateBitmap(AxWebBrowser1)
        bmp.Save("c:\test.bmp")

    End Sub

End Class

Public Class Win32

    Public Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
    Public Declare Function GetWindowDC Lib "user32" Alias "GetWindowDC" (ByVal hwnd As Integer) As Integer
    Public Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
    Public Const SRCCOPY As Integer = &HCC0020

End Class

Public Class Hardcopy

    Public Shared Function CreateBitmap(ByVal Control As Control) As Bitmap

        Dim gDest As Graphics
        Dim hdcDest As IntPtr
        Dim hdcSrc As Integer
        Dim hWnd As Integer = Control.Handle.ToInt32

        CreateBitmap = New Bitmap(Control.Width, Control.Height)
        gDest = gDest.FromImage(CreateBitmap)
        hdcSrc = Win32.GetWindowDC(hWnd)
        hdcDest = gDest.GetHdc

        Win32.BitBlt(hdcDest.ToInt32, 0, 0, Control.Width, Control.Height, hdcSrc, 0, 0, Win32.SRCCOPY)

        gDest.ReleaseHdc(hdcDest)
        Win32.ReleaseDC(hWnd, hdcSrc)

    End Function

End Class