关于图象的保存问题(VB 6.0)

Question

简单的通过SavePicture保存PictureBox中的图像是不行的，需要使用API以及接口
http://www.applevb.com/sourcecode/capture.zip
这个程序可以参考一下，是一个屏幕捕捉以及保存的程序
www.applevb.com

Answer 1

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7950
   LinkTopic       =   "Form1"
   ScaleHeight     =   7140
   ScaleWidth      =   7950
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   3015
      Left            =   1395
      ScaleHeight     =   2955
      ScaleWidth      =   2520
      TabIndex        =   0
      Top             =   1920
      Width           =   2580
      Begin VB.Shape Shape1 
         Height          =   1155
         Left            =   360
         Top             =   600
         Width           =   1485
      End
      Begin VB.Line Line1 
         X1              =   -765
         X2              =   1305
         Y1              =   765
         Y2              =   -210
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Click()
    ' 声明变量。
    Dim CX, CY, Limit, Radius   As Integer, Msg As String
    ScaleMode = vbPixels    ' 设置比例模型为像素。
    AutoRedraw = True ' 打开 AutoRedraw。
    Width = Height  ' 改变宽度以便和高度匹配。
    CX = ScaleWidth / 2 ' 设置 X 位置。
    CY = ScaleHeight / 2    ' 设置 Y 位置。
    Limit = CX  ' 圆的尺寸限制。
    For Radius = 0 To Limit ' 设置半径。
        Picture1.Circle (CX, CY), Radius, RGB(Rnd * 255, Rnd * 255, Rnd * 255)
        DoEvents    ' 转移到其它操作。
    Next Radius
    Msg = "Choose OK to save the graphics from this form "
    Msg = Msg & "to a bitmap file."
    MsgBox Msg
    SavePicture Picture1.Image, "TEST.BMP"   ' 将图片保存到文件。
End Sub
    

Answer 2

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