|
|
LPrint : Windows からの PR201系プリンタ直接制御
所収ソース
LPrint.Bas
Attribute VB_Name = "mdlLPrint"
'********************************************************************
' file name : LPrint.Bas
' purpose : Windows 下でのプリンタ直接出力のためのルーチン
'
' Version 0.9 / October 31, 2003
'--------------------------------------------------------------------
' history : V0.1/2002-11-20/ 新規作成。
' : V0.2/2002-11-22/ プリンタ初期化、追加。
' : V0.3/2002-11-26/ 実験用 ESC/P ルーチン、分離。
' : V0.4/2003-01-10/ コメント補記。
' : V0.5/2003-01-15/ Start/EndPagePrinter 宣言追加。
' : V0.6/2003-02-01/ LPrint 内 JIS コード用バッファ増。
' : V0.7/2003-02-21/ 念のための byt(n) の末尾 NULL 加。
' : V0.8/2003-03-11/ LPrint NULL 文字列対策。
' : V0.9/2003-10-31/ ホームページ用コメント改変。
'--------------------------------------------------------------------
' remarks : 1) 本モジュールは PC-PR201 系プリンタ用制御コード体系
' : "201PL" を前提とする。
' : 2) プリンタ初期化と文字列出力（LPrint）関係以外で、
' : 本モジュールでサポートする制御コードは以下の通り。
' : TAB コード送出
' : 水平タブ設定・解除
' : 倍角文字設定（文字の横幅拡大）・解除
' : 強調印字指定・解除
' : 文字拡大率・縮小率設定
' : 3) 本モジュールの使用手順は、以下を前提としている。
' : 'プリンタのオブジェクトハンドルを取得
' : lngResult = OpenPrinter(Printer.DeviceName, _
' : lngPrinterHandle, _
' : ByVal vbNullString)
' : 'ドキュメントに関する情報を設定
' : With udtDOCINFO
' : .pDocName = App.EXEName
' : .pOutputFile = vbNullString
' : .pDatatype = vbNullString
' : End With
' :
' : '印刷を開始
' : lngResult = StartDocPrinter(lngPrinterHandle, 1, udtDOCINFO)
' : lngResult = StartPagePrinter(lngPrinterHandle)
' :
' : lngResult = InitializePrinter(lngPrinterHandle)
' : ' 印刷内容を設定（制御コードを含まない、文字列）
' : strWrittenData = ...
' : bRet = LPrint(lngPrinterHandle, strWrittenData )
' :
' : lngResult = EndPagePrinter(lngPrinterHandle)
' : lngResult = EndDocPrinter(lngPrinterHandle)
' : 'プリンタオブジェクトをクローズ
' : lngResult = ClosePrinter(lngPrinterHandle)
'********************************************************************
Option Explicit
Public Const ESC As Byte = &H1B
'***** Declarations for Win32API
'***** 印刷ドキュメント情報構造体
Type DOC_INFO_1
pDocName As String
pOutputFile As String
pDatatype As String
End Type
'***** プリンタのオブジェクトハンドル取得関数
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
(ByVal pPrinterName As String, _
phPrinter As Long, _
pDefault As Any) As Long
'***** 印刷開始関数
Public Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pDocInfo As DOC_INFO_1) As Long
'***** 印刷ジョブ開始通知 to Sooler
Public Declare Function StartPagePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
'***** データ出力関数
Public Declare Function WritePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long, _
pBuf As Any, _
ByVal cdBuf As Long, _
pcWritten As Long) As Long
'***** 印刷ジョブ終了通知 to Sooler
Public Declare Function EndPagePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
'***** 印刷終了関数
Public Declare Function EndDocPrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
'***** プリンタのオブジェクトハンドル破棄関数
Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
'***** Declarations for 自作ＤＬＬ
Public Declare Function SJis2Jis Lib "SJis2Jis.dll" Alias "SJis2JisPR201" _
(ByRef A As Any, _
ByRef B As Any, _
ByVal C As Integer) As Long
'********************************************************************
'procedure : InitializePrinter
' purpose : プリンタ初期化
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : 0 = 成功（下記の全ステップを通過）
' : 1 = 失敗（ソフトリセット不成功）
' : 2 = 失敗（ネイティブモード移行不成功）
' : 3 = 失敗（デフォルト改行量設定不成功）
' : 4 = 失敗（デフォルト文字ピッチ指定不成功）
'********************************************************************
Public Function InitializePrinter(lngPHandle As Long) As Long
Dim lngRet As Integer
Dim bRet As Boolean
bRet = SoftReset(lngPHandle)
If bRet Then
bRet = NativeMode(lngPHandle)
If bRet Then
bRet = DefaultLineFeed(lngPHandle)
If bRet Then
bRet = DefaultCharPitch(lngPHandle)
If bRet Then
lngRet = 0 'No Error
Else
lngRet = 4
End If
Else
lngRet = 3
End If
Else
lngRet = 2
End If
Else
lngRet = 1
End If
InitializePrinter = lngRet
End Function
'********************************************************************
'procedure : SoftReset
' purpose : プリンタのソフトリセット
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' remarks : ESC/P の場合の動作
' : 1. 行バッファの印字データを消去
' : 2. コントロールコマンドで設定された全印字パラメータ
' : を初期化（登録文字は消去されない）
' : 3. ページ内に印字データがある場合、そのページを排紙
' : 4. 印字位置を第１文字目へ移動
' : 201PL の場合は、詳細不明
'********************************************************************
Private Function SoftReset(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = Asc("c")
byt(2) = Asc("1")
byt(3) = 0 '余分だが念のため
lngBytes = 3
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
SoftReset = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : NativeMode
' purpose : ネイティブ・モード指定
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
' remarks : ESC/P にはネイティブモード移行命令は無い
'********************************************************************
Private Function NativeMode(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = Asc("M")
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
NativeMode = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : DefaultLineFeed
' purpose : デフォルトの改行モード（＝１／６改行）指定
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
' remarks : ESC/P、201PL 共、デフォルトは 1/6 改行モードである
'********************************************************************
Private Function DefaultLineFeed(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = Asc("A")
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
DefaultLineFeed = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : DefaultCharPitch
' purpose : デフォルトの文字ピッチ指定
' : ... ESC/P → ANK 文字 10 CPI 指定
' : 201PR → HD パイカ指定
' remarks : ESC/P の場合の制限
' : 1) プロポーショナルピッチが設定されている間は無効
' : 2) 設定は、12CPI、15CPI が設定されるまで有効
' : 3) 印字文字間隔は、ANK ピッチの調整 [ESC][SP]で可変
'********************************************************************
Private Function DefaultCharPitch(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngBytes As Long
Dim lngRet As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = Asc("H")
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
DefaultCharPitch = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : LPrint
' purpose : 文字列の出力（ANSI、DBCS 共用）
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' : strOrigin .... 出力対象文字列（Unicode）
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function LPrint(lngPHandle As Long, strOrigin As String) As Boolean
Dim strUni As String
Dim iLen As Integer
Dim lngBytes As Long
Dim lngWritten As Long
Dim lngRet As Long
Dim bytSJIS() As Byte
Dim bytJIS(512) As Byte '元 256 bytes、2003-02-01 余裕を見て増
strUni = strOrigin '元の文字列には手を付けない
If strUni = "" Then '2003-03-11 NULL 文字対策
LPrint = True
Exit Function
End If
bytSJIS = StrConv(strUni, vbFromUnicode) 'Shift JIS 化
iLen = UBound(bytSJIS) + 1 'LenB(bytSJIS)
lngBytes = SJis2Jis(bytSJIS(0), bytJIS(0), iLen)
If lngBytes > 0 Then
lngRet = WritePrinter(lngPHandle, bytJIS(0), lngBytes, lngWritten)
LPrint = IsOK(lngRet, lngBytes, lngWritten)
Else
LPrint = False
End If
End Function
'********************************************************************
'procedure : HTab
' purpose : TAB コード(&H09) の発行
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function HTab(lngPHandle As Long) As Boolean
Dim lngRet As Long
Dim lngWritten As Long
Dim byt(128) As Byte
byt(0) = &H9
byt(1) = 0 '余分だが念のため
lngRet = WritePrinter(lngPHandle, byt(0), 1, lngWritten)
HTab = IsOK(lngRet, 1, lngWritten)
End Function
'********************************************************************
'procedure : SetHorizontalTab
' purpose : 水平タブ設定
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' : iNum ......... 設定個数（1〜32）
' : iTab() ....... タブ位置格納配列（要素は 0-origin、各値
' : の範囲は 1 〜 255）
' returns : True = 成功 / False = 失敗
' remarks : このコマンド実行で、以前に設定の水平タブは、すべてクリア
' : される。ゆえに事前の ClearHorizontalTab は不要。
'********************************************************************
Public Function SetHorizontalTab(lngPHandle As Long, _
iNum As Integer, iTab() As Integer) As Boolean
Dim i As Integer
Dim lngBytes As Long
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngWritten As Long
Dim strTemp As String
Dim j As Integer
byt(0) = ESC
byt(1) = Asc("(") '28H
lngBytes = 2
For i = 0 To iNum - 1
strTemp = Format$(iTab(i), "000")
For j = 1 To 3
byt(lngBytes) = CByte(Asc(Mid$(strTemp, j, 1)))
lngBytes = lngBytes + 1
Next j
If i = iNum - 1 Then '最終ならば
byt(lngBytes) = &H2E 'ピリオド [.]
Else '途中ならば
byt(lngBytes) = &H2C 'カンマ [,]
End If
lngBytes = lngBytes + 1
Next i
byt(lngBytes) = 0 '余分だが念のため
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
SetHorizontalTab = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : ClearHorizontalTab
' purpose : 水平タブ設定の全解除
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function ClearHorizontalTab(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = Asc("2")
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
ClearHorizontalTab = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : SetExpand
' purpose : 横倍角文字設定
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function SetExpand(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = &HE 'SO
byt(1) = 0 '余分だが念のため
lngBytes = 1
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
SetExpand = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : ClearExpand
' purpose : 横倍角文字解除
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function ClearExpand(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = &HF 'SI
byt(1) = 0 '余分だが念のため
lngBytes = 1
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
ClearExpand = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : SetEmphasis
' purpose : 強調印字指定
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function SetEmphasis(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = Asc("!")
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
SetEmphasis = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : ClearEmphasis
' purpose : 強調印字の解除
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function ClearEmphasis(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = ESC
byt(1) = CByte(&H22) '["]
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
ClearEmphasis = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : SetReduction
' purpose : 横1/2縮小
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
' remarks : ESC/P については漢字に対する半角文字指定とした。
' : ANK ならは [SI] のみで可。
'********************************************************************
Public Function SetReduction(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngBytes As Long
Dim lngRet As Long
Dim lngWritten As Long
byt(0) = &H1C 'FS
byt(1) = Asc("m") '&H6D
byt(2) = Asc("1")
byt(3) = Asc("/")
byt(4) = Asc("1")
byt(5) = Asc(",")
byt(6) = Asc("1")
byt(7) = Asc("/")
byt(8) = Asc("2")
byt(9) = Asc(",")
byt(10) = Asc(".")
byt(11) = 0 '余分だが念のため
lngBytes = 11
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
SetReduction = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : ClearReduction
' purpose : 文字縮小の解除（＝倍率を１に戻す）
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
' remarks : ESC/P については漢字に対する半角文字指定とした。
' : ANK ならは [DC2] のみで可。
'********************************************************************
Public Function ClearReduction(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = &H1C 'FS
byt(1) = Asc("m") '&H6D
byt(2) = Asc("1")
byt(3) = Asc("/")
byt(4) = Asc("1")
byt(5) = Asc(",")
byt(6) = Asc("1")
byt(7) = Asc("/")
byt(8) = Asc("1")
byt(9) = Asc(",")
byt(10) = Asc(".")
byt(11) = 0 '余分だが念のため
lngBytes = 11
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
ClearReduction = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : NewLine
' purpose : 改行
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function NewLine(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = &HD
byt(1) = &HA
byt(2) = 0 '余分だが念のため
lngBytes = 2
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
NewLine = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : NewPage
' purpose : 改ページ
'parameter : lngPHandle ... プリンタのオブジェクトハンドル
' returns : True = 成功 / False = 失敗
'********************************************************************
Public Function NewPage(lngPHandle As Long) As Boolean
Dim byt(128) As Byte
Dim lngRet As Long
Dim lngBytes As Long
Dim lngWritten As Long
byt(0) = &HC
byt(1) = 0 '余分だが念のため
lngBytes = 1
lngRet = WritePrinter(lngPHandle, byt(0), lngBytes, lngWritten)
NewPage = IsOK(lngRet, lngBytes, lngWritten)
End Function
'********************************************************************
'procedure : IsOK
' purpose : WritePrinter (Win32API) 実行結果の成功／失敗判定
'parameter : lngReturn ... WritePrinter 関数 (Win32API) の戻り値
' : lngBytes .... WritePrinter へ渡した情報のバイト数
' : lngWritten .. WritePrinter が処理したバイト数
' returns : True = 成功 / False = 失敗
'********************************************************************
Private Function IsOK(lngReturn As Long, _
lngBytes As Long, _
lngWritten As Long) As Boolean
If lngReturn = 0 Then
IsOK = False
Else
If lngBytes <> lngWritten Then
IsOK = False
Else
IsOK = True
End If
End If
End Function
'以下、応用レベル
'********************************************************************
'procedure : StartPrint
' purpose : 印字出力開始前の（簡易）処理 ... プリンタのオブジェクト
' : ハンドル (lngPrinterHandle) の取得を主目的とする
'parameter : lngPrinterHandle ... ハンドル格納のための変数 (ByRef)
' returns : True = 取得成功 / False = 失敗
' : （実際には StartPagePrinter の戻り値にて判断）
'********************************************************************
Public Function StartPrint(lngPrinterHandle As Long) As Boolean
Dim udtDOCINFO As DOC_INFO_1
Dim lngPHandle As Long
Dim lngResult As Long
'プリンタのオブジェクトハンドルを取得
lngResult = OpenPrinter(Printer.DeviceName, _
lngPrinterHandle, ByVal vbNullString)
'ドキュメントに関する情報を設定
With udtDOCINFO
.pDocName = App.EXEName
.pOutputFile = vbNullString
.pDatatype = vbNullString
End With
'印刷を開始
lngResult = StartDocPrinter(lngPrinterHandle, 1, udtDOCINFO)
lngResult = StartPagePrinter(lngPrinterHandle)
If lngResult = 0 Then
StartPrint = False
Else
StartPrint = True
End If
End Function
'********************************************************************
'procedure : FinishPrint
' purpose : 印刷終了処理 ... プリンタオブジェクトを破棄、等
'parameter : lngPrinterHandle ... プリンタオブジェクトハンドル
' returns : True = 成功 / 失敗
' : （実際には ClosePrinter の戻り値にて判断）
'********************************************************************
Public Function FinishPrint(lngPrinterHandle As Long) As Boolean
Dim lngResult As Long
lngResult = EndPagePrinter(lngPrinterHandle)
lngResult = EndDocPrinter(lngPrinterHandle)
'プリンタオブジェクトをクローズ
lngResult = ClosePrinter(lngPrinterHandle)
If lngResult = 0 Then
FinishPrint = False
Else
FinishPrint = True
End If
End Function
このページの先頭に戻る
「ソース（２）」へ進む（SJis2Jis.C、SJis2Jis.H、SJis2Jis.Def）
「LPrint 概要」へ戻る
「役立たない？/プログラム等」へ戻る
 |
darokugawa@master.email.ne.jp |
このページ最終更新日 : October 21, 2003 |
|
ごあいさつ、ご案内
プログラム等