怎么截当前活动窗体的屏慕截图

[tiantian1980]

作了个屏慕截图的ActionX控件，但只能当前打开的窗体，如果切换到其他窗体就不能截了。
下面是截当前窗体的代码：
Public Sub ScrnCap(Left As Long, Top As Long, Right As Long, Bottom As Long)
Shape1.Visible = False '不需要拷贝shape
LblPos.Visible = False
DoEvents
Dim rWidth As Long
Dim rHeight As Long
Dim SourceDC As Long
Dim DestDC As Long
Dim BHandle As Long
Dim Wnd As Long
Dim DHandle As Long
rWidth = Right - Left
rHeight = Bottom - Top
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Left, Top, &HCC0020
Wnd = GetDesktopWindow

OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard

DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub
请问大虾怎么做可也截其他活动窗体，并让这个控件是全屏呢。我猜想是SourceDC = CreateDC

("DISPLAY", 0, 0, 0)的问题，但怎么才能获得当前活动的窗体的呢？不甚感激！

[zzyong00]

'获得前台窗口的句柄。这里的“前台窗口”是指前台应用程序的活动窗口
Private Declare Function GetForegroundWindow Lib "user32" _
                () As Long
'获取指定窗口的设备场景
Private Declare Function GetDC Lib "user32" _
                (ByVal hwnd As Long) As Long
Public Sub ScrnCap(Left As Long, Top As Long, Right As Long, Bottom As Long) 
        Shape1.Visible = False                                   '不需要拷贝shape 
        LblPos.Visible = False 
        DoEvents 
        Dim rWidth     As Long 
        Dim rHeight     As Long 
        Dim SourceDC     As Long 
        Dim DestDC     As Long 
        Dim BHandle     As Long 
        Dim Wnd     As Long 
        Dim DHandle     As Long 
        rWidth = Right - Left 
        rHeight = Bottom - Top 
        SourceDC = CreateDC("DISPLAY", 0, 0, 0) '取得全屏幕
         SourceDC = GetDC(GetForegroundWindow()) '取得当前窗口
         DestDC = CreateCompatibleDC(SourceDC) 
        BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight) 
        SelectObject DestDC, BHandle 
        BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Left, Top, &HCC0020 
        Wnd = GetDesktopWindow 
         
        OpenClipboard Wnd 
        EmptyClipboard 
        SetClipboardData 2, BHandle 
        CloseClipboard 
         
        DeleteDC DestDC 
        ReleaseDC DHandle, SourceDC 
End Sub 

[zzyong00]

其它的API没声明

[cbm6666]

'添加 Command1 Picture1

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (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 CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 CloseClipboard Lib "user32" () As Long
Private Sub Form_Load()
Picture1.AutoSize = True
End Sub

Sub Command1_Click()
Me.Visible = False
ScrnCap 0, 0, Screen.Width \ 15, Screen.Height \ 15
Me.Visible = True
Picture1 = Clipboard.GetData()
SavePicture Picture1.Image, "c:\ddd.bmp"
End Sub

Public Sub ScrnCap(Lt&, Top&, Rt&, Bot&)
rWidth = Rt - Lt
rHeight = Bot - Top
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, Screen.Width \ 15, Screen.Height \ 15, SourceDC, Lt, Top, &HCC0020
'*************** 要抓其它窗口的画面只要 Wnd=该窗口的句柄即可
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub


'Public Sub ScrnCap 如果你要做ActiveX Dll 的话,你这个sub应该是要放在这个Dll里面的 .cls 类中再调用

如此,这个Sub将有所改变

Public Sub ScrnCap(TPicBox As Object,Lt&, Top&, Rt&, Bot&)

在代码中调用则改为 Call ScrnCap Picture1,0, 0, Screen.Width \ 15, Screen.Height \ 15

[tianhuo_soft]

用API截取全部屏幕

[cbm6666]

Private Declare Function GetDesktopWindow Lib "user32" () 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 Sub Form_Load()
Dim lDesktop&, hDC&
Me.AutoRedraw = True
Me.ScaleMode = 1
lDesktop = GetDesktopWindow() '取得桌面窗口 , 别的窗口在此改一下句柄即可,假设得到657342
hDC = GetDC(lDesktop) '取得桌面窗口的设备场景 hDC = GetDC(657342)
BitBlt Me.hDC, 0, 0, Screen.Width, Screen.Height, hDC, 0, 0, vbSrcCopy '将桌面图象绘制到窗体
End Sub

[射天狼]

你要设置全局的快捷键，按快捷键的时候，截取屏幕。
或者加一个定时器控件，启动之后，开始截取屏幕。

天狼工作室
http://www.j2soft.cn/

[tiantian1980]

认真看了各位的回贴，但
GetDesktopWindow() '取得桌面窗口 , 别的窗口在此改一下句柄即可,假设得到657342
这样怎么在ActiveX中还是获得不到其他窗口呢？不知为什么？

[leejunki820417]

请教一下，每次我运行的时候，sourceDC和DestDC的数值都很大，然后会报出溢出的错误，有人遇到过么？