VB 打印图片 VB 打印图片 VB 打印图片 VB 打印图片

摘要:VB源码,报表打印,打印图片,图像打印 VB 打印BMP格式的图片文件，Vb打印图像的实例。打印窗口在右侧，左侧上部分是资源管理器，用来选择图片路径，下部是所需路径下的所有BMP图片，你可以任选一张后，单击鼠标，即可在右侧预览。确认无误后可点击“打颖按钮将这张BMP图像打印出来。 运行环境：Windows/VB6

本DataGridView打印控件和.NET打印控件5.7版2014年11月2日修改完成，完全免费，在.NET2.0及以上环境下都可以使用（VB打印、C#打印都是可以的），有帮助文档与使用实例。 与上一版相比，控件5.7版的主要更改如下： 1、重写DataGridView导出Excel的代码，5.7版控件使用开源的NPOI库导出Excel,完全不依赖Office,不会再有因为没装Office或Office安装有问题而导出失败的情况，而且导出速度非常快，支持大于65536条记录的导出（自动分成多个工作表），效果非常好。导出Excel的接口未变，因此您不需要修改任何代码，只需替换控件即可； 2、SimpleReport打印组件添加了导出Excel功能，该功能在打印预览界面的按钮中； 3、多表头组件MulHeaderDataGridView添加了从Excel中导入数据（ImportFromExcel函数）及复制（Copy函数）与粘贴（Paste函数）的功能。其中导入Excel功能使用开源的NPOI组件实现，不依赖Office。 4、其他一些完善，比如解决了导出Excel时强制换行不自动显示，而是要双击才显示问题；导出Excel时，图片能按单元格大小导出。 本控件特色： 1、强大的DataGridView打印功能，不仅可以以多种形式（普通打印、分栏打印、跨页打印、工资条打印）打印DGV表格，基本上能完全按DGV控件本身设置的格式如字体、字号、背景颜色、前景颜色、单元格对齐方式等打印出来，文字图像都可以打印，而且是完全根据表格当前的显示顺序进行打印的，基本上做到了所见即所得的打印。 2、报表设计功能。报表模板设计组件EasyReport可以设计普通报表、分组报表、套打模板等，以DataGridView为数据源。控件的位置以毫米为计量单位，定位准确，很适合套打单据设计。 3、强大的图表打印功能。5.2版控件新增了一个Chartlet的组件，使用非常方便，可以生成柱形图、饼图、折线图等多种图形，而且可以设置2D或3D效果，既可以在打印控件中打印出来，也可以在Graphics对象中显示。 4、分组汇总打印DataGridVeiw功能，每组还可以自动换新页打印，还可以自动增加行号。 5、强大的文本打印输出功能，控件提供多个文本打印重载函数，打印文本时，如果需要，控件会自动换行和换页打印输出。还增加了以指定行间距及字符间距打印文本的功能，可以用固定行距，也可以用单倍或多倍行距打印文本。 6、强大的绘图功能，基本上.NET的GDI+的绘图函数(如直线、矩形、路径、多边形、曲线等)都有，只有个别函数的名称有点区别。 7、支持同一文档多种版面格式打印（类似于Word中的节的功能）：对同一份文档，不同的页面可以设置不同的格式（纸张大小、纸张方向、页边距），只需要在新增一页时在NewPage方法中指定要使用的页面格式即可，使用非常简单。 8、报表文件保存功能。本控件允许将当前打印预览的内容保存为报表文件，以后使用本控件重新打开该报表文件即可重现原来保存报表时的打印内容。 9、Excel导出功能，可以将DataGridView导出为Excel文件，5.7版控件使用开源的NPOI导出Excel，速度非常快，效果非常好，5.4版还增加了合并单元格的导出功能。 10、打印DataGridView时的打印方案保存与读取功能。可以将当前打印参数保存为打印方案文件，或者从保存的打印方案文件中读取打印参数。 11、水印打印功能。根据需要，可以在页面中打印或不打印以半透明空心文字打印水印。 12、强大的容器控件打印功能(DrawPanel函数)。借助该函数，您只需要在您的容器控件中设计好要打印的内容及打印内容的相对位置，控件轻松帮你打印出来(如果超过一页，控件会自动换页续打)。 13、特殊文字效果打印功能。控件具有打印浮雕文字、阴影文字、空心文字、块文字的功能。 14、页眉页脚中既可打印文字，也可打印图像，或者即打印图像又打印输出文字。 15、图像与图标打印输出功能。 16、多表头（跨行跨列的复杂表头）打印功能，多表头组件支持多表头显示与打印、单元格内容的合并显示、打印与导出。 17、自定义纸张支持功能。 18、纸张背景图片设置打印功能。 19、.NET4.0支持功能(是单独的一个文件)。 20、直接打印窗口中的TreeView控件功能。 21、打印窗口中的ListView功能。 22、RichTextBox控件的RTF文本打印功能。 23、斜线表头打印功能（5.4版新增）。 24、二维码打印功能（5.5版本增加）。 25、5.6版新增的SimpleReport组件允许您在一个方案文件中管理多个打印方案，在打印预览时能自由在各个打印方案之间切换。 26、5.7版控件增加了使用开源的NPOI从Excel文件中导入数据到DataGridView的功能，以及DataGridView的复制与粘贴功能。 我将持续改进该控件，并将不断推出控件的新版本，要查看或下载控件的升级版本，请登陆网站：http://myyouping.download.csdn.net/ 。具体使用方法请参见帮助文件与实例文件，如有疑问或好的建议，请与我联系： 邮箱：myyouping@139.com Q Q：479781502

