怎么在程序运行中把VB的窗体存成一张图片????

Question

Option Explicit
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 Const SRCCOPY = &HCC0020Private Sub Picture1_Click()
    'Picture1.AutoRedraw = True
    Rem Picture1.Picture = Me.PrintForm
    BitBlt Picture1.hDC, 0, 0, Me.ScaleWidth / Screen.TwipsPerPixelX, Me.ScaleHeight / Screen.TwipsPerPixelY, Me.hDC, 0, 0, SRCCOPY
End Sub另外，如果对你有帮助,请回复我的一个帖子：)
http://www.csdn.net/expert/topic/654/654811.xml?temp=.8152735
主题：  我自认VB水平不错，请大家给我估估价！

Answer 1

如果想要得到Picture对象,可以:Private Sub Picture1_Click()    Picture1.AutoRedraw = True
    Rem Picture1.Picture = Me.PrintForm
    Picture1.Visible = False
    BitBlt Picture1.hDC, 0, 0, Me.ScaleWidth / Screen.TwipsPerPixelX, Me.ScaleHeight / Screen.TwipsPerPixelY, Me.hDC, 0, 0, SRCCOPY
    Picture2.Picture = Picture1.Image
    
End Sub

Answer 2

谢谢dragoncity(自己发工资) 我就去看看

Answer 3

如果要得到Picture对象,可以:
Private Sub Picture1_Click()
    Picture1.AutoRedraw = True
    Rem Picture1.Picture = Me.PrintForm
    Picture1.Visible = False
    BitBlt Picture1.hDC, 0, 0, Me.ScaleWidth / Screen.TwipsPerPixelX, Me.ScaleHeight / Screen.TwipsPerPixelY, Me.hDC, 0, 0, SRCCOPY
    Picture2.Picture = Picture1.Image
    或者:
    dim MyPicture as Picture
    set MyPicture = Picture1.Image
    
End Sub

Answer 4

我不是要得到Picture1,而是整个窗体

Answer 5

上面代码有点问题
'本例使用 SavePicture 语句保存画在 Form 对象的 Picture 属性中的图形。
'要试用此例，可将以下代码粘贴到 Form 对象的声明部分，然后运行此例，单击 Form 对象。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 ' 设置半径。
        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 Image, "TEST.BMP"   ' 将图片保存到文件。
End Sub

Answer 6

谢谢!!我也不是想拷贝Form 对象的 Picture 属性中的图形,而是整个窗体现在我正在想用拷贝屏幕的方法

Answer 7

小Case.只要适当调整Form1.Picture1的大小,使其等于Form1的图片大小即可.
Private Sub Picture1_Click()
    Picture1.AutoRedraw = True
    Rem Picture1.Picture = Me.PrintForm
    Picture1.Visible = False
    Picture1.BorderStyle = 0
    Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
    BitBlt Picture1.hDC, 0, 0, Me.ScaleWidth / Screen.TwipsPerPixelX, Me.ScaleHeight / Screen.TwipsPerPixelY, Me.hDC, 0, 0, SRCCOPY
    Picture2.Picture = Picture1.Image
    
End Sub如果要测试,可以添加Form2(比Form1的尺寸大,以看出整个图片),以下是Form2的代码:
Private Sub Form_Click()
    Me.BackColor = vbRed
    Me.Picture = Form1.Picture1.Image
    
End Sub

Answer 8

我的窗体上没有Picture ,而是很多控件和计算出的图形

Answer 9

弄了半天,你是想要整个窗体的图形(包括标题栏/边框等),改成下面:Private Sub Command2_Click()
    Picture1.AutoRedraw = True
    Rem Picture1.Picture = Me.PrintForm
    Picture1.Visible = False
    Picture1.BorderStyle = 0
    Picture1.Move 0, 0, Me.Width, Me.Height
    Dim ScreenDC As Long
    ScreenDC = GetDC(0)
    
    BitBlt Picture1.hDC, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, ScreenDC, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, SRCCOPY
    Picture2.Picture = Picture1.Image
    
End Sub其中,应添加一个模块,模块中的代码如下:
Option ExplicitPublic 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
Public Const SRCCOPY = &HCC0020Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long解决了吧?

Answer 10

补充:你测试时,应Form2.Show,然后单击Form2,看见的是整个Form1的图形,包括边框/标题栏.
用SavePicture方法,可保存图片为图形文件.给分?

Answer 11

谢谢!!!明白你的意思了可是,我刚刚试了,BitBlt Picture1.hDC, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, ScreenDC, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, SRCCOPY
    
没有一点反应,夜蛾没有错误信息,,,,,为什么呢???

Answer 12

注意:AutoRedraw=True时,Visible应为False,二者正好相反.
给分?

Answer 13

使用Bitblt后
要加上refresh
picture1.Refresh

Answer 14

'保存窗体，刚刚测试通过'Option Explicit
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
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const SRCCOPY = &HCC0020Private Sub Picture1_Click()
    Picture1.AutoRedraw = True    Dim DeskHdc&, Ret&    ' Get Desktop DC
    DeskHdc = GetDC(0)
    
    Picture1.Width = Screen.Width
    Picture1.Height = Screen.Height
    BitBlt Picture1.hdc, 0, 0, Picture1.Width / Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY, DeskHdc, 0, 0, vbSrcCopy
    Ret = ReleaseDC(0&, DeskHdc)
    Picture1.Refresh
    
End Sub

Answer 15

对不起写错了，是保存屏幕到Pictrue控件中

Answer 16

几个api函数可以做到这样的效果，不过我忘了