やはりPrinterオブジェクトは少々動きが不明ですね。
サンプルを作ってみました。
サンプル作って気づいたのは、Fontをセットしてから
Printerオブジェクトに対して、プロパティの参照や
メソッドの実行すると思うようにいきませんね。
(Printer.ScaleWidthやPrinter.Print等)
僕の作ったサンプルでの回避方法は出力座標はあらかじめ
別の変数に格納しておく、出力はTextOutを使用。
ほかにも注意しなければいけないことがあるかもしれませんが、
いかのサンプルを参考に動くパターンを見つけなければ
いけないかもしれません。
' -- 標準モジュール
Option Explicit
Public Const DEFAULT_CHARSET = 1
Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" ( _
ByVal H As Long, _
ByVal W As Long, _
ByVal E As Long, _
ByVal O As Long, _
ByVal W As Long, _
ByVal I As Long, _
ByVal u As Long, _
ByVal S As Long, _
ByVal C As Long, _
ByVal OP As Long, _
ByVal CP As Long, _
ByVal Q As Long, _
ByVal PAF As Long, _
ByVal F As String _
) As Long
Public Declare Function SelectObject Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal hObject As Long _
) As Long
Public Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long _
) As Long
Public 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
' -- フォーム
Option Explicit
#Const PRN = 1
Private Sub Command1_Click()
Dim hFont As Long
Dim hFontOld As Long
Dim hDC As Long
Dim I As Long
Dim X As Long
Dim Y As Long
Dim FontHeight As Long
Dim FontName As String
FontHeight = 32
FontName = Me.Font.Name
#If PRN = 1 Then
hDC = Printer.hDC
Printer.Print " "
#Else
hDC = Me.hDC
#End If
#If PRN = 1 Then
X = Printer.ScaleWidth / 2
Y = Printer.ScaleHeight / 2
#Else
X = Me.ScaleWidth / 2
Y = Me.ScaleHeight / 2
#End If
For I = 0 To 36
hFont = CreateFont(-(FontHeight * 20 / Printer.TwipsPerPixelY), 0, I * 100, I * 100, 0, False, False, False, DEFAULT_CHARSET, False, False, False, False, "@" & FontName)
hFontOld = SelectObject(hDC, hFont)
Call TextOut(hDC, X, Y, "あいうえお", 10)
Call SelectObject(hDC, hFontOld)
Call DeleteObject(hFont)
Next
#If PRN = 1 Then
Call Printer.EndDoc
#End If
End Sub
|