本DataGridView打印控件和.NET打印控件5.5版（含报表模板设计组件）2014年2月8日修改完成，完全免费，在.NET2.0及以上环境下都可以使用（VB打印、C#打印都是可以的），有帮助文档与使用实例。 与上一版本的5.4版相比，新控件5.5版的主要更改如下： 1、对控件进行了完善，DGVPrint、VB2008Print、EasyReport组件的打印预览速度有较大的提升； 2、VB2008Print与EasyReport添加了二维码打印的功能，该功能使用开源的Zxing.NET实现； 3、添加了DrawDGVEx函数，一方面可以以DGVprint对象中的参数在VB2008Print组件中打印，另一方面提供了并排打印多个表格的重载函数； 4、DGVPrint组件添加了报表头与报表尾内容的设置属性和参数； 5、DGVPrint与VB2008Print组件在以工资条方式打印表格时，添加了是否自动换行续打的功能（即，如果工资条列太多在一行中打印不下时，可以指定自动换行续打）； 6、修改了EasyReport组件的设计界面，每个区域的属性放在属性窗口中显示； 7、EasyReport组件添加了简单的多栏打印支持功能； 8、VB2008Print组件添加了PrintDGVFixedWidth函数，方便将DataGridView按指定宽度进行打印； 9、去掉了网页打印功能（因为在IE11下没法使用，所以干脆去掉），去掉了打印RDLC报表的功能； 10、其他一些完善，比如在导出Excel时，如果Columheader不可见，则不导出；解决了快速导出Excel时部分特殊列没有表格线问题（比如是数值列，但使用了%等格式）；VB2008Print组件添加了PageScale可以指定打印时的缩放比例等等。 本控件特色： 1、强大的DataGridView打印功能，不仅可以以多种形式（普通打印、分栏打印、跨页打印、工资条打印）打印DGV表格，基本上能完全按DGV控件本身设置的格式如字体、字号、背景颜色、前景颜色、单元格对齐方式等打印出来，文字图像都可以打印，而且是完全根据表格当前的显示顺序进行打印的，基本上做到了所见即所得的打印。 2、报表设计功能。报表模板设计组件EasyReport与WebEasyReport组件可以设计普通报表、分组报表、套打模板等，分别以DataGridView为数据源。控件的位置以毫米为计量单位，定位准确，很适合套打单据设计。 3、强大的图表打印功能。5.2版控件新增了一个Chartlet的组件，使用非常方便，可以生成柱形图、饼图、折线图等多种图形，而且可以设置2D或3D效果，既可以在打印控件中打印出来，也可以在Graphics对象中显示。 4、分组汇总打印DataGridVeiw功能，每组还可以自动换新页打印，还可以自动增加行号。 5、强大的文本打印输出功能，控件提供多个文本打印重载函数，打印文本时，如果需要，控件会自动换行和换页打印输出。还增加了以指定行间距及字符间距打印文本的功能，可以用固定行距，也可以用单倍或多倍行距打印文本。 6、强大的绘图功能，基本上.NET的GDI+的绘图函数(如直线、矩形、路径、多边形、曲线等)都有，只有个别函数的名称有点区别。 7、支持同一文档多种版面格式打印（类似于Word中的节的功能）：对同一份文档，不同的页面可以设置不同的格式（纸张大小、纸张方向、页边 距），只需要在新增一页时在NewPage方法中指定要使用的页面格式即可，使用非常简单。 8、报表文件保存功能。本控件允许将当前打印预览的内容保存为报表文件，以后使用本控件重新打开该报表文件即可重现原来保存报表时的打印内容。 9、Excel导出功能，可以将DataGridView和GridView导出为Excel文件，5.2版控件还增加了不依赖Office的导出Excel功能，而且速度非常快，5.4版还增加了合并单元格的导出功能。 10、打印DataGridView时的打印方案保存与读取功能。可以将当前打印参数保存为打印方案文件，或者从保存的打印方案文件中读取打印参数。 11、水印打印功能。根据需要，可以在页面中打印或不打印以半透明空心文字打印水印。 12、强大的容器控件打印功能(DrawPanel函数)。借助该函数，您只需要在您的容器控件中设计好要打印的内容及打印内容的相对位置，控件轻松帮你打印出来(如果超过一页，控件会自动换页续打)。 13、特殊文字效果打印功能。控件具有打印浮雕文字、阴影文字、空心文字、块文字的功能。 14、页眉页脚中既可打印文字，也可打印图像，或者即打印图像又打印输出文字。 15、图像与图标打印输出功能。 16、多表头（跨行跨列的复杂表头）打印功能，多表头组件支持多表头显示与打印、单元格内容的合并显示、打印与导出。 17、自定义纸张支持功能。 18、纸张背景图片设置打印功能。 19、.NET4.0支持功能(是单独的一个文件) 20、直接打印窗口中的TreeView控件功能 21、打印窗口中的ListView功能。 22、RichTextBox控件的RTF文本打印功能。 23、斜线表头打印功能（5.4版新增）。 24、二维码打印功能（5.5版本增加）。 我将持续改进该控件，并将不断推出控件的新版本，要查看或下载控件的升级版本，请登陆网站：http://myyouping.download.csdn.net/ 。具体使用方法请参见帮助文件与实例文件，如有疑问或好的建议，请与我联系： 邮箱：myyouping@139.com Q Q：479781502

