OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

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

  • すぐに回答を!
  • 質問No.194114
  • 閲覧数1042
  • ありがとう数4
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 91% (41/45)

こんにちは。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
通報する
  • 回答数3
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.2
レベル13

ベストアンサー率 59% (729/1235)

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

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

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

Printer.Printではなく、TextOutを使いましょう。
お礼コメント
maruru01

お礼率 91% (41/45)

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

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

どこが悪いのでしょうか。ちょっと八方塞がりの状態です。
とりあえず、参考URLありがとうございました。
投稿日時 - 2002-01-07 19:01:35
-PR-
-PR-

その他の回答 (全2件)

  • 回答No.1
レベル12

ベストアンサー率 65% (276/422)

今VB4環境で、しかもMSDNが手元にないので、調べる事ができません。 ですので回避方法として、非表示のピクチャボックスに描画して、それをプリントアウトではだめですか? フォームもピクチャボックスも内部では一緒だから、手っ取り早い回避方法だと思いますが。。。 やっぱダメ? ...続きを読む
今VB4環境で、しかもMSDNが手元にないので、調べる事ができません。

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

やっぱダメ?
お礼コメント
maruru01

お礼率 91% (41/45)

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


  • 回答No.3
レベル10

ベストアンサー率 32% (64/196)

回転文字の件は確か下記のMLの過去ログで見た記憶があります。 ただ過去ログの番号を忘れました。 そこで紹介されていたコードを下記に載せておきます。 ちなみに私はAPIには疎いので、動作の理屈がわかりませんが。 ------------------------------------------------------ Option Explicit Private Declare Fu ...続きを読む
回転文字の件は確か下記の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
お礼コメント
maruru01

お礼率 91% (41/45)

回答ありがとうございます。
実は書いていただいた内容は、私も見たことがあります。
結局、PrinterのLineメソッドを、CreateFontの後に使用していたのが原因のようで、先にLineメソッドで線(四角)を書いて、その後でCreateFontでフォントを作成して、TextOutを使用すると、一応文字列は回転しました。
どうもありがとうございました。
投稿日時 - 2002-01-08 14:43:38
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