Private Declare Function icePub_saveScreen Lib "icePubDll.dll" (ByVal bmpFile As String) As Integer

Dim str1 As String
Dim a2 As Integer

str1 = App.Path + "\1.bmp"
a2 = icePub_saveScreen(str1)

Private Declare Function icePub_saveScreenJpg Lib "icePubDll.dll" (ByVal jpgFile As String) As Integer

Dim str1 As String
Dim a2 As Integer

str1 = App.Path + "\1.jpg"
a2 = icePub_saveScreenJpg(str1)

Private Declare Function icePub_saveSubScreen Lib "icePubDll.dll" (ByVal bmpFile As String, ByVal startX As Integer,ByVal startY As Integer,ByVal endX As Integer,ByVal endY As Integer) As Integer

Dim str1 As String
Dim a2 As Integer

str1 = App.Path + "\1.bmp"
a2 = icePub_saveSubScreen(str1,0,0,100,60)

Private Declare Function icePub_saveSubScreenJpg Lib "icePubDll.dll" (ByVal jpgFile As String, ByVal startX As Integer,ByVal startY As Integer,ByVal endX As Integer,ByVal endY As Integer) As Integer

Dim str1 As String
Dim a2 As Integer

str1 = App.Path + "\1.jpg"
a2 = icePub_saveScreenJpg(str1,0,0,100,60)

download:
http://dl.icese.net/dev.php?f=icePubDll.rar
复制代码

Usage:PrtScr x y width height [drive:][path]filename
例:PrtScr 0 0 200 200 save.bmp (截取左上角200*200的区域保存为save.bmp)
x y从屏幕左上角算起
复制代码

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ##
Private Type PointAPI
  X As Long
  Y As Long
End Type
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor 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 GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitmapInfo, ByVal wUsage As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As PointAPI) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs
Private Type RGBQUAD
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End Type
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
  biXPelsPerMeter As Long
  biYPelsPerMeter As Long
  biClrUsed As Long
  biClrImportant As Long
End Type
Private Type BitmapInfo
  bmiHeader As BitmapInfoHeader
  bmiColors As RGBQUAD
End Type
Private Type BitmapFileHeader
  bfType As Integer
  bfSize As Long
  bfReserved1 As Integer
  bfReserved2 As Integer
  bfOffBits As Long
End Type
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ##
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal l As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_ALWAYS = 2
Private Const GENERIC_WRITE = &H40000000
'Download by http://www.codefans.net
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ##
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_SHOWWINDOW = &H40
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As PointAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As PointAPI, ByVal nCount As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Private Const PS_DOT = 2                     '  .......
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' ########### ########### ########### ########### ########### ########### ########### ###########
' ########### ########### ########### ########### ########### ########### ########### ###########
' ########### ########### ########### ########### ########### ########### ########### ###########

Private Sub GetScreenResolution(ByRef nWidth As Integer, ByRef nHeight As Integer)
  Dim a(1 To 61) As Integer
  EnumDisplaySettings 0, -1, a(1)
  'a(53) Deep / a(55) Width / a(57) Height / a(61) Refresh frequency
  nWidth = a(55)
  nHeight = a(57)
End Sub

Sub Main()
  TestSaveScreen
  MsgBox "Done"
  End
End Sub

Sub TestSaveScreen()
  Dim beginPoint As PointAPI
  Dim endPoint As PointAPI
  Dim X As Long, Y As Long
  Y = GetSystemMetrics(SM_CYSCREEN)
  X = GetSystemMetrics(SM_CXSCREEN)
  beginPoint.X = 0
  beginPoint.Y = 0
  endPoint.X = X
  endPoint.Y = Y
  Screen2Bmp "c:\1.bmp", beginPoint, endPoint
End Sub

