Screen shot via Win API or something else 
Author Message
 Screen shot via Win API or something else

Hi,
I'm trying to write code that takes a screen shot and
dumps it into a Word document.
Could anyone help me in the right direction?
If possible I would like to create a function that
returns a bitmap picture or perhaps puts the picture in
the clipboard.

Grateful for any tip!
Kristian



Tue, 27 Dec 2005 21:25:09 GMT  
 Screen shot via Win API or something else

Quote:
> I'm trying to write code that takes a screen shot and
> dumps it into a Word document.
> Could anyone help me in the right direction?
> If possible I would like to create a function that
> returns a bitmap picture or perhaps puts the picture in
> the clipboard.

'***
Private Declare Function GetSystemMetrics Lib "user32" _
    (ByVal nIndex As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" _
    (ByVal hDC As Long, ByRef pBitmapInfo As BitmapInfoHeader, _
    ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, _
    ByVal dw As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, _
    ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
    ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
    ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
    ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
    (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
    (ByVal hObject As Long, ByVal nCount As Long, _
    ByRef lpObject As Any) As Long

Private Type BitmapInfoHeader ' 40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPel{*filter*}eter As Long
    biYPel{*filter*}eter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type Bitmap ' 24 bytes
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Const DIB_RGB_COLORS As Long = 0 ' Color table in RGBs
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const SM_XVIRTUALSCREEN As Long = 76
Private Const SM_YVIRTUALSCREEN As Long = 77
Private Const SM_CXVIRTUALSCREEN As Long = 78
Private Const SM_CYVIRTUALSCREEN As Long = 79
Private Const SM_CMONITORS As Long = 80

Private Function ScreenShot() As Long ' HBITMAP
    Dim bmi As BitmapInfoHeader
    Dim Created As Boolean
    Dim XFrom As Long, YFrom As Long
    Dim SnapShot As Long, OldBMP As Long ' HBITMAP
    Dim ShotDC As Long, WndDC As Long ' HDC

    ' Initialise header
    bmi.biBitCount = 32
    bmi.biPlanes = 1
    bmi.biSize = Len(bmi)

    If (GetSystemMetrics(SM_CMONITORS) > 1) Then ' Multi-monitor
        bmi.biWidth = GetSystemMetrics(SM_CXVIRTUALSCREEN)
        bmi.biHeight = GetSystemMetrics(SM_CYVIRTUALSCREEN)
        XFrom = GetSystemMetrics(SM_XVIRTUALSCREEN)
        YFrom = GetSystemMetrics(SM_YVIRTUALSCREEN)
    Else ' Single monitor
        bmi.biWidth = GetSystemMetrics(SM_CXSCREEN)
        bmi.biHeight = GetSystemMetrics(SM_CYSCREEN)
    End If

    ' Create a DIB for the screenshot
    SnapShot = CreateDIBSection(0, bmi, DIB_RGB_COLORS, 0, 0, 0)

    If (SnapShot) Then ' Create a DC
        ShotDC = CreateCompatibleDC(0)

        If (ShotDC) Then ' Select DIB into DC
            OldBMP = SelectObject(ShotDC, SnapShot)

            If (OldBMP) Then ' Capture screen
                WndDC = GetDC(0)
                Created = BitBlt(ShotDC, 0, 0, bmi.biWidth, _
                    bmi.biHeight, WndDC, XFrom, YFrom, vbSrcCopy) <> 0
                Call ReleaseDC(0, WndDC)

                ' Deselect DIB
                Call SelectObject(ShotDC, OldBMP)
            End If

            ' Delete DC
            Call DeleteDC(ShotDC)
        End If

        ' Clean up DIB if something failed
        If (Not Created) Then Call DeleteObject(SnapShot)
    End If

    ' Return either the DIB handle, or null if it failed
    ScreenShot = IIf(Created, SnapShot, 0&)
End Function
'***

You can use it as follows:

'***
Dim ScreenDIB As Long ' HBITMAP
Dim bm As Bitmap
Dim DrawDC As Long ' HDC
Dim OldBMP As Long ' HBITMAP

ScreenDIB = ScreenShot()

If (ScreenDIB) Then
    Call GetObject(ScreenDIB, Len(bm), bm)
    DrawDC = CreateCompatibleDC(0)
    OldBMP = SelectObject(DrawDC, ScreenDIB)
    If (OldBMP) Then Call BitBlt(hDC, 0, 0, bm.bmWidth, _
        bm.bmHeight, DrawDC, 0, 0, vbSrcCopy)
    Call SelectObject(DrawDC, OldBMP)
    Call DeleteObject(ScreenDIB)
    Call DeleteDC(DrawDC)
End If
'***

Assuming hDC is the handle to the DC you're drawing to.
Hope this helps,

    Mike

 - Microsoft Visual Basic MVP -

WWW: http://www.*-*-*.com/



Tue, 27 Dec 2005 21:37:51 GMT  
 Screen shot via Win API or something else

Quote:
> Hi,
> I'm trying to write code that takes a screen shot and
> dumps it into a Word document.
> Could anyone help me in the right direction?
> If possible I would like to create a function that
> returns a bitmap picture or perhaps puts the picture in
> the clipboard.

You might want to add this SnapShot form to your bag o' tricks.
It will return an image of the desktop, return a thumbnail of the image
or send it to the clipboard.

Usage:  (Form1)

Private Sub Command1_Click()
  Set Me.Picture = SnapShot.GetPicture
End Sub

Private Sub Command2_Click()
  SnapShot.SendToClipboard
End Sub

Private Sub Command3_Click()
  Set Me.Picture = SnapShot.GetThumbnail(.25)
End Sub

'[  SnapShot  form  ]

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 Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal
nHeight As Long, _
                         ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal
nHeight As Long, _
                         ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight
As Long, ByVal dwRop As Long) As Long

Private Sub Form_Initialize()
  ' Set these in the IDE

  ' Name = "Snapshot"
  ' BorderStyle = 0
  AutoRedraw = True
  ScaleMode = vbPixels
End Sub

Public Function GetPicture() As StdPicture
Dim dc As Long
  Move 0, 0, Screen.Width, Screen.Height
  Set Me.Picture = Nothing
  dc = GetDC(0)
  BitBlt hdc, 0, 0, ScaleWidth, ScaleHeight, dc, 0, 0, vbSrcCopy
  ReleaseDC Me.hwnd, dc
  Set GetPicture = Me.Image
  Unload Me
End Function

Public Function GetThumbnail(Optional Size As Double = 0.1) As StdPicture
Dim dc As Long, wid As Long, hgt As Long

  If Size <= 0 Then Size = 1
  Move 0, 0, Screen.Width, Screen.Height

  If Size <= 1 Then
    ' Scale down by size factor
    wid = ScaleWidth * Size
    hgt = ScaleHeight * Size
  Else
    ' Fit to width size (in Pixels)
    wid = Size
    hgt = ScaleHeight * (wid / ScaleWidth)
  End If

  Move 0, 0, wid * Screen.TwipsPerPixelX, hgt * Screen.TwipsPerPixelY
  Set Me.Picture = Nothing
  dc = GetDC(0)
  StretchBlt hdc, 0, 0, wid, hgt, dc, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY, vbSrcCopy
  ReleaseDC Me.hwnd, dc
  Set GetThumbnail = Me.Image
  Unload Me
End Function

Public Sub SendToClipboard()
  Clipboard.Clear
  Clipboard.SetData GetPicture
End Sub



Wed, 28 Dec 2005 01:59:33 GMT  
 
 [ 3 post ] 

 Relevant Pages 

1. WIN 2k API vs WIN 98/WIN NT API - Help needed

2. Getting the Current (working) Directory via Win API

3. PROBLEM: Adding a printer via API, then creating a printer Share via API (source included)

4. Standby via Win API

5. Copying Excel screen shot to Word

6. Screen shot help

7. Screen Shot?

8. generating a mail message with screen shot of emulation

9. Screen Shot?

10. Getting a screen shot in VB?

11. Screen Shot

12. Screen Shot

 

 
Powered by phpBB® Forum Software