横書きの半角数字を、縦表示にしても，横に「・・・」と並べるには？

質問

リンクさせたデータの中に「123（半角）」があったとして、
これを縦書きで表示させたいときに、
横に「123」と並べることはできますか？

例えて書けば・・・
「これは123円です」のデータをリンクさせて、縦書き表示にしたくて、

　こ
　れ
　は
　123
　円
　で
　す

みたいなイメージ???
１でも２でも折り返されたくなくて、３で折り返されたい感じ???
加えて、必ずしも3文字とも決まっていなくて・・・

具体的に記述して教えていただけると、ありがたいです。
かなりワガママですが、コメントを入れてください・・・
お願いします。

回答No.5

ARC

>実は…ＶＢで具体的に記述していただけると、「！！！」でした。

ちょっと時間が空いたんで、実際に作ってみました。

フォームにピクチャボックス(Picture1),テキストボックス(Text1),ボタン(縦書きボタン)を配置して、以下のようにコーディングしてください。
Picture1のAutoRedrawはTrueに設定しときます。

テキスト中の$H(文字列)を縦中横表示します。
特殊書式の文法チェックとか、ピクチャボックス外にはみ出したときの処理とかは入ってません。
句読点の位置とかもおかしくなるんで、句読点についての処理も入れたほうがいいですね。

一応それなりにコメント入れましたが、不明点とかあったら補足してください。

****************************************************

Option Explicit
Const MARGIN_TOP = 5 * 56.7 '上余白5mm
Const MARGIN_RIGHT = 5 * 56.7　'右余白5mm
Const LETTER_SPACING = 1 * 56.7　'字間1mm
Const LINE_HEIGHT = 10 * 56.7 '行間10mm

Private Sub Form_Load()
　Me.Text1 = "これは$H(123)円です。"
End Sub

Private Sub 縦書きボタン_Click()
　Dim Text As String
　Dim DrawChar As String
　Dim i As Long
　Dim x As Single, y As Single '字を書く座標(ｘは行の中心線)
　Dim StPos As Long, EdPos As Long　'文字列内の位置情報
　Text = Me.Text1

　Me.Picture1.Cls
　Me.Picture1.FontName = "ＭＳ ゴシック"
　x = Me.Picture1.Width - MARGIN_RIGHT - (Me.Picture1.TextWidth("あ") / 2)
　y = MARGIN_TOP
　For i = 1 To Len(Text)
　　DrawChar = ""
　　'文字を一文字ずつ検査する。
　　Select Case Mid$(Text, i, 1)
　　　Case vbCr, vbLf '改行コード
　　　　x = x - LINE_HEIGHT
　　　　y = MARGIN_TOP
　　　　If Mid$(Text, i + 1, 1) = vbLf Then i = i + 1
　　　Case "$" '特殊書式
　　　　'TODO:異常な文法に対する処理を入れること

　　　　Select Case Mid$(Text, i + 1, 1)
　　　　　Case "$"　'"$$"は"$"一文字とみなす
　　　　　　DrawChar = "$"
　　　　　　i = i + 1
　　　　　Case "H"　'$H(文字列)は、文字列を縦中横表示
　　　　　　StPos = i + 3
　　　　　　EdPos = InStr(StPos, Text, ")", vbBinaryCompare)
　　　　　　DrawChar = Mid$(Text, StPos, EdPos - StPos)
　　　　　　i = EdPos
　　　　　Case Else'書式指定が間違ってる
　　　　　　Debug.Assert True
　　　　End Select
　　　Case Else
　　　'通常の文字
　　　　DrawChar = Mid$(Text, i, 1)
　　End Select

　　'文字を描画
　　If DrawChar <> "" Then
　　　With Me.Picture1
　　　　.CurrentX = x - (.TextWidth(DrawChar) / 2)
　　　　.CurrentY = y
　　　　Me.Picture1.Print DrawChar
　　　　y = y + .TextHeight(DrawChar) + LETTER_SPACING
　　　End With
　　End If
　Next i
End Sub

お礼

あまりにもご丁寧で・・・感激→ダウン気味（笑）
ありがとうございました。