VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[管理用]
| 投稿日 | ： 2005/12/28(Wed) 00:32 |
| 投稿者 | ： たすく |
| ＵＲＬ | ： |
| タイトル | ： Re^4: VB6での回転文字列の印刷 |
花ちゃん 様
ご回答有難う御座います。
> あと、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
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）