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

Question

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

Answer 1

贴一段给你参考 ^-^
主　　题：关于VB下屏幕截图的问题（一个VB菜鸟的问题）
作　　者：Crops
所属论坛：Visual Basic
问题点数：20
回复次数：5
发表时间：2001-7-23 23:20:01
 
  
  我在学WIN32 API时，教程说用GetDC取得屏幕设备源后，再用Bitble将屏幕绘制到窗口就可以做到屏幕截图，但没有源代码，我自己无法弄对，希望各位指教。(如可能请将源代码发至[email protected]) 
回复贴子： 
回复人：　xyjdn(项有建)　(2001-7-24 23:36:48)  得7分 
Option ExplicitDeclare 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
'FORMSub 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 SubPrivate 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 SubPrivate 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 SubPrivate Sub mSaveFile_Click()
  On Error Resume Next
  With CommonDialog1
      .DialogTitle = "存储文件"
      .Filter = "位图文件(*.bmp)&brvbar;*.bmp"
      .CancelError = True
      .ShowOpen
      If Err.Number <> cdlCancel Then
        SavePicture picCopy.Picture, .FileName
      End If
  End With
End SubPrivate 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 LongConst SRCCOPY = &HCC0020Private 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 SubPrivate 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
 

Answer 2

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