CreateFontで回転させて印刷出来ない

質問

こんにちは。maruru01です。
APIのCreateFont関数を使用して文字列を回転させ、それを印刷しようとしたのですが、うまくいきません。
どうもCreateFontの情報がPrinterオブジェクトに伝わってないようです。
オブジェクトをPrinterの替わりにForm1にするとちゃんと回転して表示されます。
どうすればうまくいくのでしょうか。
よろしくお願いします。

使用環境：Windows2000(SP2)、Visual Basic 6.0(SP5) EnterpriseEdition

Private Sub Command1_Click()

　　Dim hdc As Long
　　Dim FontName As String
　　Dim FontHeight As Long
　　Dim hFont As Long
　　Dim hFontOld As Long
　　Dim tempStr As String

　　Const DEFAULT_CHARSET = 1

　　tempStr = "文字列回転"

　　hdc = Printer.hdc
　　FontName = "ＭＳ Ｐゴシック"
　　FontHeight = 9
　　hFont = CreateFont(-(FontHeight * 20 / Screen.TwipsPerPixelX), 0, 900, 2700, 0, False, False, False, DEFAULT_CHARSET, False, False, False, False, FontName)
　　hFontOld = SelectObject(hdc, hFont)

　　Printer.ScaleMode = vbCentimeters
　　Printer.CurrentX = 2
　　Printer.CurrentY = 2
　　Printer.Print tempStr

　　DeleteObject SelectObject(hdc, hFontOld)

End Sub

回答No.2

todo36 · ベストアンサー

＞どうもCreateFontの情報がPrinterオブジェクトに伝わってないようです。

VBの制限事項です。→参考URL

＞どうすればうまくいくのでしょうか。

Printer.Printではなく、TextOutを使いましょう。

参考URL：

http://www.microsoft.com/japan/support/kb/articles/J045/7/77.asp

お礼

回答ありがとうございます。
実はTextOutも下のように使ったんですが、やはりうまくいきませんでした。

Result = TextOut(hdc, OffsetX, OffsetY, tempStr, LenB(StrConv(tempStr, vbFromUnicode)))

どこが悪いのでしょうか。ちょっと八方塞がりの状態です。
とりあえず、参考URLありがとうございました。

回答No.3

prome

回転文字の件は確か下記のＭＬの過去ログで見た記憶があります。
ただ過去ログの番号を忘れました。

そこで紹介されていたコードを下記に載せておきます。
ちなみに私はＡＰＩには疎いので、動作の理屈がわかりませんが。
------------------------------------------------------
Option Explicit
Private 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
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 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 Sub Form_Paint()
Dim Responce
Dim FontHandle As Long
Dim OldFontHandle As Long
Dim ResultCode As Long
Dim TargetDcHandle As Long
Dim strMsg As String

Responce = MsgBox("文字列を印刷しますか", 4, "")

'描画対象のデバイスコンテキストをフォームに設定
TargetDcHandle = Form1.hDc
'描画文字列の設定
strMsg = "文字列"

'論理フォントの作成
FontHandle = CreateFont(48, 24, 400, 0, 0, 0, 0, _
0, 1, 0, 0, 0, 0, "ＭＳ 明朝")
'作成した論理フォントを描画対象のデバイスコンテキストに割り当てる
OldFontHandle = SelectObject(TargetDcHandle, FontHandle)
'文字列を描画する
ResultCode = TextOut(TargetDcHandle, 10, 100, strMsg, _
LenB(StrConv(strMsg, vbFromUnicode)))

'元のフォントオブジェクトに戻す
ResultCode = SelectObject(TargetDcHandle, OldFontHandle)
'作成した論理フォントを削除する
ResultCode = DeleteObject(FontHandle)

If Responce = vbYes Then
'描画対象のデバイスコンテキストをプリンタに設定
TargetDcHandle = Printer.hDc
'描画文字列の設定
strMsg = "文字列"

Printer.Print ""

'論理フォントの作成
FontHandle = CreateFont(48, 24, 300, 0, 0, 0, 0, _
0, 1, 0, 0, 0, 0, "ＭＳ 明朝")

'作成した論理フォントを描画対象のデバイスコンテキストに割り当てる
OldFontHandle = SelectObject(TargetDcHandle, FontHandle)
'文字列を印刷する
ResultCode = TextOut(TargetDcHandle, 10, 100, strMsg, _
LenB(StrConv(strMsg, vbFromUnicode)))
Printer.EndDoc

'元のフォントオブジェクトに戻す
ResultCode = SelectObject(TargetDcHandle, OldFontHandle)
'作成した論理フォントを削除する
ResultCode = DeleteObject(FontHandle)
End If
End Sub

参考URL：

http://dev.sfdata.ne.jp/VB/search.html

お礼

回答ありがとうございます。
実は書いていただいた内容は、私も見たことがあります。
結局、PrinterのLineメソッドを、CreateFontの後に使用していたのが原因のようで、先にLineメソッドで線（四角）を書いて、その後でCreateFontでフォントを作成して、TextOutを使用すると、一応文字列は回転しました。
どうもありがとうございました。

回答No.1

TAGOSAKU7

今ＶＢ４環境で、しかもＭＳＤＮが手元にないので、調べる事ができません。

ですので回避方法として、非表示のピクチャボックスに描画して、それをプリントアウトではだめですか？
フォームもピクチャボックスも内部では一緒だから、手っ取り早い回避方法だと思いますが。。。

やっぱダメ？

お礼

回答ありがとうございます。
＞非表示のピクチャボックスに描画して、それをプリントアウトではだめですか？
PrintFormメソッドのことですよね。
実際には絵も一緒に印刷するので、PrintFormでは画質が問題で使えないんです。
なんにしろ、早い回答ありがとうございました。