VB6でAPI(TextOut)を使って印刷する必要があるのですが、インターネットで調べたらサンプルがあってそれを参考にさせてもらおうと思っています。
ただ、当方としては、印刷位置と印刷文字サイズをmmで指定したく、色々試しているのですがうまくいきません。お分かりになる方どこがおかしいかご教示願えないでしょうか?
サンプルのソースコードを以下に張っておきます。formにCommandボタンを一つ張ってください。
Option Explicit
Dim FX As Integer 'フォントの横サイズ
Dim FY As Integer 'フォントの縦サイズ
Dim cx As Long '表示X座標
Dim cy As Long '表示Y座標
Private Const DEFAULT_CHARSET = 1
Private Const OUT_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const FF_DONTCARE = 0
Private Const LF_FACESIZE = 32
Private Type Size
cx As Long
cy As Long
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private 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
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Private Sub Command1_Click()
Printer.Print ""
'文字印刷位置縦0mm 文字幅6mm、文字高6mmで印刷
FX = 6: FY = 6
cx = 0: cy = 0
PrintText "testてすと1"
'文字印刷位置縦50mm 文字幅6mm、文字高12mmで印刷
FX = 6: FY = 12
cx = 0: cy = 50
PrintText "testてすと2" '縦倍角
'文字印刷位置縦200mm 文字幅12mm、文字高6mmで印刷
FX = 12: FY = 6
cx = 0: cy = 100
PrintText "testてすと3" '横倍角
Printer.EndDoc
End Sub
Sub PrintText(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 PX As Long
Dim PY As Long
hdc = Printer.hdc
'↓(1)ここで文字印刷位置をmmかTwipに変換しているつもりなのですが・・・
PX = Printer.ScaleX(cx, vbMillimeters, vbTwips)
PY = Printer.ScaleY(cy, vbMillimeters, vbTwips)
With LF
.lfEscapement = 0 '文字の回転角度(角度*10)
'↓(2)ここで文字サイズをmmかTwipに変換しているつもりなのですが・・・
.lfHeight = Printer.ScaleY(FY, vbMillimeters, vbTwips) '文字の高さ
.lfWidth = Printer.ScaleX(FX, vbMillimeters, vbTwips) '文字の幅
.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("MS ゴシック", vbFromUnicode)
ByteArrayLimit = UBound(TempByteArray)
For IX = 0 To ByteArrayLimit
.lfFaceName(IX) = TempByteArray(IX)
Next
End With
NewFT = CreateFontIndirect(LF)
OldFT = SelectObject(hdc, NewFT)
TextOut hdc, PX, PY, text, LenB(StrConv(text, vbFromUnicode))
rtn = SelectObject(hdc, OldFT)
rtn = DeleteObject(NewFT)
End Sub
以上よろしくおねがいします。
No.1ベストアンサー
- 回答日時:
もう解決しましたか?
何日か経過しているので、お気づきかもしれませんし、
自分の推測による回答ですので、間違っていたらごめんなさい。
1.TextOut も フォントサイズもpixel指定になっていると思います。
質問のプログラムに下記を追加し、コマンドボタンを1つ追加して実行してみてください。
文字幅は半角文字のサイズのようです。
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 = "MS ゴシック"
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("MS ゴシック", 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
2.あと印刷位置の方ですが、印刷不可能領域の問題があると思います。
たとえば、Pinrter.Line (0,0)-(1000,1000),,b
を実行してみると、紙の左上ではなく、印刷可能領域の左上が(0,0)の位置になると思います。
ふちなし印刷とかですと端からかもしれませんが、私のプリンタでは上左3mmほど内側になりました
プリンタによって違うと思いますので、その辺も考慮に入れないといけないと思います。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
入力規則のリストの文字の大き...
-
テーブル内の文字サイズを変更...
-
alertで表示させる文字サイズは...
-
<pre>タグ内のフォントサイズに...
-
セレクトボックスの幅を指定し...
-
テキストエリアの行文字数の固...
-
文字サイズを変更してもくずれ...
-
VBAでListViewのフォントを変更...
-
共有メモリについて
-
プルダウンメニュー内のフォン...
-
<table></table>内のFONT指定に...
-
CSSです。英数字のみArial書体...
-
英サイト(UTF-8)内での全角文字...
-
outlook 文字を揃えたい。tab...
-
マイクロ(μ)の文字を半角で出...
-
教えてください。
-
フォルダ内の写真を画面幅にあ...
-
EXCEL VBA 印刷プレビューダイ...
-
オプションメニューの中の文字...
-
Dreamweaver のテンプレートで...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
入力規則のリストの文字の大き...
-
テーブル内の文字サイズを変更...
-
ペイント3Dのテキストサイズ変更
-
alertで表示させる文字サイズは...
-
テキストエディタmiの表示文字...
-
<pre>タグ内のフォントサイズに...
-
英サイト(UTF-8)内での全角文字...
-
VBAでListViewのフォントを変更...
-
セレクトボックスの幅を指定し...
-
”ヒラギノ明朝Pro”をWindowsで...
-
alertで、アイコンの変更、又は...
-
CSSです。英数字のみArial書体...
-
パスワード欄の"●"文字を小さく...
-
エクセルで文字が勝手に大きく...
-
コピーライト記号の表示が小さい
-
MoveWindowで位置だけ変更する...
-
奇数のフォントサイズ指定について
-
excelをhtmlに変換した途端、一...
-
<table></table>内のFONT指定に...
-
CListCtrlで行の高さを指定した...
おすすめ情報