需求如下,使用VB6新建一个工程,在默认的Form1上:
1)放置一个CommandButton控件
2)放置一个PictureBox控件,默认名称为Picture1,在Picture1里面在放置一个PictureBox控件,默认名称为Picture2控件,在Picture2里面放置一个RichTextBox和一个OLE控件,默认名称分别为RichTextBox1和Ole1
3)在窗体上放置一个水平滚动条和一个垂直滚动条,默认名称为VScroll1和HScroll1
4)进入代码视图,插入如下代码:Private Sub Command1_Click()
Dim str As String
str = "这里需要实现打印PictureBox2上面所有元素的程序..."
str = str & vbCrLf & vbCrLf & "请你帮忙!!"
MsgBox str, vbInformation, "谢谢你"
End SubPrivate Sub Form_Load()
InitSize
Dim strRTF As String
strRTF = "{\rtf1\ansi\ansicpg936\deff0{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}"
strRTF = strRTF & "{\f1\fswiss\fprq2\fcharset0 Arial Black;}{\f2\fnil\fcharset134 \'cb\'ce\'cc\'e5;}}"
strRTF = strRTF & "{\colortbl ;\red255\green0\blue0;\red128\green0\blue0;\red0\green0\blue255;}"
strRTF = strRTF & "{\stylesheet{ Normal;}{\s1 heading 1;}{\s2 heading 2;}{\s3 heading 3;}"
strRTF = strRTF & "{\s4 heading 4;}{\s5 heading 5;}{\s6 heading 6;}{\s7 heading 7;}{\s8 heading 8;}{\s9 heading 9;}}"
strRTF = strRTF & "\viewkind4\uc1\pard\cf1\lang1033\b\f0\fs32 Test word\cf0\b0"
strRTF = strRTF & "\par \pard\keepn\s8\cf2\i\f1 Test word Test word Test word Test word"
strRTF = strRTF & "\par \pard\keepn\s9\cf3\ul\b\i0\f0\fs28 This is test content\'85\'85"
strRTF = strRTF & "\par \pard\cf0\lang2052\ulnone\b0\f2\fs18 \par }"
RichTextBox1.TextRTF = strRTF
OLE1.CreateEmbed App.Path & "\mydoc.doc"
End SubPrivate Sub InitSize()
'初始化页面所有控件的大小及位置
'On Error Resume Next
Command1.Move 120, 120, 1800, 375
Command1.Caption = "打印Picture2控件"
Picture1.Move 120, 600, Me.ScaleWidth - 555, Me.ScaleHeight - 1050
Picture1.BackColor = vbApplicationWorkspace
Picture1.ScaleMode = 3 'Pixel
Picture2.Move 20, 20, 794, 1123 'Picture2刚好为一张A4纸的大小
HScroll1.Move 120, Picture1.Top + Picture1.Height, Picture1.Width, 315
VScroll1.Move Picture1.Left + Picture1.Width, 600, 315, Picture1.Height
VScroll1.min = 0
VScroll1.max = IIf((Picture2.Height + 40 - Picture1.Height / 15) < 0, 0, Picture2.Height + 40 - Picture1.Height / 15)
VScroll1.SmallChange = Picture1.Height / 60
VScroll1.LargeChange = Picture1.Height / 15
HScroll1.min = 0
HScroll1.max = IIf((Picture2.Width + 40 - Picture1.Width / 15) < 0, 0, Picture2.Width + 40 - Picture1.Width / 15)
HScroll1.SmallChange = Picture1.Width / 60
HScroll1.LargeChange = Picture1.Width / 15
Picture2.ScaleMode = 3
RichTextBox1.Move 60, 60, 674, 150
OLE1.Move 60, 215, 674, 848
End SubPrivate Sub Form_Resize()
InitSize
End SubPrivate Sub VScroll1_Change()
Picture2.Top = 20 - VScroll1.value
End SubPrivate Sub VScroll1_GotFocus()
Picture2.SetFocus
End SubPrivate Sub VScroll1_Scroll()
Picture2.Top = 20 - VScroll1.value
End SubPrivate Sub HScroll1_Change()
Picture2.Left = 20 - HScroll1.value
End SubPrivate Sub HScroll1_GotFocus()
Picture2.SetFocus
End SubPrivate Sub HScroll1_Scroll()
Picture2.Left = 20 - HScroll1.value
End Sub
5)最后,在应用程序的目录新建一个名为“mydoc.doc”的WORD文档,随便在文档里面插入一些表格和文字,保存并关闭6)运行应用程序。现在的问题:我的目的是想单击Command1按钮打印Picture2上的所有内容,保存RichtextBox里面的格式文本以及嵌入在OLE里面的WORD文档。我尝试了很多种方法,都没有办法成功,这几种方法都是围绕如何将Picture2转换成一个BMP位图,然后再打印该位图。但是所有方法都最多转换Picture2的可见部分,不可见部分无法保存。这只是解决我问题的一个示例程序,实际我的方案中,每个需要打印的PictureBox都可能包含每个RichTextBox控件,并且RichTextBox控件是放置再OLE上方的。如果使用位图打印整个Picture2的,这样虽然虽然可以解决,但不是狠完美,因为使用BMP格式打印出来文字清晰度不够,有锯齿。如果能够清晰的打印出Picture2,我愿意出1000元感谢,我在广州,银行划帐、汇款都可以。当然这只是我的一个手段,因为最近很多问题都无人做答,对于真正的高手,1000真不算什么。无论怎样,我一定会重重酬谢!!!!
1)放置一个CommandButton控件
2)放置一个PictureBox控件,默认名称为Picture1,在Picture1里面在放置一个PictureBox控件,默认名称为Picture2控件,在Picture2里面放置一个RichTextBox和一个OLE控件,默认名称分别为RichTextBox1和Ole1
3)在窗体上放置一个水平滚动条和一个垂直滚动条,默认名称为VScroll1和HScroll1
4)进入代码视图,插入如下代码:Private Sub Command1_Click()
Dim str As String
str = "这里需要实现打印PictureBox2上面所有元素的程序..."
str = str & vbCrLf & vbCrLf & "请你帮忙!!"
MsgBox str, vbInformation, "谢谢你"
End SubPrivate Sub Form_Load()
InitSize
Dim strRTF As String
strRTF = "{\rtf1\ansi\ansicpg936\deff0{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}"
strRTF = strRTF & "{\f1\fswiss\fprq2\fcharset0 Arial Black;}{\f2\fnil\fcharset134 \'cb\'ce\'cc\'e5;}}"
strRTF = strRTF & "{\colortbl ;\red255\green0\blue0;\red128\green0\blue0;\red0\green0\blue255;}"
strRTF = strRTF & "{\stylesheet{ Normal;}{\s1 heading 1;}{\s2 heading 2;}{\s3 heading 3;}"
strRTF = strRTF & "{\s4 heading 4;}{\s5 heading 5;}{\s6 heading 6;}{\s7 heading 7;}{\s8 heading 8;}{\s9 heading 9;}}"
strRTF = strRTF & "\viewkind4\uc1\pard\cf1\lang1033\b\f0\fs32 Test word\cf0\b0"
strRTF = strRTF & "\par \pard\keepn\s8\cf2\i\f1 Test word Test word Test word Test word"
strRTF = strRTF & "\par \pard\keepn\s9\cf3\ul\b\i0\f0\fs28 This is test content\'85\'85"
strRTF = strRTF & "\par \pard\cf0\lang2052\ulnone\b0\f2\fs18 \par }"
RichTextBox1.TextRTF = strRTF
OLE1.CreateEmbed App.Path & "\mydoc.doc"
End SubPrivate Sub InitSize()
'初始化页面所有控件的大小及位置
'On Error Resume Next
Command1.Move 120, 120, 1800, 375
Command1.Caption = "打印Picture2控件"
Picture1.Move 120, 600, Me.ScaleWidth - 555, Me.ScaleHeight - 1050
Picture1.BackColor = vbApplicationWorkspace
Picture1.ScaleMode = 3 'Pixel
Picture2.Move 20, 20, 794, 1123 'Picture2刚好为一张A4纸的大小
HScroll1.Move 120, Picture1.Top + Picture1.Height, Picture1.Width, 315
VScroll1.Move Picture1.Left + Picture1.Width, 600, 315, Picture1.Height
VScroll1.min = 0
VScroll1.max = IIf((Picture2.Height + 40 - Picture1.Height / 15) < 0, 0, Picture2.Height + 40 - Picture1.Height / 15)
VScroll1.SmallChange = Picture1.Height / 60
VScroll1.LargeChange = Picture1.Height / 15
HScroll1.min = 0
HScroll1.max = IIf((Picture2.Width + 40 - Picture1.Width / 15) < 0, 0, Picture2.Width + 40 - Picture1.Width / 15)
HScroll1.SmallChange = Picture1.Width / 60
HScroll1.LargeChange = Picture1.Width / 15
Picture2.ScaleMode = 3
RichTextBox1.Move 60, 60, 674, 150
OLE1.Move 60, 215, 674, 848
End SubPrivate Sub Form_Resize()
InitSize
End SubPrivate Sub VScroll1_Change()
Picture2.Top = 20 - VScroll1.value
End SubPrivate Sub VScroll1_GotFocus()
Picture2.SetFocus
End SubPrivate Sub VScroll1_Scroll()
Picture2.Top = 20 - VScroll1.value
End SubPrivate Sub HScroll1_Change()
Picture2.Left = 20 - HScroll1.value
End SubPrivate Sub HScroll1_GotFocus()
Picture2.SetFocus
End SubPrivate Sub HScroll1_Scroll()
Picture2.Left = 20 - HScroll1.value
End Sub
5)最后,在应用程序的目录新建一个名为“mydoc.doc”的WORD文档,随便在文档里面插入一些表格和文字,保存并关闭6)运行应用程序。现在的问题:我的目的是想单击Command1按钮打印Picture2上的所有内容,保存RichtextBox里面的格式文本以及嵌入在OLE里面的WORD文档。我尝试了很多种方法,都没有办法成功,这几种方法都是围绕如何将Picture2转换成一个BMP位图,然后再打印该位图。但是所有方法都最多转换Picture2的可见部分,不可见部分无法保存。这只是解决我问题的一个示例程序,实际我的方案中,每个需要打印的PictureBox都可能包含每个RichTextBox控件,并且RichTextBox控件是放置再OLE上方的。如果使用位图打印整个Picture2的,这样虽然虽然可以解决,但不是狠完美,因为使用BMP格式打印出来文字清晰度不够,有锯齿。如果能够清晰的打印出Picture2,我愿意出1000元感谢,我在广州,银行划帐、汇款都可以。当然这只是我的一个手段,因为最近很多问题都无人做答,对于真正的高手,1000真不算什么。无论怎样,我一定会重重酬谢!!!!
Last reviewed: October 13, 1997
Article ID: Q161299
The information in this article applies to:
Standard, Professional, and Enterprise Editions of Microsoft Visual Basic for Windows, version 5.0
SUMMARY
This article shows how to capture any form or window including the screen into a Visual Basic Picture object. Once the on-screen image is captured in the Picture object, it can easily be printed using the PaintPicture method of the Visual Basic Printer object. MORE INFORMATION
The included example provides several useful routines for capturing images. All of the routines have been written to work under both 16- and 32-bit Windows platforms and they contain full palette support. The routines in the example can: Capture the entire contents of a form.
Capture the client area of a form.
Capture the entire screen.
Capture the active window on the screen.
Capture any portion of any window given a handle to it.
Create a Picture object from a bitmap and a palette.
Print a Picture object as large as possible on the page. Visual Basic 4.0 introduced a new Picture object. The Picture object is actually a standard OLE type and it is documented in the Control Developer's Kit (CDK.)
The CDK includes the function OleCreatePictureIndirect which can be used to construct new Picture objects from Visual Basic 4.0. The routine CreateBitmapPicture in the example calls OleCreatePictureIndirect to build a Picture object from a handle to a bitmap and a handle to a palette. If the Picture includes a valid palette, Visual Basic will know to use it when rendering the Picture to the screen or printer. The CreateBitmapPicture routine is used by the CaptureWindow routine to construct Picture objects containing a bitmap of a part or all of a window. The CaptureWindow routine in the example captures any portion of a window given a window handle. The routine includes several parameters for describing the exact portion of the window to capture. Capture Window works by copying the on-screen image of a window into a new bitmap. It also checks to see if the screen has a palette and if so it makes a copy of it. CaptureWindow then calls CreateBitmapPicture to construct a bitmap from the newly created bitmap and palette. The CaptureForm, CaptureClient, CaptureScreen, and CaptureActiveWindow routines included in the example all use CaptureWindow to capture specific windows. CaptureForm and CaptureClient both call Capture window and pass it the hWnd property of a Form object. CaptureScreen simply gets the handle to the desk top window and calls CaptureWindow. Similarly, CaptureActiveWindow just gets the window handle of the active window and calls CaptureWindow. Once the desired image is captured in a Picture object, it is easy to print in Visual Basic 4.0 using the PaintPicture method of the Printer object. The example provides the routine PrintPictureToFitPage that uses the PaintPictureMethod to print the captured images as large as possible in the printable area of the page. ExampleStart a new project. Form1 is created by default. Place six CommandButtons on the form along the left side. Place one picture box on the form to the right of the buttons. Put the following code in Form1:
可以直接得到不可见区域的内容IViewObject接口可以创建和管理与通知接收器的连接,让调用程序获取控件改变的通知,提供了Draw方法这两天我一直在捣鼓这个问题,只是不知道如何得到这个接口
你先看一下MSDN的资料
导出到WORD后,文档格式无法控制,所以不行。我当然有考虑过。
1)如果用户改变了窗口大小,比如不是全部,每一次Picture的可见范围很小,那么就需要多次抓图,速度比较慢。
2)如果在程序处理的过程中,用户单击了其他窗口,那么就乱抓一通,全乱套了
3)打印出来效果很差,由于采用图片,锯齿比较厉害所以,从根本上说,问题还是没有解决。
//2)如果在程序处理的过程中,用户单击了其他窗口,那么就乱抓一通,全乱套了
//3)打印出来效果很差,由于采用图片,锯齿比较厉害1、不需要多次抓图,可通过API函数解决
2、由于是对窗口的hwnd控制,因此不会乱抓一通
3、优化打印代码。
mk:@MSITStore:C:\Program%20Files\Microsoft%20Visual%20Studio\MSDN98\98VS\2052\kb.chm::/Source/vbwin/q178076.htm中的部分代码
这个方法我知道,我现在也可以先将整个Picture画出来(不含RichtextBox),然后可以再一个一个将Richtextbox画出来,但不知道怎么样将Richtextbox的图像放过去。有没有MSN,方便一下交流!!