お世話になっております。タスクと申します。

現在VB6 SP6にてアプリケーションを開発しております。
その機能の中に、グラフの表示/印刷があり、Lineメソッドなどを利用して
自前描画を行っております。
グラフの中にY軸のタイトルは反時計回り90度回転させて描画する部分があり、
コレについてはWEBで調べてCreateFont等を利用することで実現できると分かり
Pictureについては期待通りの描画が行われます。
ですが、印刷すると回転せずに描画されてしまいます。
なお、ハードコピーによる印字は許容されておりません。

処理としては以下の様に行っております。

※ rfDevにPictureかPrinterがわたってきます。
　尚、切り出して整形しただけなので、サイズ計算などの処理は省いております。

Public Sub drawYTitle(ByRef rfDev As Object)

    Dim hLastObjct As Long
    Dim hFont As Long

    hFont = CreateFont(18, 0, 900, 900, 0, False, False, False, SHIFTJIS_CHARSET, _
                OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, _
                DEFAULT_PITCH Or FF_DONTCARE, "ＭＳ ゴシック")
    hLastObjct = SelectObject(rfDev.hdc, hFont)

    Call TextOut(rfDev.hdc, 0, 0, vbTwips, vbPixels), _
                g_stGraphEnv.strYTitle, LenB(StrConv(g_stGraphEnv.strYTitle,
vbFromUnicode)))


    Call SelectObject(rfDev.hdc, hLastObjct)
    Call DeleteObject(hFont)

End Sub


尚、色々なプリンタにて試してみましたが、どれも旨くいきませんでした。
何方か原因が分かる方、アドバイスを宜しく御願いいたします。

投稿されたコードが印刷のコードすべてなら印刷はできないかと思います。
（試してはいませんが、コードを追加しなければならないので面倒なので）
APIを使っての印刷時の注意事項等は考慮されていますか？
Picture と Printer を切り替えただけでは印刷できないと思いますよ。
hhttp://www.bcap.co.jp/hanafusa/logbbs1/wforum.cgi?mode=allread&no=2716&page=180#2716

それに 下記のコードは動きますか？
Call TextOut(rfDev.hdc, 0, 0, vbTwips, vbPixels), _
g_stGraphEnv.strYTitle, LenB(StrConv(g_stGraphEnv.strYTitle,
vbFromUnicode)))

花ちゃん 様

ご回答有難う御座います。

添付したコードは余計な部分をカットしたもののためすべてではありませんが、
基本的には事前にPrinterに用紙方向、サイズ、カラーを設定しておいて、
LineやPrintメソッドにて色々描画した後に、先の関数を呼び出して、
Printer.EndDocを呼ぶという流れです。
尚、TextOut関数部分については整形ミスでした。申し訳御座いません。


> Picture と Printer を切り替えただけでは印刷できないと思いますよ。

同じように扱うことが出来ないのでしょうか？
なにか特別な設定をしないと描画できないのでしょうか？
(現状それなりに同じ動作をしているので気づきませんでした)


ご紹介いただいたURLを辿って行き、MSのサイトにて
「API を併用した出力が無効になる現象について」の項を拝見いたしました。
すべてAPIを使用しないとダメなのですね。

APIを使って頑張ってみます。
有難う御座いました。

