List 7-143　FormPrintPreviewフォームの修正したDrawBoxプロシージャ（修正個所は赤色で示した）

---

  1： Private Function DrawBox(ByRef objDoc As Object, _
   　                          ByVal Text As String, _
   　                          ByVal ColumnWidth As Long, _
   　                          ByVal Alignment As Long, _
   　                          ByVal drawFlag As Boolean) As Long
  2：     ' 指定された幅に収まるように折り返して，テキストを描画する
  3：     ' 【引数】
  4：     '   objDoc = 描画対象となるオブジェクト
  5：     '              ピクチャボックスかPrinterオブジェクトのいずれか
  6：     '   Text = 描画する文字列
  7：     '   ColumnWidth = 描画幅
  8：     '   Alignment = 文字揃え
  9：     '                   dbgGeneral（標準。文字ならば左揃え，数値ならば右揃え）
 10：     '                   dbgLeft（左揃え）
 11：     '                   dbgRight（右揃え）
 12：     '                   dbgCenter（中央揃え）
 13：     '               のいずれか
 14：     '   drawFlag = 実際に描画するかどうかのフラグ。
 15：     '              描画するときはTrue，
 16：     '              描画せずカレント位置を変更するだけのときにはFalse
 17：     ' 【戻り値】
 18：     '   描画したテキストの高さを返す
 19：     
 20：     Const OffsetX = 56 ' 表示オフセットはここでは約1mmとする
 21：     Const OffsetY = 56 ' 表示オフセットはここでは約1mmとする
 22：     
 23：     Dim txHeight As Long
 24：     Dim i As Long
 25：     Dim putText As String
 26：     Dim X As Long, Y As Long
 27：     Dim orgX As Long, orgY As Long
 28：     
 29：     i = 1
 30：     txHeight = 0
 31：     orgX = objDoc.CurrentX
 32：     orgY = objDoc.CurrentY
 33：     X = orgX + OffsetX
 34：     objDoc.CurrentX = X
 35：     
 36：     ColumnWidth = ColumnWidth - OffsetX
 37：     Y = orgY + OffsetY
 38：     objDoc.CurrentY = Y
 39：     
 40：     If ColumnWidth <= 0 Then
 41：         ' 幅が0の場合には，表示しない
 42：         DrawBox = 0
 43：         Exit Function
 44：     End If
 45：         
 46：         
 47：     ' 揃えがデフォルトのとき
 48：     If Alignment = dbgGeneral Then
 49：         ' デフォルト
 50：         ' テキストならば左揃え，数値ならば右揃え
 51：         If IsNumeric(Text) Then
 52：             ' 数値なので右揃え
 53：             Alignment = dbgRight
 54：         Else
 55：             ' 文字なので左揃え
 56：             Alignment = dbgLeft
 57：         End If
 58：     End If
 59：     
 60：     ' 横幅からはみ出さない部分だけ折り返して表示するループ処理
 61：     Do
 62：         ' 横幅からはみ出さない部分だけをputText変数に格納する
 63：         putText = ""
 64：         Do While (objDoc.TextWidth(putText) < ColumnWidth) And (i <= Len(Text))
 65：             If Mid(Text, i, 2) = vbCrLf Then
 66：                 ' CrLfのときにはそれを飛ばして改行する
 67：                 i = i + 2
 68：                 Exit Do
 69：             End If
 70：             putText = putText & Mid(Text, i, 1)
 71：             i = i + 1
 72：         Loop
 73：         
 74：         If (objDoc.TextWidth(putText) > ColumnWidth)AND (Len(putText) > 1) Then
 75：             putText = Left(putText, Len(putText) - 1)
 76：             i = i - 1
 77：         End If
 78：         
 79：         ' 揃えごとの処理
 80：         Select Case Alignment
 81：             Case dbgRight
 82：                 ' 右揃え
 83：                 objDoc.CurrentX = X + ColumnWidth - objDoc.TextWidth(putText)
 84：             Case dbgCenter
 85：                 ' 中央揃え
 86：                 objDoc.CurrentX = X + (ColumnWidth - objDoc.TextWidth(putText)) / 2
 87：             Case Else
 88：                 ' 左揃え
 89：                 objDoc.CurrentX = X
 90：         End Select
 91：         ' 文字を描画する
 92：         myPrint objDoc, putText, drawFlag
 93：         objDoc.CurrentX = X
 94：         txHeight = txHeight + objDoc.TextHeight(putText)
 95：     Loop While i <= Len(Text)
 96：     
 97：     objDoc.CurrentX = orgX
 98：     objDoc.CurrentY = orgY
 99：     
100：     DrawBox = txHeight + OffsetY * 2
101： End Function