Screen Capture med ActiveX

Ta en skärmdump med standared exe och skala der den till en viss storlek och spara den på bestämd plats funkar ju bra. Men hur gör man om man vill köra allt i bakgrunden. Ex. med en activeX komponent?

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 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 Sub Command1_Click()
Dim x As Integer, y As Integer, nWidth As Integer, nHeight As Integer
  Dim dwRop As Long, hSrcDC As Long, hDestDC As Long
  Dim strFName As String

    Dim strTime As String
    strTime = Replace(Now, ":","")
    Picture1.Width = Screen.Width
    Picture1.Height = Screen.Height
    
    strFName = "Pic_" & strTime & ".jpg"
    Let nHeight = Screen.Height
    Let nWidth = Screen.Width
    Let dwRop = vbSrcCopy
    Let hDestDC = Picture1.hDc
    Let hSrcDC = GetDC(0)
    Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, hSrcDC, 0, 0, dwRop)
    Call ReleaseDC(0, hSrcDC)
    
    Picture2.PaintPicture Picture1.Image, 0, 0, 2000, 1000

    SavePicture Picture2.Image, App.Path & "\" & strFName
End Sub

Efter ditt anrop till BitBlt får du köra Picture1.Refresh. Vet inte om det behövs för Picture2 också efter att du har kört PaintPicture men jag tror inte det.

Detta bör iaf fungera. Jag använder aldrig PictureBoxar så jag är inte helt säker. Jag föredrar API. :)

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 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 Sub Command1_Click()
Dim x As Integer, y As Integer, nWidth As Integer, nHeight As Integer
  Dim dwRop As Long, hSrcDC As Long, hDestDC As Long
  Dim strFName As String

    Dim strTime As String
    strTime = Replace(Now, ":","")
    Picture1.Width = Screen.Width
    Picture1.Height = Screen.Height
    
    strFName = "Pic_" & strTime & ".jpg"
    Let nHeight = Screen.Height
    Let nWidth = Screen.Width
    Let dwRop = vbSrcCopy
    Let hDestDC = Picture1.hDc
    Let hSrcDC = GetDC(0)
    Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, hSrcDC, 0, 0, dwRop)
    Call ReleaseDC(0, hSrcDC)
    
    Picture1.Refresh
    Picture2.PaintPicture Picture1.Image, 0, 0, 2000, 1000

    SavePicture Picture2.Image, App.Path & "\" & strFName
End Sub

Ok, men min tanke var att så småningom skapa en aspkomponent för att ta screen shots då skall man väl inte använda standard exe utan activex eller något sådant?