プロが教える店舗&オフィスのセキュリティ対策術

こんにちは。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 = "MS Pゴシック"
  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

A 回答 (3件)

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



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

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

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

参考URL:http://www.microsoft.com/japan/support/kb/articl …
    • good
    • 0
この回答へのお礼

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

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

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

お礼日時:2002/01/07 19:01

回転文字の件は確か下記のMLの過去ログで見た記憶があります。


ただ過去ログの番号を忘れました。

そこで紹介されていたコードを下記に載せておきます。
ちなみに私はAPIには疎いので、動作の理屈がわかりませんが。
------------------------------------------------------
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, "MS 明朝")
'作成した論理フォントを描画対象のデバイスコンテキストに割り当てる
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, "MS 明朝")

'作成した論理フォントを描画対象のデバイスコンテキストに割り当てる
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
    • good
    • 0
この回答へのお礼

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

お礼日時:2002/01/08 14:43

今VB4環境で、しかもMSDNが手元にないので、調べる事ができません。



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

やっぱダメ?
    • good
    • 0
この回答へのお礼

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

お礼日時:2002/01/07 18:55

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!