あと、hFont = CreateFont(18, の 第一引数の18はどのように計算していますか？
表示と印字では大きく変わるはずですが！
私の場合はどちらも マイナス側の数値になったかと。

どちらにしても確認できないようなコードではハッキリした事は解りません。

花ちゃん 様

ご回答有難う御座います。

> あと、hFont = CreateFont(18, の 第一引数の18はどのように計算していますか？
> 表示と印字では大きく変わるはずですが！
> 私の場合はどちらも マイナス側の数値になったかと。
>
> どちらにしても確認できないようなコードではハッキリした事は解りません。

実際の実装に近いサンプルを作りました。
以下のような感じです。

------- Module ---------------------------------------------
Public Const CLIP_DEFAULT_PRECIS As Long = 0
Public Const DEFAULT_QUALITY As Long = 0
Public Const DEFAULT_PITCH As Long = 0
Public Const FF_ROMAN As Long = (1 * 16)

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 A
s Long, ByVal x As
Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Public Const LOGPIXELSY = 90

Public Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumera
tor As
Long, ByVal nDenominator As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex
As Long)
As Long

------- Form -----------------------------------------------

Private Const SBL_NUM_BAESWIDTH As Long = 3135
Private Const SBL_NUM_BAESHIGHT As Long = 1815

Private Sub Command1_Click()

    Call drawYTitle(Picture1)

End Sub

Public Sub drawYTitle(ByRef rfDev As Object)

    Dim dScaleX As Double
    Dim dScaleY As Double
    Dim hLastObjct As Long
    Dim hFont As Long

    dScaleX = rfDev.Width / SBL_NUM_BAESWIDTH
    dScaleY = rfDev.Height / SBL_NUM_BAESHIGHT

    rfDev.ScaleWidth = SBL_NUM_BAESWIDTH
    rfDev.ScaleHeight = SBL_NUM_BAESHIGHT

    rfDev.Line (0, 0)-(SBL_NUM_BAESWIDTH, SBL_NUM_BAESHIGHT), RGB(255, 255, 255), BF

    Dim nHeight As Long
    nHeight = -MulDiv(8 * dScaleY, GetDeviceCaps(hdc, LOGPIXELSY), 72)
    hFont = CreateFont(nHeight, 0, 900, 900, 0, False, False, False, SHIFTJIS_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, VARIABLE_PITCH Or FF_ROMAN, "
ＭＳ
ゴシック")
    hLastObjct = SelectObject(rfDev.hdc, hFont)
    
    Call TextOut(rfDev.hdc, _
            rfDev.ScaleX((SBL_NUM_BAESWIDTH / 2) * dScaleX, vbTwips, vbPixels), _
            rfDev.ScaleY((SBL_NUM_BAESHIGHT / 2) * dScaleY, vbTwips, vbPixels), _
            "あいうabc", LenB(StrConv("あいうabc", vbFromUnicode)))

    Call SelectObject(rfDev.hdc, hLastObjct)
    Call DeleteObject(hFont)

End Sub



Private Sub Command2_Click()

    Set Printer = Printers(0)
    Printer.Orientation = vbPRORLandscape
    Printer.ColorMode = vbPRCMMonochrome
    Printer.PaperSize = vbPRPSA4
    Call drawYTitle(Printer)
    Printer.EndDoc

End Sub

KB 412851 には、下記のような記述がありますね。
hhttp://support.microsoft.com/kb/412851/ja

　『Printer オブジェクトがデバイス コンテキストに設定された値を無視するため、
　　API 関数を使用して行った設定が印刷結果に反映されません。』

　『回避するためには、Printer オブジェクトを使用せず、全て API で印刷の処理を
　　行っていただきます。』

という事で、Printer オブジェクトは使用禁止の方向で書きなおしてみましょう。



ちなみに、VB5 用の KB 412851 にも、同様の解説があったりします。
hhttp://support.microsoft.com/kb/411269/ja

　『API を併用した出力が無効になる現象について』

　『現状で確認されている回避策は Printer オブジェクトを一切使用せず
　　全て API で印刷の処理を行う方法のみです。』

　『これは CreateDC や DeleteDC も全て自分で処理することを意味しています。』

> という事で、Printer オブジェクトは使用禁止の方向で書きなおしてみましょう。

VBのPrinterオブジェクトは、API関数と絡めたりする際には何かと
不便を感じることが多いので、そういうときにはPrinterオブジェクト
を使わずに済ますのが一般的です。

それでもPrinterオブジェクトを使いたいのであれば、例えば、
hhttp://www.koalanet.ne.jp/~akiya/vbtaste/vbp/RotFont.lzh
のようにして、内部保持形式がメタファイルであるPictureに
して、それをPaintPictureする、というような方法が使えます。

K.J.K.様

ご回答有難う御座います。

確かにPictureに描画しPrinterに出力するという方法は考えましたが、
余りVBに詳しくないもので、大きなピクチャーが作れず諦めてしまいました。
お教えいただいたサンプルは参考にさせていただきます。

取り合えず、工数の兼ね合いからレイアウトなどを変えて頂く方向で決着いたしました。

有難う御座いました。

魔界の仮面弁士 様

ご回答真に有難う御座います。

やはりすべて自前で行うほか無い様ですね。
取り合えず、工数の兼ね合いからレイアウトなどを変えて頂く方向で決着いたしました。

有難う御座いました。

> 実際の実装に近いサンプルを作りました。
このコードでは動かないでしょう。
他人にコードを検証して貰おうと思うなら実際にコピペしたら動くようなコードを投稿
しないとどなたも試してくれませんよ。
前回も書きましたが印刷と表示では色々設定が違います（今回のような場合）

このコードをペーストして貴方が実際に動くかどうか試して見てください。
肝心な定数の設定の部分が書いていなかったり、独自の定数を使っておられるようですが
その根拠が解らないし。
又、コードを投稿する場合は図表モードで投稿してください。

>nHeight = -MulDiv(8 * dScaleY, GetDeviceCaps(hdc, LOGPIXELSY), 72)
上記の 変数 hdc はどうなっているのですか？

私のサンプル(No.233)のやり方とまったく違うので動かして検証してみないと私には
貴方のサンプルが理解できませんが、なんせまともに動かないので試す気にもなれません。

花ちゃん 様

ご回答有難う御座います。

申し訳御座いません。
確かに上記サンプルは、貼り付けただけでは動かず、Formとボタンを追加する必要があります。
本当はサンプルごと乗せたかったのですが、良い方法が分からずこんな半端なものになってしまいまし
た。
色々と申し訳御座いません。

取り合えず、工数の兼ね合いからレイアウトなどを変えて頂く方向で決着いたしました。

色々お付き合い頂き、有難う御座いました。

表示の設定が間違っていないなら、下記の1行を追加してみて下さい。

> Private Sub Command2_Click()
>
>     Set Printer = Printers(0)
>     Printer.Orientation = vbPRORLandscape
>     Printer.ColorMode = vbPRCMMonochrome
>     Printer.PaperSize = vbPRPSA4

Printer.Print ""　　　'この部分を追加

>     Call drawYTitle(Printer)
>     Printer.EndDoc
>
> End Sub