FontをセットしてからPrinterオブジェクトに対して、 プロパティの参照やメソッドの実行すると思うように出力されないようです。 (Printer.ScaleWidthやPrinter.Print等) Printerオブジェクトの挙動不審は昔からなくならないですね。 |
更新履歴 2001/08/16 バグ修正 |
' -- 標準モジュール 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 nTwipsPerPixelY 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 " " X = Printer.ScaleWidth / 2 / Printer.TwipsPerPixelX Y = Printer.ScaleHeight / 2 / Printer.TwipsPerPixelY nTwipsPerPixelY = Printer.TwipsPerPixelY #Else hDC = Me.hDC X = Me.ScaleWidth / 2 / Screen.TwipsPerPixelX Y = Me.ScaleHeight / 2 / Screen.TwipsPerPixelY nTwipsPerPixelY = Screen.TwipsPerPixelY #End If For I = 0 To 36 hFont = CreateFont(-(FontHeight * 20 / nTwipsPerPixelY), _ 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 |