VB6 APIを使った文字印刷について

質問

• VB6でAPI(TextOut)を使った文字印刷の方法を学びましょう。
• 印刷位置と文字サイズの指定方法について試行錯誤しています。
• サンプルコードを使用していますが、うまくいかない部分があります。

回答No.1

taisuke555 · ベストアンサー

もう解決しましたか？
何日か経過しているので、お気づきかもしれませんし、
自分の推測による回答ですので、間違っていたらごめんなさい。

１．TextOut も フォントサイズもpixel指定になっていると思います。

質問のプログラムに下記を追加し、コマンドボタンを１つ追加して実行してみてください。
文字幅は半角文字のサイズのようです。

Private Sub Command2_Click()
　　FX = 6　　　　　'通常のフォント
　　FontTest1 "t"

　　FX = 0: FY = 6　'幅を0にすると高さに合わせて調整する
　　FontTest2 "t"

　　FX = 6: FY = 6　'半角の幅？
　　FontTest2 "t"
End Sub

Private Sub FontTest1(text As String)
　　Dim rtn As Long
　　Dim hdc As Long
　　Dim sz　As Size

　　'通常のサイズ
　　Printer.FontName = "ＭＳ ゴシック"
　　Printer.FontSize = CLng(Printer.ScaleX(FX, vbMillimeters, vbPoints))

　　hdc = Printer.hdc
　　rtn = GetTextExtentPoint32(hdc, text, LenB(StrConv(text, vbFromUnicode)), sz)
　　MsgBox "[" & text & "] (" & CLng(Printer.ScaleX(FX, vbMillimeters, vbPoints)) & _
　　　　　　　　") = (" & sz.cx & "," & sz.cy & ")"
End Sub

Sub FontTest2(text As String)
　　Dim LF As LOGFONT
　　Dim IX As Integer

　　Dim TempByteArray() As Byte
　　Dim ByteArrayLimit As Long

　　Dim OldFT As Long
　　Dim NewFT As Long
　　Dim rtn As Long

　　Dim hdc As Long

　　Dim sz As Size

　　hdc = Printer.hdc

　　With LF
　　　　.lfEscapement = 0 '文字の回転角度(角度*10)

　　　　'↓(2)ここで文字サイズをmmかTwipに変換しているつもりなのですが・・・
　　　　.lfHeight = Printer.ScaleY(FY, vbMillimeters, vbPixels) '文字の高さ
　　　　.lfWidth = Printer.ScaleX(FX, vbMillimeters, vbPixels) '文字の幅

　　　　.lfWeight = 400 '文字の太さ
　　　　.lfItalic = False '斜体
　　　　.lfUnderline = False '下線
　　　　.lfStrikeOut = False '取り消し線

　　　　.lfCharSet = DEFAULT_CHARSET
　　　　.lfOutPrecision = OUT_DEFAULT_PRECIS
　　　　.lfClipPrecision = OUT_DEFAULT_PRECIS
　　　　.lfQuality = DEFAULT_QUALITY
　　　　.lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE

　　　　TempByteArray = StrConv("ＭＳ ゴシック", vbFromUnicode)
　　　　ByteArrayLimit = UBound(TempByteArray)

　　　　For IX = 0 To ByteArrayLimit
　　　　　　.lfFaceName(IX) = TempByteArray(IX)
　　　　Next
　　End With

　　NewFT = CreateFontIndirect(LF)
　　OldFT = SelectObject(hdc, NewFT)

　　rtn = GetTextExtentPoint32(hdc, text, LenB(StrConv(text, vbFromUnicode)), sz)
　　MsgBox "[" & text & "] (幅,高さ) = (" & LF.lfWidth & "," & LF.lfHeight & ")→(" & sz.cx & "," & sz.cy & ")"

　　rtn = SelectObject(hdc, OldFT)
　　rtn = DeleteObject(NewFT)
End Sub

２．あと印刷位置の方ですが、印刷不可能領域の問題があると思います。
たとえば、Pinrter.Line (0,0)-(1000,1000),,b
を実行してみると、紙の左上ではなく、印刷可能領域の左上が(0,0)の位置になると思います。
ふちなし印刷とかですと端からかもしれませんが、私のプリンタでは上左3mmほど内側になりました
プリンタによって違うと思いますので、その辺も考慮に入れないといけないと思います。

お礼

わかりやすい回答ありがとうございました。助かります。

早速試してみます。