Question

vb 将下图窗体中所有的内容打印出来，包括输入的text框以及picturebox中的曲线

如上图中的窗体，想把上窗体中的所有内容通过打印机打印到a4纸上，目前通过form1.printform打印的时候，窗体中大部分内容能打印，但是picturebox中绘制的曲线图以及曲线图的坐标均不能打印显示，是空的。如果使用printer.的方法，能打印曲线，但是text框又不行。如何能通过截图的方式，把窗体截下来，打印或者有更好的代码，求解》？？？？？

Answer 1

'截悄仔图当前窗体
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'截图当前窗体
Private Type POINTAPI
X As Long
Y As Long
End Type
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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function ReleaseDC Lib "user32"乎运锋 (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Sub Command1_Click()
Dim hdc As Long
Dim sw As Integer
Dim sh As Integer
Dim CurPos As POINTAPI
Dim Cur As Long
On Error Resume Next
DoEvents
Picture1.AutoRedraw = True
hdc = GetDC(0)
GetCursorPos CurPos
Cur = GetCursor
Picture1.Top = 0
Picture1.Left = 0
Picture1.Width = Me.Width
Picture1.Height = Me.Height - 任务栏高度
sw = Me.Width
sh = Me.Height
BitBlt Picture1.hdc, 0, 0, sw, sh, hdc, 0, 0, vbSrcCopy '鼠标框岁晌
DrawIcon Picture1.hdc, CurPos.X - 10, CurPos.Y - 10, Cur
ReleaseDC 0, hdc
Picture1.AutoRedraw = False
SavePicture Picture1.Image, "C:\Test1.bmp" ''''' 图片导出
Printer.Orientation = 2 '打印机打印页面为横向
'' Me.PrintForm '打印窗体
End Sub

追问

运行了那段程序后，打印的东西变成了这样了，图是截取出来了，但是位置不对啊

希望告诉怎么修改。。。。谢谢

追答

你可能已经用了Picture1的控件，添加Picture2或Picture3，不与你Picture有冲突
同时把截图命令中的Picture1改成新添加的控件名

追问

是啊，picture1我已经使用过了，就是我使用printform无法打印出来的区域，即做曲线图的区域，下图区域

中的内容无法打印，你说新增一个空间picture，那放在什么地方呢，目的是什么呢，谢谢！

追答

再添加一个Picture2控件放在窗体上，初始化时隐藏
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Type POINTAPI
X As Long
Y As Long
End Type
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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Sub Command1_Click()
Dim hdc As Long
Dim sw As Integer
Dim sh As Integer
Dim CurPos As POINTAPI
Dim Cur As Long
Me.Top = 0'窗体位置移动，
Me.Left = -10
On Error Resume Next
DoEvents
Picture2.AutoRedraw = True
hdc = GetDC(0)
GetCursorPos CurPos
Cur = GetCursor
Picture2.Top = 0
Picture2.Left = 0
Picture2.Width = Me.Width
Picture2.Height = Me.Height - 任务栏高度
sw = Me.Width
sh = Me.Height
BitBlt Picture1.hdc, 0, 60, sw, sh, hdc, 0, 60, vbSrcCopy '鼠标框
DrawIcon Picture2.hdc, CurPos.X - 10, CurPos.Y - 10, Cur
ReleaseDC 0, hdc
Picture2.AutoRedraw = False
'Picture2.Visible = True
SavePicture Picture2.Image, "C:\Test1.bmp" ''''' 图片导出

End Sub
Private Sub Form_Load()
Picture2.Visible = False
End Sub

追问

还是打印不了啊，现在这样修改后，那个曲线框中又变成什么都没有了，悲剧啊。。。。能不能直接给个你测试的例子或者远程看下。。。。

追答

我这里测试通过，发个附件你测试一下看看