注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

BCB-DG's Blog

...

 
 
 

日志

 
 

ScreenCapture  

2007-08-03 23:35:36|  分类: VNC |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
Public Class ScreenCapture

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal
lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As
String, ByVal lpInitData As String) As Integer

Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As
Integer) As Integer

Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As
Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer

Private Declare Function GetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps"
(ByVal hdc As Integer, ByVal nIndex As Integer) As Integer

Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Integer,
ByVal hObject As Integer) As Integer

Private Declare Function BitBlt Lib "GDI32" (ByVal srchDC As Integer, ByVal
srcX As Integer, ByVal srcY As Integer, ByVal srcW As Integer, ByVal srcH As
Integer, ByVal desthDC As Integer, ByVal destX As Integer, ByVal destY As
Integer, ByVal op As Integer) As Integer

Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Integer) As
Integer

Private Declare Function DeleteObject Lib "GDI32" (ByVal hObj As Integer) As
Integer

Private Declare Function GetCursorInfo Lib "User32.dll" (ByRef pCI As
CursorInfo) As Long

Private Declare Function GetCursorPos Lib "User32.dll" (ByVal lpPoint As
PointAPI) As Long

Private Declare Function DrawIconEx Lib "User32.dll" (ByVal hDC As Long, _

ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, _

ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, _

ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Private Const SRCCOPY As Integer = &HCC0020

Private Const HORIZRES As Integer = 8

Private Const VERTRES As Integer = 10

Private Const CURSOR_SHOWING As Long = &H1

Private Const DI_NORMAL As Long = &H3

Private Structure PointAPI

Dim X As Long

Dim Y As Long

End Structure

Private Structure CursorInfo

Dim cbSize As Long

Dim flags As Long

Dim hCursor As Long

Dim ptScreenPos As PointAPI

End Structure

Private oBackground As System.Drawing.Bitmap

Public Sub CaptureScreen()

Dim hSDC, hMDC As Integer

Dim hBMP, hBMPOld As Integer

Dim CurInf As CursorInfo

Dim CurPos As PointAPI

Dim FW As Integer 'Width

Dim FH As Integer 'Height

Try

hSDC = CreateDC("DISPLAY", "", "", "")

hMDC = CreateCompatibleDC(hSDC)

FW = GetDeviceCaps(hSDC, HORIZRES)

FH = GetDeviceCaps(hSDC, VERTRES)

hBMP = CreateCompatibleBitmap(hSDC, FW, FH)

hBMPOld = SelectObject(hMDC, hBMP)

Call BitBlt(hMDC, 0, 0, FW, FH, hSDC, 0, 0, SRCCOPY)

Call DeleteDC(hSDC)

CurInf.cbSize = Len(CurInf)

Call GetCursorInfo(CurInf)

If (CurInf.flags And CURSOR_SHOWING) Then

Call GetCursorPos(CurPos)

Call DrawIconEx(hMDC, CurPos.X, CurPos.Y, _

CurInf.hCursor, 0, 0, 0, False, DI_NORMAL)

End If

Call SelectObject(hMDC, hBMPOld)

Call DeleteDC(hMDC)

oBackground = System.Drawing.Image.FromHbitmap(New IntPtr(hBMP))

DeleteObject(hBMP)

DeleteObject(hBMPOld)

'Seems to be a memory hole in fromHbitmap ....

'Code gets SLOW when not GC.Collect ing ... wierd.

GC.Collect()

Catch ex As Exception

Debug.WriteLine("General GDI ERROR: " & ex.Message.ToString)

End Try

End Sub

Public ReadOnly Property GetSizedScreen(ByVal s As System.Drawing.Size) As
System.Drawing.Bitmap

Get

Try

Return New System.Drawing.Bitmap(oBackground, s)

Catch ex As Exception

Debug.WriteLine("Error: ScreenCapture - GetSizedScreen")

End Try

End Get

End Property

End Class
  评论这张
 
阅读(958)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017