主题:如何实现活动窗口抓图
Private Sub Command2_Click()
Dim hActiveWindow As Long
Dim RectActive As RECT
Dim hDC2 As Long
Form2.Picture = LoadPicture("")
Form2.Cls
Form1.Picture1.Cls
Form1.WindowState = 1
Form2.AutoRedraw = True
Form1.Picture1.AutoRedraw = True
DoEvents
hActiveWindow = GetForegroundWindow()
GetWindowRect hActiveWindow, RectActive
Form2.Cls
If Form2.WindowState = 2 Then
Form2.Hide
Else
Form2.Picture = LoadPicture("")
Form2.Width = (RectActive.Right - RectActive.Left) * Screen.TwipsPerPixelX + BorderWidth
Form2.Height = (RectActive.Bottom - RectActive.Top) * Screen.TwipsPerPixelY + BorderWidth
End If
hDC2 = GetWindowDC(hActiveWindow)
BitBlt Form2.hdc, 0, 0, Form2.Width, Form2.Height, hDC2, 0, 0, vbSrcCopy
ReleaseDC hActiveWindow, hDC2
Form2.Picture = Form2.Image
If Form2.Width = 0 Then
Dim fx As Integer
Dim fy As Integer
Dim hdc As Long
Form1.Picture1.Cls
Form2.Cls
Form1.WindowState = 1
DoEvents
Form1.Picture1.AutoRedraw = True
Form2.Width = Screen.Width
Form2.Height = Screen.Height
hdc = GetDC(0)
fx = Screen.Width / Screen.TwipsPerPixelX
fy = Screen.Height / Screen.TwipsPerPixelY
BitBlt Form2.hdc, 0, 0, fx, fy, hdc, 0, 0, vbSrcCopy
ReleaseDC 0, hdc
Form2.Picture = Form2.Image
Form1.Picture1.PaintPicture Form2.Picture, 80, 80, Form1.Picture1.Width - 200, Form1.Picture1.Height - 200, 0, 0, Form2.Width, Form2.Height
Form1.WindowState = 0
Else
Form1.Picture1.PaintPicture Form2.Picture, 80, 80, Form1.Picture1.Width - 200, Form1.Picture1.Height - 200, 0, 0, Form2.Width, Form2.Height
End If
Form1.Show
Form1.WindowState = 0
End Sub
为了简化编写,没用两个Picture控件,采用两个form,但在运行时,出现图像重叠,加doevents也无多大效果,这是怎么回事?怎么样才能消除?
Dim hActiveWindow As Long
Dim RectActive As RECT
Dim hDC2 As Long
Form2.Picture = LoadPicture("")
Form2.Cls
Form1.Picture1.Cls
Form1.WindowState = 1
Form2.AutoRedraw = True
Form1.Picture1.AutoRedraw = True
DoEvents
hActiveWindow = GetForegroundWindow()
GetWindowRect hActiveWindow, RectActive
Form2.Cls
If Form2.WindowState = 2 Then
Form2.Hide
Else
Form2.Picture = LoadPicture("")
Form2.Width = (RectActive.Right - RectActive.Left) * Screen.TwipsPerPixelX + BorderWidth
Form2.Height = (RectActive.Bottom - RectActive.Top) * Screen.TwipsPerPixelY + BorderWidth
End If
hDC2 = GetWindowDC(hActiveWindow)
BitBlt Form2.hdc, 0, 0, Form2.Width, Form2.Height, hDC2, 0, 0, vbSrcCopy
ReleaseDC hActiveWindow, hDC2
Form2.Picture = Form2.Image
If Form2.Width = 0 Then
Dim fx As Integer
Dim fy As Integer
Dim hdc As Long
Form1.Picture1.Cls
Form2.Cls
Form1.WindowState = 1
DoEvents
Form1.Picture1.AutoRedraw = True
Form2.Width = Screen.Width
Form2.Height = Screen.Height
hdc = GetDC(0)
fx = Screen.Width / Screen.TwipsPerPixelX
fy = Screen.Height / Screen.TwipsPerPixelY
BitBlt Form2.hdc, 0, 0, fx, fy, hdc, 0, 0, vbSrcCopy
ReleaseDC 0, hdc
Form2.Picture = Form2.Image
Form1.Picture1.PaintPicture Form2.Picture, 80, 80, Form1.Picture1.Width - 200, Form1.Picture1.Height - 200, 0, 0, Form2.Width, Form2.Height
Form1.WindowState = 0
Else
Form1.Picture1.PaintPicture Form2.Picture, 80, 80, Form1.Picture1.Width - 200, Form1.Picture1.Height - 200, 0, 0, Form2.Width, Form2.Height
End If
Form1.Show
Form1.WindowState = 0
End Sub
为了简化编写,没用两个Picture控件,采用两个form,但在运行时,出现图像重叠,加doevents也无多大效果,这是怎么回事?怎么样才能消除?