Сделать скриншот окна приложения - VB

Узнай цену своей работы

Формулировка задачи:

Добрый день! Как сделать, чтобы при нажатии на кнопку программа делала скриншот самой себя (сама форма не на весь экран), а затем сохраняла бы скрин в том месте, где укажет пользователь.

Решение задачи: «Сделать скриншот окна приложения»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Type PicBmp
  4.     size As Long
  5.     Type As Long
  6.     hBmp As Long
  7.     hpal As Long
  8.     Reserved As Long
  9. End Type
  10.  
  11. Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  12. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  13. 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
  14. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  15. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  16. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  17. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  18. Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  19.  
  20. Private Sub Form_Click()
  21.     Dim sDC As Long, dDC As Long, oBmp As Long, Bmp As Long, Pic As PicBmp, GUID(3) As Long, IPic As IPicture
  22.    
  23.     sDC = GetWindowDC(Me.hwnd)
  24.     dDC = CreateCompatibleDC(sDC)
  25.     Bmp = CreateCompatibleBitmap(sDC, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
  26.     oBmp = SelectObject(dDC, Bmp)
  27.    
  28.     BitBlt dDC, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, sDC, 0, 0, vbSrcCopy
  29.    
  30.     SelectObject dDC, oBmp
  31.     DeleteDC dDC
  32.     ReleaseDC Me.hwnd, sDC
  33.    
  34.     GUID(0) = &H7BF80980
  35.     GUID(1) = &H101ABF32
  36.     GUID(2) = &HAA00BB8B
  37.     GUID(3) = &HAB0C3000
  38.    
  39.     Pic.size = Len(Pic)
  40.     Pic.Type = vbPicTypeBitmap
  41.     Pic.hBmp = Bmp
  42.    
  43.     OleCreatePictureIndirect Pic, GUID(0), True, IPic
  44.    
  45.     If Not IPic Is Nothing Then
  46.         SavePicture IPic, App.Path & "\Test.BMP"
  47.     End If
  48. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.143 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы