◆◇◆急救◆◇◆如何将屏幕的某块区域（部分在form上，部分在image上......）显示出来的图象复制到form的另一块上，而且可以按比例缩放？

[fengyang]

谢谢！◎

[fengyang]

没人

[MonkeyLin]

很麻烦的呀,要好多API
先获得桌面句柄(GetDesktop)
然后GetDC
然后bitblt（把屏幕上你要的那部分复制到PicBox or Form中）
....自己看着办吧

[MonkeyLin]

贴一段给你参考 ^-^






主　　题：关于VB下屏幕截图的问题（一个VB菜鸟的问题）
作　　者：Crops
所属论坛：Visual Basic
问题点数：20
回复次数：5
发表时间：2001-7-23 23:20:01


我在学WIN32 API时，教程说用GetDC取得屏幕设备源后，再用Bitble将屏幕绘制到窗口就可以做到屏幕截图，但没有源代码，我自己无法弄对，希望各位指教。(如可能请将源代码发至[e-mail])


回复贴子：
回复人：　xyjdn(项有建)　(2001-7-24 23:36:48) 得7分
Option Explicit

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
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long




'FORM

Sub SetPicture()
picCopy.Visible = True
If picCopy.Width <= Picture1.ScaleWidth Then
picCopy.Left = (Picture1.ScaleWidth - picCopy.Width) / 2
Else
picCopy.Left = 0
HScroll1.Min = 0
HScroll1.Value = 0
HScroll1.Max = picCopy.Width - Picture1.ScaleWidth
HScroll1.SmallChange = HScroll1.Max / 100
HScroll1.LargeChange = HScroll1.Max / 10
End If

If picCopy.Height <= Picture1.ScaleHeight Then
picCopy.Top = (Picture1.ScaleHeight - picCopy.Height) / 2
Else
picCopy.Top = 0
VScroll1.Min = 0
VScroll1.Value = 0
VScroll1.Max = picCopy.Height - Picture1.ScaleHeight
VScroll1.SmallChange = VScroll1.Max / 100
VScroll1.LargeChange = VScroll1.Max / 10
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
Picture1.Width = Me.ScaleWidth - VScroll1.Width
Picture1.Height = Me.ScaleHeight - HScroll1.Height
VScroll1.Left = Picture1.Width
HScroll1.Top = Picture1.Height
VScroll1.Height = Picture1.Height
HScroll1.Width = Picture1.Width

SetPicture
End Sub

Private Sub HScroll1_Change()
picCopy.Left = -HScroll1.Value
End Sub
Private Sub mCopyScreen_Click()
Dim hDC As Long, sx As Integer, sy As Integer

Me.Hide
DoEvents

picCopy.Width = Screen.Width
picCopy.Height = Screen.Height

picCopy.AutoRedraw = True

hDC = GetDC(0)
sx = Screen.Width \ Screen.TwipsPerPixelX
sy = Screen.Height \ Screen.TwipsPerPixelY
BitBlt picCopy.hDC, 0, 0, sx, sy, hDC, 0, 0, vbSrcCopy
ReleaseDC 0, hDC

picCopy.AutoRedraw = False

SetPicture
Me.Show
End Sub

Private Sub mSaveFile_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "存储文件"
.Filter = "位图文件(*.bmp)¦*.bmp"
.CancelError = True
.ShowOpen
If Err.Number <> cdlCancel Then
SavePicture picCopy.Picture, .FileName
End If
End With
End Sub

Private Sub VScroll1_Change()
picCopy.Top = -VScroll1.Value
End Sub




回复人：　wangfeng(VB比较会)　(2001-7-24 23:51:18) 得0分
http://www.csdn.net/expert/topic/207/207887.shtm
回复人：　suntingting(亭亭)　(2001-7-25 19:19:16) 得3分
dim sun as long
sun=getdc(0)
bitblt picture1.hdc,0,0,picture1.width,picture1.height,sun,0,0,vbsrccopy
即可，
picture1.AutoRedraw为true
回复人：　xxlroad(土八路)　(2001-7-25 20:46:10) 得3分
'回复人：TechnoFantasy(www.applevb.com)　(2001-6-16 21:37:00) 得0分
'to kimryo(kimryo)
'谁说VB数据类型单一，很不好用呢。截屏VB十分简单，看看下面的代码：
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 GetDC Lib "user32" (ByVal hwnd As Long) As Long

Const SRCCOPY = &HCC0020

Private Sub Form_Activate()
Me.Hide
For i = 1 To 10000 '延时
DoEvents
Next i
BitBlt Picture1.hDC, 0, 0, Screen.Width / 15, Screen.Height / 15, GetDC(0), 0, 0, SRCCOPY
SavePicture Picture1.Image, "sss.bmp"
End
End Sub

Private Sub Form_Load()
With Picture1
.AutoRedraw = True
.Width = Screen.Width
.Height = Screen.Height
End With
End Sub
回复人：　xxlroad(土八路)　(2001-7-25 20:46:59) 得7分
'把下面保存为 asdf.frm
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6495
ClientLeft = 60
ClientTop = 345
ClientWidth = 8235
LinkTopic = "Form1"
ScaleHeight = 6495
ScaleWidth = 8235
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture1
Height = 5085
Left = 240
ScaleHeight = 5025
ScaleWidth = 7950
TabIndex = 1
Top = 735
Width = 8010
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 4965
TabIndex = 0
Top = 30
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
'函数:
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, rWidth, rHeight, SourceDC, Lt, Top, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub
'以下的示例把屏幕图象捕捉后，放到Picture1 中。
Sub Command1_Click()
Form1.Visible = False
ScrnCap 0, 0, 640, 480
Form1.Visible = True
Picture1 = Clipboard.GetData()
End Sub

[MonkeyLin]

保存到PicBox后再调用PaintPicture事件截取你想要的那一部分并放大/缩小