用过Windows的人都知道，几乎所有软件，Word也好，Excel也好，AutoCAD也好，在打印的时候，一旦按下【打印】按钮，打印机就会开始动作，然后整页纸会被送入打印机，哪怕这张纸上仅有一个字也是如此。这就是所谓的“按页”打印，。嗯，是的，这在一般情况下似乎也没有什么问题。但是，有的场合就不行了，比如票据打印，还有打印一些流水帐之类的东西，总不至于打一份记录就用一整页纸这么夸张吧，所以我们必须找到一个“按行”打印的方法，当打印机打完一行后，并不执行出纸动作，而是停留在下一行的位置待命。因此我编写了这个类，以方便需要用到“按行”打印的人士使用。
------------------------------------------------------
简单讲一下原理，我们都知道Windows程序在打印的时候都有一个“打印到文件”的功能，这个功能可以讲打印的内容存为一种后缀为.PRN的文件，很多工具都能浏览这种文件，比如Adobe的PageMaker。
当我们生成了.PRN文件（而不是实质打印后），就能对文件本身进行修改，根据我的实验，发现该文件最后三个字节为“出纸”命令。Windows打印每次都换页的秘密就在于此，简单的，我们只需要将这三个字节删除，打印机就不会执行“出纸”命令了。
接着，我们将处理后的.PRN（最后三个字节被删除）文件用常规的方法再实质性（也就是启动打印机）打印一遍，打印机因为收不到“出纸”指令，所以它打完一行之后如果没有新的内容，它就会卡在原处不动，除非有新的内容需要它再次启动。
至此，完成“按行”打印的目的。
------------------------------------------------------
说明：
1. 本程序只使用于针式打印机
2. 本程序所使用的长度单位为“像素”
------------------------------------------------------
首先按常规方法添加向工程里添加一个类，取名为clsLBLPrn，并将以下内容复制进去：
*************************************************************
LBL (Line By Line) Print class
2004.06.01 Written By Rockage(Yang Hua)
http://www.rockags.com
http://www.stoneren.com
email:
rockages@gmail.com
*************************************************************
Author grants royalty-free rights to use this code.
*************************************************************
Option Explicit
Private Type DOCINFO
cbSize As Long
lpszDocName As String
lpszOutput As String
lpszDatatype As String
fwType As Long
End Type
Private Type DOC_INFO_1
pDocName As String
pOutputFile As String
pDatatype As String
End Type
Private Type POINT_TYPE
x As Long
y As Long
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Drawing API:
Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lplf As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal fnPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINT_TYPE) As Long
Private Declare Function LineTo Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Printer API:
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpszDriver As String, ByVal lpszDevice As String, ByVal lpszOutput As Long, lpInitData As Any) As Long
Private Declare Function StartPage Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function StartDoc Lib "gdi32.dll" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
Private Declare Function EndPage Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function EndDoc Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrn As Long, pDefault As Any) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrn As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrn As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private lf As LOGFONT, itsCurrentX As Long, itsCurrentY As Long
Private pt As POINT_TYPE
Private ret As Long
Private hPrintDC As Long
Private di As DOCINFO
Private prnName As String, strDOC As Boolean
Public Property Let CurrentY(ByVal vNewValue As Long)
itsCurrentY = vNewValue
End Property
Public Property Let CurrentX(ByVal vNewValue As Long)
itsCurrentX = vNewValue
End Property
Public Property Let FontSize(ByVal vNewValue As Long)
lf.lfHeight = vNewValue
End Property
Public Sub PrintLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
MoveToEx hPrintDC, X1, Y1, pt
LineTo hPrintDC, X2, Y2
End Sub
Public Sub PrintText(ByVal strText As String)
Dim hFont As Long, hOldFont As Long
hFont = CreateFontIndirect(lf)
hOldFont = SelectObject(hPrintDC, hFont)
ret = TextOut(hPrintDC, itsCurrentX, itsCurrentY, strText, LenB(StrConv(strText, vbFromUnicode)))
ret = SelectObject(hPrintDC, hOldFont)
ret = DeleteObject(hFont)
End Sub
Public Sub EndDocs()
If strDOC Then
ret = EndPage(hPrintDC) 结束虚拟打印,temp.prn过渡文件生成完毕
ret = EndDoc(hPrintDC)
--------------------------------------------
进入实质打印：
Dim hPrn As Long
Dim Written As Long
Dim I As Long
Dim hFile As Integer
Dim sFile As String
Dim Buffer() As Byte, lstByte As Long
Dim di2 As DOC_INFO_1
hFile = FreeFile
sFile = App.Path "" "temp.prn" 装载过渡文件
di2.pDocName = sFile
di2.pOutputFile = vbNullString
di2.pDatatype = "RAW"
Call OpenPrinter(prnName, hPrn, ByVal 0)
Call StartDocPrinter(hPrn, 1, di2) 打开一个直传模式的打印Job
Call StartPagePrinter(hPrn)
hFile = FreeFile
Open sFile For Binary Access Read As hFile
If LOF(hFile) 0 Then
ReDim Buffer(1 To LOF(hFile)) As Byte
lstByte = UBound(Buffer) - 3 temp.prn文件的最后三个字节为翻页指令，此处将此3字节过滤
For I = 1 To lstByte
Get #hFile, , Buffer(I)
Next I
Call WritePrinter(hPrn, Buffer(1), lstByte, Written) 数据直接传送到打印机
End If lof=0
Close #hFile
Call EndPagePrinter(hPrn)
DoEvents
Call EndDocPrinter(hPrn) 结束打印
Call ClosePrinter(hPrn)
ret = DeleteDC(hPrintDC)
strDOC = False
Kill sFile 删除过渡文件
End If
End Sub
Public Sub StartDocs()
创建一个与默认打印机相关联的DC:
hPrintDC = CreateDC("WINSPOOL", prnName, 0, ByVal CLng(0))
di.cbSize = Len(di)
di.lpszDocName = "Heavy Metal Forever" 打印标题，随意设
di.lpszOutput = App.Path "" "temp.prn" 打印到过渡文件
di.lpszDatatype = ""
di.fwType = 0
ret = StartDoc(hPrintDC, di) 以传统模式开始一个打印Job
ret = StartPage(hPrintDC)
strDOC = True
End Sub
Private Sub Class_Initialize()
Dim sRet As String
Dim nRet As Integer
Dim I As Integer
查WIN.INI 中的默认打印机:
sRet = Space(255)
nRet = GetProfileString("Windows", ByVal "device", "", sRet, Len(sRet))
sRet = UCase(Left(sRet, InStr(sRet, ",") - 1))
prnName = sRet 默认打印机
End Sub
Private Sub Class_Terminate()
Exit Code
End Sub