VB单据套打设计程序ar_vb套打代码_vb套打印_套打_套打 vb_打印套打

VB打印功能全代码

摘要:VB源码,报表打印,打印通知单 VB打印邮政汇款通知单的例子，汇款通知的内容取自Access数据库里，因此程序包括两个部分，一个是从数据库中读取出打印的内容，另一部分则是按照指定格式打印出汇款通知单，在平时的编程中，这个技巧对VB来说是实用的。 运行环境：Windows/VB6

VB 打印对话框的实例 VB 打印对话框的实例

Option Explicit Global Const mm = 567 Global Const cm = 567 Global Const NM_PP_Ofs = 0 '36 Global Const Gray = &HC0C0C0 Global Scala As Single Global Const ANTEPRIMA = 0 Global Const STAMPANTE = 1 Global Const NONESCLUSIVO = 0 Global Const ESCLUSIVO = 1 Global LocPerc As String Global Const LocName = "_$$_TEMP.TMP" Global Ofs As Single Global Const SistemaCoordinate = 0 Global NM_AnnullaStampa As Boolean Global TempDemoMode As Boolean Sub SistemaBarra(sP As Integer, eP As Integer, aP As Integer) ' PrnPRN.sBar > max bar ' PrnPRN.aBar > actual value ' ' sP = start page ' eP = end page ' aP = actual page Static Stp As Single Stp = PrnPrn.tBar.Width / ((eP - sP) + 1) PrnPrn.pBar.Width = Stp * aP End Sub Function TempFileExists(MyFilename As String) As Boolean Dim TempAttr As Double TempFileExists = True On Error GoTo MyErrorFileExist TempAttr = FileLen(MyFilename) GoTo MyExitFileExist MyErrorFileExist: TempFileExists = False Resume MyExitFileExist MyExitFileExist: On Error GoTo 0 End Function Sub ContaPagine() PrnPrv.MousePointer = vbHourglass Static NumPag As Integer NumPag = 0 Static A As String, B As String PrnPrv.ePag.Clear Open LocPerc + LocName For Append As #27: Close #27 '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Open LocPerc + LocName For Input As #27 While Not EOF(27) Line Input #27, A If A = "#startpage" Then NumPag = NumPag + 1 ElseIf A = "#endpage" Then PrnPrv.ePag.AddItem Format(NumPag) End If Wend Close #27 If PrnPrv.ePag.ListCount > 0 Then PrnPrv.ePag.ListIndex = 0 Else PrnPrv.MousePointer = vbDefault MsgBox "No pages to print!", vbInformation, "Preview non available" Unload PrnPrv End If PrnPrv.MousePointer = vbDefault End Sub Sub SistemaStatusBar() PrnPrv.aPag.Caption = PrnPrv.ePag.Text PrnPrv.tPag.Caption = PrnPrv.ePag.ListCount PrnPrv.zPag.Caption = PrnPrv.zVal.Text + "%" End Sub Function StripComma(S As String) As Single Static l As Integer For l = 1 To Len(S) If Mid(S, l, 1) = "," Then Mid(S, l, 1) = "." End If Next StripComma = Val(S) End Function Sub TempDelete() Open LocPerc + LocName For Append As #25 Close #25 Kill LocPerc + LocName End Sub Sub TempInit() PrnPrv.TmpList.Pattern = "_$$_*.TMP" PrnPrv.TmpList.Path = Left(LocPerc, Len(LocPerc) - 1) PrnPrv.TmpList.Refresh If PrnPrv.TmpList.ListCount > 0 Then Kill LocPerc + "_$$_*.TMP" End If Randomize 1 Open LocPerc + LocName For Output As #25 Close #25 Unload PrnPrv End Sub Sub TempPrint(Dato As String) Open LocPerc + LocName For Append As #25 Print #25, Dato Close #25 End Sub Sub PrintHeader(Sin As String, Des As String, Dst As Integer) TempPrint "#startpage" PrintBox 2, 0.9, 18, 0.91, ANTEPRIMA PrintInLef 2, 0.55, Sin, "Arial", 8, False, ANTEPRIMA PrintInRig 18, 0.55, Des, "Arial", 8, False, ANTEPRIMA If TempDemoMode = True Then PrintCross 2, 0.9, 17.9, 26.01, ANTEPRIMA PrintCross 2.1, 0.9, 18, 26.01, ANTEPRIMA End If End Sub Sub PrintFooter(Sin As String, Des As String, Dst As Integer) PrintBox 2, 26, 18, 26.01, ANTEPRIMA PrintInLef 2, 26.1, Sin, "Arial", 8, False, ANTEPRIMA PrintInRig 18, 26.1, Des, "Arial", 8, False, ANTEPRIMA TempPrint "#endpage" ContaPagine End Sub Sub PrintRefGrid(Dst As Integer) Static X, Y As Integer TempPrint "#fontname" TempPrint "Arial" TempPrint "#fontsize" TempPrint Format(6 * Scala) For Y = 0 To 26 TempPrint "#y" TempPrint Format(Y * mm) For X = 0 To 19 TempPrint "#x" TempPrint Format(X * mm) TempPrint "#txt" TempPrint "+" & Format$(X, "#,##0") & "," & Format$(Y, "#,##0") Next Next End Sub Sub PrintJust(X As Single, Y As Single, Phrase As String, Fname As String, Fsize As Integer, Fbold As Integer, Larg As Single, Dst As Integer) ReDim aT(500) As String Static NumPar As Integer Static aP As String Static OaP As String Static lP, l As Integer Static VecOfs As Single Static Interl As Single PrnPrv.Prv.FontName = Fname PrnPrv.Prv.FontSize = Fsize PrnPrv.Prv.FontBold = Fbold 'Interl = PrnPrv.Prv.TextHeight(Phrase) Interl = 0.4 If PrnPrv.Prv.TextWidth(Phrase) > Larg * mm Then NumPar = 0 For l = 1 To Len(Phrase) If Mid$(Phrase, l, 1) = " " Then NumPar = NumPar + 1 Else aT(NumPar) = aT(NumPar) + Mid$(Phrase, l, 1) End If Next aP = "" lP = 0 For l = 0 To NumPar OaP = aP If aP = "" Then aP = aT(l) Else aP = aP + " " + aT(l) End If If PrnPrv.Prv.TextWidth(aP) > Larg * mm Then aP = OaP PrintInLef X, Y + (Interl * lP), aP, Fname, Fsize, Fbold, ANTEPRIMA Ofs = Ofs + Interl aP = aT(l) lP = lP + 1 End If Next PrintInLef X, Y + (Interl * lP), aP, Fname, Fsize, Fbold, ANTEPRIMA Ofs = Ofs + Interl Else PrintInLef X, Y, Phrase, Fname, Fsize, Fbold, ANTEPRIMA Ofs = Ofs + Interl End If End Sub Sub PrintJustS(X As Single, Y As Single, Phrase As String, Fname As String, Fsize As Integer, Fbold As Integer, Larg As Single, Dst As Integer) ReDim aT(500) As String Static NumPar As Integer Static aP As String Static OaP As String Static lP, l As Integer Static VecOfs As Single Static lStp As Single lStp = 0.3 PrnPrv.Prv.FontName = Fname PrnPrv.Prv.FontSize = Fsize PrnPrv.Prv.FontBold = Fbold If PrnPrv.Prv.TextWidth(Phrase) > Larg * mm Then NumPar = 0 For l = 1 To Len(Phrase) If Mid$(Phrase, l, 1) = " " Then NumPar = NumPar + 1 Else aT(NumPar) = aT(NumPar) + Mid$(Phrase, l, 1) End If Next aP = "" lP = 0 For l = 0 To NumPar OaP = aP If aP = "" Then aP = aT(l) Else aP = aP + " " + aT(l) End If If PrnPrv.Prv.TextWidth(aP) > Larg * mm Then aP = OaP PrintInLef X, Y + (lStp * lP), aP, Fname, Fsize, Fbold, ANTEPRIMA Ofs = Ofs + lStp aP = aT(l) lP = lP + 1 End If Next PrintInLef X, Y + (lStp * lP), aP, Fname, Fsize, Fbold, ANTEPRIMA Ofs = Ofs + lStp Else PrintInLef X, Y, Phrase, Fname, Fsize, Fbold, ANTEPRIMA Ofs = Ofs + lStp End If End Sub Sub PrintInRig(X As Single, Y As Single, Phrase As String, Fname As String, Fsize As Integer, Fbold As Integer, Dst As Integer) Static Tmp As String Static Lungh As Single Lungh = PrnPrv.Prv.TextWidth(Phrase) TempPrint "#fontname" TempPrint Fname TempPrint "#fontsize" TempPrint Format(Fsize) TempPrint "#fontbold" TempPrint Format(Fbold) TempPrint "#y" TempPrint Format(Y * mm) TempPrint "#x" TempPrint Format(X * mm) ' - Lungh TempPrint "#txt_r" TempPrint Phrase End Sub Sub PrintInLef(X As Single, Y As Single, Phrase As String, Fname As String, Fsize As Integer, Fbold As Integer, Dst As Integer) TempPrint "#fontname" TempPrint Fname TempPrint "#fontsize" TempPrint Format(Fsize) TempPrint "#fontbold" TempPrint Format(Fbold) TempPrint "#y" TempPrint Format(Y * mm) TempPrint "#x" TempPrint Format(X * mm) TempPrint "#txt_l" TempPrint Phrase End Sub Sub PrintInCen(X As Single, Y As Single, Phrase As String, Fname As String, Fsize As Integer, Fbold As Integer, Dst As Integer) Static dX As Single Static tmpX As Single ' ' X = coordinata orizzontale ' Y = coordinata del centro della riga ' Phrase = stringa da stampare ' dX = Int(PrnPrv.Prv.TextWidth(Phrase) / 2) tmpX = (X * mm) - (dX) If tmpX < 0 Then MsgBox "Error in coords!!!!", 16, "PrintInCen" Exit Sub End If TempPrint "#fontname" TempPrint Fname TempPrint "#fontsize" TempPrint Format(Fsize) TempPrint "#fontbold" TempPrint Format(Fbold) TempPrint "#y" TempPrint Format(Y * mm) TempPrint "#x" TempPrint Format(tmpX) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ TempPrint "#txt_c" TempPrint Phrase End Sub Sub PrintCross(X As Single, Y As Single, X1 As Single, Y1 As Single, Dst As Integer) TempPrint "#fill" TempPrint "1" TempPrint "#color" TempPrint "0" TempPrint "#line" TempPrint Format(X * mm) TempPrint Format(Y * mm) TempPrint Format(X1 * mm) TempPrint Format(Y1 * mm) TempPrint "" TempPrint "" TempPrint "#line" TempPrint Format(X1 * mm) TempPrint Format(Y * mm) TempPrint Format(X * mm) TempPrint Format(Y1 * mm) TempPrint "" TempPrint "" End Sub Sub PrintBoxFill(X As Single, Y As Single, X1 As Single, Y1 As Single, MyCol As Long, Dst As Integer) TempPrint "#fill" TempPrint "1" TempPrint "#color" TempPrint "0" TempPrint "#line" TempPrint Format(X * mm) TempPrint Format(Y * mm) TempPrint Format(X1 * mm) TempPrint Format(Y1 * mm) TempPrint Format(MyCol) TempPrint "BF" End Sub Sub PrintBoxFill2(X As Single, Y As Single, X1 As Single, Y1 As Single, MyCol As Long, MyFil As Long, Dst As Integer) TempPrint "#fill" TempPrint Format(MyFil) TempPrint "#color" TempPrint Format(MyCol) TempPrint "#line" TempPrint Format(X * mm) TempPrint Format(Y * mm) TempPrint Format(X1 * mm) TempPrint Format(Y1 * mm) TempPrint "" TempPrint "B" End Sub Sub PrintBox(X As Single, Y As Single, X1 As Single, Y1 As Single, Dst As Integer) TempPrint "#fill" TempPrint "1" TempPrint "#color" TempPrint "0" TempPrint "#line" TempPrint Format(X * mm) TempPrint Format(Y * mm) TempPrint Format(X1 * mm) TempPrint Format(Y1 * mm) TempPrint "" TempPrint "B" End Sub Sub PrintImg(Nome As Control, X As Single, Y As Single, X1 As Single, Y1 As Single, Dst As Integer) Static RR As Single, RT As String, NI As String TempPrint "#img" RR = (899999 * Rnd) + 100000 RT = Format(RR, "000000") NI = LocPerc + "_$$_" + RT + ".tmp" TempPrint NI SavePicture Nome, NI TempPrint Format(X * mm) TempPrint Format(Y * mm) TempPrint Format(X1 * mm) TempPrint Format(Y1 * mm) End Sub Sub SetA3() PrnPrv.Prv.Cls PrnPrv.Prv.Width = PrnPrv.Prv.Height * (29.7 / 42) PrnPrv.Prv.ScaleWidth = mm * 29.7 PrnPrv.Prv.ScaleHeight = mm * 42 Scala = PrnPrv.Prv.Height / PrnPrv.Prv.ScaleHeight End Sub Sub SetA4() PrnPrv.Prv.Cls PrnPrv.Prv.Width = PrnPrv.Prv.Height * (21 / 29.7) PrnPrv.Prv.ScaleWidth = mm * 21 PrnPrv.Prv.ScaleHeight = mm * 29.7 Scala = PrnPrv.Prv.Height / PrnPrv.Prv.ScaleHeight End Sub Sub SetB5() PrnPrv.Prv.Cls PrnPrv.Prv.Width = PrnPrv.Prv.Height * (15 / 21) PrnPrv.Prv.ScaleWidth = mm * 15 PrnPrv.Prv.ScaleHeight = mm * 21 Scala = PrnPrv.Prv.Height / PrnPrv.Prv.ScaleHeight End Sub Sub TempShow(X01 As Single, Y01 As Single, X02 As Single, Y02 As Single) PrnPrv.MousePointer = vbHourglass Static OldFill As Long, OldColo As Long Static l As Integer, Lung As Single, dX As Single, tmpX As Single Static pPnt As Integer, pRef As Integer pPnt = 0 pRef = Val(PrnPrv.ePag.Text) Static A As String, B As String Static X As Single, Y As Single Static X1 As Single, Y1 As Single Static BoxColor As Long, BoxType As String PrnPrv.Prv.Cls 'PrnPrv.Prv.Scale (X01, Y01)-(X02, Y02) PrnPrv.Prv.Left = (X01 * -1) + NM_PP_Ofs PrnPrv.Prv.Top = (Y01 * -1) + NM_PP_Ofs + PrnPrv.Cmd(0).Height Open LocPerc + LocName For Input As #26 While Not EOF(26) Line Input #26, A If A = "#line" Then Line Input #26, A X = StripComma(A) Line Input #26, A Y = StripComma(A) Line Input #26, A X1 = StripComma(A) Line Input #26, A Y1 = StripComma(A) Line Input #26, A B = A BoxColor = StripComma(A) Line Input #26, A BoxType = A If pPnt = pRef Then If B = "" And BoxType = "" Then PrnPrv.Prv.Line (X, Y)-(X1, Y1) ElseIf B <> "" Then PrnPrv.Prv.Line (X, Y)-(X1, Y1), BoxColor, BF Else PrnPrv.Prv.Line (X, Y)-(X1, Y1), , B End If End If ElseIf A = "#x" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.CurrentX = StripComma(A) End If ElseIf A = "#y" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.CurrentY = StripComma(A) End If ElseIf A = "#txt_c" Then Line Input #26, A If pPnt = pRef Then dX = Int(PrnPrv.Prv.TextWidth(A) / 2) tmpX = PrnPrv.Prv.CurrentX - dX PrnPrv.Prv.Print A End If ElseIf A = "#txt_l" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.Print A End If ElseIf A = "#txt_r" Then Line Input #26, A If pPnt = pRef Then Lung = PrnPrv.Prv.TextWidth(A) PrnPrv.Prv.CurrentX = PrnPrv.Prv.CurrentX - Lung PrnPrv.Prv.Print A End If ElseIf A = "#fontname" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.FontName = A End If ElseIf A = "#fontsize" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.FontSize = StripComma(A) * Scala End If ElseIf A = "#fontbold" Then Line Input #26, A If pPnt = pRef Then If A = "0" Then PrnPrv.Prv.FontBold = False Else PrnPrv.Prv.FontBold = True End If End If ElseIf A = "#fill" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.FillStyle = CLng(Val(A)) End If ElseIf A = "#color" Then Line Input #26, A If pPnt = pRef Then PrnPrv.Prv.FillColor = CLng(Val(A)) End If ElseIf A = "#img" Then Line Input #26, A If TempFileExists(A) = True Then PrnPrv.Img.Picture = LoadPicture(A) End If Line Input #26, A X = StripComma(A) Line Input #26, A Y = StripComma(A) Line Input #26, A X1 = StripComma(A) Line Input #26, A Y1 = StripComma(A) If pPnt = pRef Then PrnPrv.Prv.PaintPicture PrnPrv.Img.Picture, X, Y, X1, Y1 End If ElseIf A = "#startpage" Then pPnt = pPnt + 1 ElseIf A = "#endpage" Then If pPnt = pRef Then GoTo BastaLeggere End If End If Wend BastaLeggere: Close #26 If PrnPrv.Prv.Width > PrnPrv.hBar.Width Then PrnPrv.hBar.Min = 0 PrnPrv.hBar.Max = PrnPrv.Prv.Width - PrnPrv.hBar.Width PrnPrv.hBar.SmallChange = 20 'PrnPrv.hBar.LargeChange = PrnPrv.hBar.Max / 10 PrnPrv.hBar.LargeChange = (PrnPrv.hBar.Width * PrnPrv.hBar.Max) / PrnPrv.Prv.Width Else PrnPrv.hBar.Min = 0 PrnPrv.hBar.Max = 0 End If If PrnPrv.Prv.Height > PrnPrv.vBar.Height Then PrnPrv.vBar.Min = 0 PrnPrv.vBar.Max = PrnPrv.Prv.Height - PrnPrv.vBar.Height PrnPrv.vBar.SmallChange = 20 'PrnPrv.vBar.LargeChange = PrnPrv.vBar.Max / 10 PrnPrv.vBar.LargeChange = (PrnPrv.vBar.Height * PrnPrv.vBar.Max) / PrnPrv.Prv.Height Else PrnPrv.vBar.Min = 0 PrnPrv.vBar.Max = 0 End If SistemaStatusBar PrnPrv.MousePointer = vbDefault End Sub Sub TempStampa(sP As Integer, eP As Integer) PrnPrv.MousePointer = vbHourglass PrnPrn.Command2.Font.Bold = True DoEvents PrnPrn.pBar.Width = 0 Static DaStampare As Boolean DaStampare = False Static l As Integer, Lung As Single, dX As Single, tmpX As Single Static pPnt As Integer, pRef As Integer pPnt = 0 pRef = Val(PrnPrv.ePag.Text) Static A As String, B As String Static X As Single, Y As Single Static X1 As Single, Y1 As Single Static BoxColor As Long, BoxType As String Open LocPerc + LocName For Input As #26 While Not EOF(26) Line Input #26, A If A = "#line" Then Line Input #26, A X = StripComma(A) Line Input #26, A Y = StripComma(A) Line Input #26, A X1 = StripComma(A) Line Input #26, A Y1 = StripComma(A) Line Input #26, A B = A BoxColor = StripComma(A) Line Input #26, A BoxType = A If DaStampare = True Then If B = "" And BoxType = "" Then Printer.Line (X, Y)-(X1, Y1) ElseIf B <> "" Then Printer.Line (X, Y)-(X1, Y1), BoxColor, BF Else Printer.Line (X, Y)-(X1, Y1), , B End If End If ElseIf A = "#x" Then Line Input #26, A If DaStampare = True Then Printer.CurrentX = StripComma(A) End If ElseIf A = "#y" Then Line Input #26, A If DaStampare = True Then Printer.CurrentY = StripComma(A) End If ElseIf A = "#txt_c" Then Line Input #26, A If DaStampare = True Then dX = Int(Printer.TextWidth(A) / 2) tmpX = Printer.CurrentX - dX Printer.Print A End If ElseIf A = "#txt_l" Then Line Input #26, A If DaStampare = True Then Printer.Print A End If ElseIf A = "#txt_r" Then Line Input #26, A If DaStampare = True Then Lung = Printer.TextWidth(A) Printer.CurrentX = Printer.CurrentX - Lung Printer.Print A End If ElseIf A = "#fontname" Then Line Input #26, A If DaStampare = True Then Printer.FontName = A End If ElseIf A = "#fontsize" Then Line Input #26, A If DaStampare = True Then Printer.FontSize = StripComma(A) End If ElseIf A = "#fontbold" Then Line Input #26, A If DaStampare = True Then If A = "0" Then Printer.FontBold = False Else Printer.FontBold = True End If End If ElseIf A = "#fill" Then Line Input #26, A If pPnt = pRef Then Printer.FillStyle = CLng(Val(A)) End If ElseIf A = "#color" Then Line Input #26, A If pPnt = pRef Then Printer.FillColor = CLng(Val(A)) End If ElseIf A = "#img" Then Line Input #26, A If TempFileExists(A) = True Then PrnPrv.Img.Picture = LoadPicture(A) End If Line Input #26, A X = StripComma(A) Line Input #26, A Y = StripComma(A) Line Input #26, A X1 = StripComma(A) Line Input #26, A Y1 = StripComma(A) If DaStampare = True Then Printer.PaintPicture PrnPrv.Img.Picture, X, Y, X1, Y1 End If ElseIf A = "#startpage" Then If NM_AnnullaStampa = True Then GoTo BastaLeggere pPnt = pPnt + 1 If pPnt > eP Then GoTo BastaLeggere ElseIf pPnt >= sP And pPnt <= eP Then DaStampare = True SistemaBarra sP, eP, pPnt DoEvents ElseIf pPnt < sP Then DaStampare = False End If ElseIf A = "#endpage" Then If NM_AnnullaStampa = True Then GoTo BastaLeggere If pPnt >= eP Then GoTo BastaLeggere If DaStampare = True Then Printer.NewPage End If Wend BastaLeggere: Printer.EndDoc Close #26 PrnPrn.Command2.Font.Bold = False PrnPrv.MousePointer = vbDefault End Sub

让你的程序更加完善实用拥有打印预览及打印功能！