Function Screen2Bmp(ByVal bmpFile As String, ByRef beginPoint As PointAPI, ByRef endPoint As PointAPI)

  Dim X&, Y&, nSrcDC&, nSrcBmp&, nMemDC&
  'Init Screen DC
  nSrcDC = GetDC(0)
  
  'Create a bitmap object on the screen
  X = GetSystemMetrics(SM_CXSCREEN)
  Y = GetSystemMetrics(SM_CYSCREEN)
  nSrcBmp = CreateCompatibleBitmap(nSrcDC, X, Y)
  nMemDC = CreateCompatibleDC(nSrcDC)    'Create a memory DC on the screen
  
  'Move the screen content to the memory DC
  SelectObject nMemDC, nSrcBmp
  BitBlt nMemDC, 0, 0, X, Y, nSrcDC, 0, 0, SRCCOPY
  DeleteObject nSrcBmp
  
  'Correct starting coordinates
  Dim nTmpDC&, nTmpBmp&, k&, g&, tmpInt%
  If endPoint.X < beginPoint.X Then
    tmpInt = endPoint.X
    endPoint.X = beginPoint.X
    beginPoint.X = tmpInt
  End If
  If endPoint.Y < beginPoint.Y Then
    tmpInt = endPoint.Y
    endPoint.Y = beginPoint.Y
    beginPoint.Y = tmpInt
  End If
  
  k = endPoint.X - beginPoint.X
  g = endPoint.Y - beginPoint.Y
  
  nTmpDC = CreateCompatibleDC(nSrcDC)
  nTmpBmp = CreateCompatibleBitmap(nSrcDC, k, g)
  SelectObject nTmpDC, nTmpBmp
  
  BitBlt nTmpDC, 0, 0, k, g, nMemDC, beginPoint.X, beginPoint.Y, SRCCOPY
  DeleteDC nMemDC
  
  Dim bih As BitmapInfoHeader
  With bih
    .biBitCount = 32
    .biClrImportant = 0
    .biClrUsed = 0
    .biCompression = 0
    .biHeight = g
    .biPlanes = 1
    .biSize = 40
    .biSizeImage = k * g * 4
    .biWidth = k
    .biXPelsPerMeter = 0
    .biYPelsPerMeter = 0
  End With
  
  Dim bfh As BitmapFileHeader
  With bfh
    .bfOffBits = 14 + bih.biSize
    .bfReserved1 = 0
    .bfReserved2 = 0
    .bfSize = .bfOffBits + bih.biSizeImage
    .bfType = 19778 'BM
  End With
  
  Dim sa As SECURITY_ATTRIBUTES
  With sa
    .bInheritHandle = 0
    .lpSecurityDescriptor = 0
    .nLength = 0
  End With
  
  If k > 0 And g > 0 Then
    ReDim bits(4, 0 To k - 1, 0 To g - 1)
  Else
    ReDim bits(4, 0, 0)
  End If
  
  Dim bitinfo As BitmapInfo
  With bitinfo.bmiHeader
    .biBitCount = 32
    .biCompression = 0
    .biHeight = g
    .biPlanes = 1
    .biSize = Len(bitinfo.bmiHeader)
    .biWidth = k
  End With
  
  GetDIBits nTmpDC, nTmpBmp, 0&, g, bits(0, 0, 0), bitinfo, DIB_RGB_COLORS
  DeleteObject nTmpBmp
  DeleteDC nTmpDC
  
  Dim fh As Long
  Dim Writtennum As Long
  fh = CreateFile(bmpFile, GENERIC_WRITE, 0, sa, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL + FILE_FLAG_SEQUENTIAL_SCAN, 0)
  Writtennum = 0
  WriteFile fh, bfh.bfType, 2, Writtennum, 0
  WriteFile fh, bfh.bfSize, 12, Writtennum, 0
  WriteFile fh, bih, bih.biSize, Writtennum, 0
  WriteFile fh, bits(0, 0, 0), bih.biSizeImage, Writtennum, 0
  
  'Debug.Print WriteFile(fh, bfh, Len(BITMAPFILEHEADER), 0, 0)
  'Debug.Print WriteFile(fh, bih, Len(BITMAPINFOHEADER), Len(BITMAPFILEHEADER), 0)
  'Debug.Print WriteFile(fh, nTmpBmp, k * g * 3, Len(BITMAPFILEHEADER) + Len(BITMAPINFOHEADER), 0)
  
  CloseHandle fh

End Function
复制代码

例:ToPng C:\a.bmp jpg
复制代码

D:\downloads\nircmd\nircmd.exe savescreenshot "d:\1.png"
复制代码

D:\downloads\nircmd\nircmd.exe savescreenshot "d:\2.png" 50 50 300 200
复制代码