VFP 愛用者社區

[Ruey]

來源:程式設計師俱樂部 Clark

http://programmer.eforum2000.net/pc2020v5/forum/ShowSameTitle.asp?URL=N&board_pc2020=vb&index=94&id=12543&mode=&type_pc2020=sametitleLevel-2

'+----------------------------------------------------------------------------
'
' Function: OpenPrinter
'
' Description: 開啟印表機通道
'
' Arguments: iPortName : 連接埠名稱
'
' Returns: 印表機代碼(-1代表開啟失敗)
'
'-----------------------------------------------------------------------------

Public Function OpenPrinter(ByVal iPortName As String) As Integer
Dim PrinterID As Integer

PrinterID = FreeFile
OpenPrinter = PrinterID

On Error Resume Next
Open iPortName For Binary Access Write Shared As #PrinterID
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbExclamation, "印表機錯誤"
OpenPrinter = -1
Else
Call PrinterInit(PrinterID)
End If
End Function


'+----------------------------------------------------------------------------
'
' Function: ClosePrinter
'
' Description: 關閉印表機通道
'
' Arguments: PrinterID : 印表機代碼
'
' Returns: 是否正常關閉(Boolean)
'
'-----------------------------------------------------------------------------

'關掉Printer
Public Function ClosePrinter(ByVal PrinterID As Integer) As Boolean
ClosePrinter = True
On Error Resume Next
Close PrinterID
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbExclamation, "印表機錯誤"
ClosePrinter = False
End If
End Function


'+----------------------------------------------------------------------------
'
' Function: PrintCode
'
' Description: 列印控制碼
'
' Arguments: PrinterID : 印表機代碼
' CodeArr : 控制碼陣列
'
' Returns: 是否正常(Boolean)
'
'-----------------------------------------------------------------------------

Public Function PrintCode(ByVal PrinterID As Integer, ByRef CodeArr() As Byte) As Boolean
PrintCode = True
On Error Resume Next
Put #PrinterID, , CodeArr
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbExclamation, "印表機錯誤"
PrintCode = False
Exit Function
End If
End Function


'+----------------------------------------------------------------------------
'
' Function: PrintString
'
' Description: 列印字串
'
' Arguments: PrinterID : 印表機代碼
' iString : 待列印字串(只能印ASCII)
'
' Returns: 是否正常(Boolean)
'
'-----------------------------------------------------------------------------

Public Function PrintString(ByVal PrinterID As Integer, ByVal iString As String) As Boolean
PrintString = True
On Error Resume Next
Put #PrinterID, , iString
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbExclamation, "印表機錯誤"
PrintString = False
Exit Function
End If
End Function


'+----------------------------------------------------------------------------
' 印表機--控制碼
'-----------------------------------------------------------------------------


'+----------------------------------------------------------------------------
'
' Function: PrinterInit
'
' Description: 初始化印表機(ESC @)
'
' Arguments: PrinterID : 印表機代碼
'
' Returns: nothing
'
'-----------------------------------------------------------------------------

Public Sub PrinterInit(ByVal PrinterID As Integer)
Dim CodeArr(1) As Byte
CodeArr(0) = &H1B
CodeArr(1) = &H40
Call PrintCode(PrinterID, CodeArr)
End Sub


'+----------------------------------------------------------------------------
'
' Function: PrinterLineFree
'
' Description: 列印+換行(LF)
'
' Arguments: PrinterID : 印表機代碼
'
' Returns: nothing
'
'-----------------------------------------------------------------------------

Public Sub PrinterLineFree(ByVal PrinterID As Integer)
Dim CodeArr(0) As Byte
CodeArr(0) = &HA
Call PrintCode(PrinterID, CodeArr)
End Sub


'+----------------------------------------------------------------------------
'
' Function: PrinterXPosition
'
' Description: 印表機水平軸位置(ESC $)
'
' Arguments: PrinterID : 印表機代碼
' HorizontalPosition : 水平軸位置
'
' Returns: nothing
'
'-----------------------------------------------------------------------------

Public Sub PrinterXPosition(ByVal PrinterID As Integer, ByVal HorizontalPosition As Integer)
Dim CodeArr(3) As Byte
CodeArr(0) = &H1B
CodeArr(1) = &H24
CodeArr(2) = HorizontalPosition Mod 256
CodeArr(3) = CByte(HorizontalPosition / 256)
Call PrintCode(PrinterID, CodeArr)
End Sub

[Ruey]

Private Sub Command1_Click()
Dim PrinterID As Integer
PrinterID = OpenPrinter("LPT1")

PrinterXPosition PrinterID, 50
PrintString PrinterID, "Clark"
PrinterLineFree PrinterID

ClosePrinter PrinterID
End Sub