タブ式テキストエディタ(13)　印刷機能をつける

リッチテキストに印刷機能を追加する

　リッチテキストの派生クラスであるExpandedTextControlクラスに、印刷機能のコードを追加します。ここでは1ページ分の印刷コードとなります。ただし、Win32APIを使うので、あれやこれやと定義しなければなりません。

' Win32API 定数
Private Const EM_FORMATRANGE As Integer = WM_USER + 57

' 構造体 : Rect
Private Structure Rect
    Dim Left As Integer
    Dim Top As Integer
    Dim Right As Integer
    Dim Bottom As Integer
End Structure

' 構造体 : CharRange
Private Structure CharRange
    Dim cpMin As Integer
    Dim cpMax As Integer
End Structure

' 構造体 : FormatRange
Private Structure FormatRange
    Dim Device As IntPtr
    Dim TargetDevice As IntPtr
    Dim PrintRect As Rect
    Dim PageRect As Rect
    Dim Range As CharRange
End Structure

' PtintPage : 印刷
Public Function PrintPage(ByVal FirstChar As Integer, ByVal LastChar As Integer, _
            ByVal e As Printing.PrintPageEventArgs) As Integer

    '開始位置と終了位置の取得
    Dim cRange As CharRange
    cRange.cpMin = FirstChar
    cRange.cpMax = LastChar

    ' 印刷領域の取得
    Dim rctPrint As Rect
    With rctPrint
        .Left = CInt(e.MarginBounds.Left * dblInch)
        .Top = CInt(e.MarginBounds.Top * dblInch)
        .Right = CInt(e.MarginBounds.Right * dblInch)
        .Bottom = CInt(e.MarginBounds.Bottom * dblInch)
    End With

    ' ページのサイズの取得
    Dim rctPage As Rect
    With rctPage
        .Left = CInt(e.PageBounds.Left * dblInch)
        .Top = CInt(e.PageBounds.Top * dblInch)
        .Right = CInt(e.PageBounds.Right * dblInch)
        .Bottom = CInt(e.PageBounds.Bottom * dblInch)
    End With

    ' FormatRange の取得
    Dim pHdc As IntPtr = e.Graphics.GetHdc()
    Dim fmtRange As FormatRange
    With fmtRange
        .Range = cRange
        .Device = pHdc
        .TargetDevice = pHdc
        .PrintRect = rctPrint
        .PageRect = rctPage
    End With

    ' FormatRange にポインタを移動
    Dim pResult As IntPtr = IntPtr.Zero
    Dim pWParam As IntPtr = IntPtr.Zero
    Dim pLParam As IntPtr = IntPtr.Zero
    pWParam = New IntPtr(1)
    pLParam = Runtime.InteropServices.Marshal.AllocCoTaskMem _
                   (Runtime.InteropServices.Marshal.SizeOf(fmtRange))
    Runtime.InteropServices.Marshal.StructureToPtr(fmtRange, pLParam, False)

    ' 印刷データの送信 
    pResult = SendMessage(Me.Handle, EM_FORMATRANGE, pWParam, pLParam)
    ' メモリの開放
    Runtime.InteropServices.Marshal.FreeCoTaskMem(pLParam)
    ' デバイスの開放
    e.Graphics.ReleaseHdc(pHdc)
    ' 戻り値 : 領域の最後の文字インデックス + 1
    Return pResult.ToInt32()
End Function 

メインフォームの印刷実行コード

　メインフォーム側のコードですが、メニューに合わせて、プレビュー、ページ設定、印刷実行のそれぞれをコーディングします。面倒なのは、ページ設定ダイアログで、ミリーインチ変換をしなければならないこと。このダイアログ、開く時は単位変換しないくせに、閉じる時はキャンセルしても勝手に単位を変換してしまうから大変です。古いバージョンだけなんでしょうか。

*フォームに PrintDocument (Name:PD1) を追加

' 変数の追加
Private m_pageset As Printing.PageSettings        ' ページ設定
Private m_printerset As Printing.PrinterSettings  ' プリンタの設定
Private m_charindex As Integer    ' ページ印刷時の最初の文字インデックス

' 印刷 : プレビュー
Private Sub PrintPreview()
    Dim d As New PrintPreviewDialogEx()
    Try
        If IsNothing(m_printerset) Then m_printerset = New Printing.PrinterSettings()
        If IsNothing(m_pageset) Then m_pageset = New Printing.PageSettings()
        PD1.PrinterSettings = m_printerset
        PD1.DefaultPageSettings = m_pageset
        d.Document = PD1
        d.ShowDialog(Me)
    Catch ex As Exception
        MessageBox.Show(ex.Message, "プレビューエラー", _
                    MessageBoxButtons.OK, MessageBoxIcon.Error)
    End Try
End Sub

' 印刷 : ページ設定
Private Sub PrintPageSet()
    Dim d As New PageSetupDialog()
    Dim m_margins As Printing.Margins
    Try
        If m_printerset Is Nothing Then m_printerset = New Printing.PrinterSettings()
        If m_pageset Is Nothing Then m_pageset = New Printing.PageSettings()

        m_margins = m_pageset.Margins  ' マージンの値を一時格納
        With d
            .PageSettings = m_pageset
            .PrinterSettings = m_printerset
            .Document = PD1
            ' インチからミリへ変換
            .PageSettings.Margins = Printing.PrinterUnitConvert.Convert(m_margins, _
                     Printing.PrinterUnit.ThousandthsOfAnInch, _
                     Printing.PrinterUnit.HundredthsOfAMillimeter)

             If .ShowDialog = DialogResult.OK Then
                m_printerset = .PrinterSettings
                m_pageset = .PageSettings
                m_margins = .PageSettings.Margins
            End If
        End With
    Catch ex As Exception
        MessageBox.Show(ex.Message, "ページ設定エラー", _
                    MessageBoxButtons.OK, MessageBoxIcon.Error)
    Finally
        m_pageset.Margins = m_margins ' マージンをインチの単位に戻す
        If Not IsNothing(d) Then d.Dispose()
    End Try
End Sub

' 印刷 : 印刷実行
Private Sub Print()
    Dim d As New PrintDialog()
    Try
        If IsNothing(m_printerset) Then m_printerset = New Printing.PrinterSettings()
        If IsNothing(m_pageset) Then m_pageset = New Printing.PageSettings()
        PD1.PrinterSettings = m_printerset
        PD1.DefaultPageSettings = m_pageset
        d.Document = PD1
        If d.ShowDialog = DialogResult.OK Then
            PD1.Print()
        End If
    Catch ex As Exception
        MessageBox.Show(ex.Message, "印刷エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Finally
        If Not IsNothing(d) Then d.Dispose()
    End Try
End Sub

' プリントドキュメント : 印刷の開始
Private Sub PD1_BeginPrint(ByVal sender As Object, _
            ByVal e As System.Drawing.Printing.PrintEventArgs) Handles PD1.BeginPrint
    m_charindex = 0
End Sub

' プリントドキュメント : ページの印刷
Private Sub PD1_PrintPage(ByVal sender As Object, _
            ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PD1.PrintPage
    Dim ctrEdit As ExpandedTextControl = DirectCast(TC1.SelectedTab, TextPage).EditBox
    m_charindex = ctrEdit.PrintPage(m_charindex, ctrEdit.TextLength, e)
    e.HasMorePages = (m_charindex < ctrEdit.TextLength)
End Sub

ダイアログの作成

　特に必要というわけではなかったのですが、プレビューダイアログの派生クラスをつくって、前に開いた時と同じ状態で次に開けるようにしてみました。

Public Class PrintPreviewDialogEx
    Inherits System.Windows.Forms.PrintPreviewDialog

    ' 変数
    Private Shared m_point As Point = New Point(100, 100)
    Private Shared m_size As Size = New Size(600, 440)
    Private Shared m_zoom As Double = 1.0
    Private Shared m_cols As Integer = 1
    Private Shared m_rows As Integer = 1

    ' プロパティ
    Public Shared Property StartUpPoint() As Point
        Get
            Return m_point
        End Get
        Set(ByVal Value As Point)
            m_point = Value
        End Set
    End Property

    Public Shared Property StartUpSize() As Size
        Get
            Return m_size
        End Get
        Set(ByVal Value As Size)
            m_size = Value
        End Set
    End Property

    Public Shared Property StartUpZoom() As Double
        Get
            Return m_zoom
        End Get
        Set(ByVal Value As Double)
            m_zoom = Value
        End Set
    End Property

    Public Shared Property StartUpColumns() As Integer
        Get
            Return m_cols
        End Get
        Set(ByVal Value As Integer)
            m_cols = Value
        End Set
    End Property

    Public Shared Property StartUpRows() As Integer
        Get
            Return m_rows
        End Get
        Set(ByVal Value As Integer)
            m_rows = Value
        End Set
    End Property

    ' New : コンストラクタ
    Public Sub New()
        MyBase.New()
    End Sub

    ' Load : ロード
    Protected Overrides Sub OnLoad(ByVal e As System.EventArgs)
        Me.SetBounds(m_point.X, m_point.Y, m_size.Width, m_size.Height)
        With Me.PrintPreviewControl
            .Zoom = m_zoom
            .Columns = m_cols
            .Rows = m_rows
        End With
    End Sub

    ' Closing : アンロード
    Protected Overrides Sub OnClosing(ByVal e As System.ComponentModel.CancelEventArgs)
        m_point = New Point(Me.Left, Me.Top)
        m_size = New Size(Me.Width, Me.Height)
        With Me.PrintPreviewControl
            m_rows = .Rows
            m_cols = .Columns
            m_zoom = .Zoom
        End With
    End Sub
End Class

印刷メニューの実装

　印刷メニューの内容は、これまでつくった関数を呼び出すだけです。

' ファイルメニュー : 印刷プレビュー
Private Sub mnPreview_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
            Handles mnPreview.Click
    PrintPreview()
End Sub

' ファイルメニュー : ページ設定
Private Sub mnPage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
            Handles mnPage.Click
    PrintPageSet()
End Sub

' ファイルメニュー : 印刷
Private Sub mnPrint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
            Handles mnPrint.Click
    Print()
End Sub