VB.NETで開発したアプリで印刷処理を行うと、黒で塗りつぶされてしまいます。きれいにイメージを印刷する方法はないでしょうか。

Question

実現したいこと

VB.NET2019で開発したアプリをWindows10で動作させ、印刷処理を行うと、黒で塗りつぶされてしまう（真っ黒なイメージが印刷される）
処理の途中でメッセージボックスを表示させるときれいに印刷できるのだが、メッセージボックスを表示させずに印刷できるようにしたい。

前提

VisualBasic.NET2019（.NET Framework4.8）、Windows10環境で動作するように64bitアプリケーションを開発しています。

発生している問題・エラーメッセージ

開発したアプリケーションで印刷処理を行うと次の動きをします。
・メッセージボックスを処理途中で表示させると、きれいに印刷できる
・メッセージボックスをなくすと、黒で塗りつぶされたようなイメージが印刷される
メッセージボックスなしできれいに印刷したいです。
動きを見るに、処理が並列で動いているのではと思い、タスク化することで改善を試みたのですが、依然真っ黒なイメージが印刷されており、解決に至っておりません。
どなたか、良い解決案をご存じないでしょうか・・・。

該当のソースコード

Module Com_ParkFunc
    Public memoryImage    As Bitmap
    Public PrintDocument1 As System.Drawing.Printing.PrintDocument


    Public Sub PubS_PrintParkTicket(ByVal strSrvNum As String)
        Dim SecName As String
        Dim KeyName As String

        '' 各項目の設定
        With FrmTicket2
            .Label5.Text = "てすと"
            .lblDate.Text = VB6.Format(Now, "yyyy年mm月dd日 hh時nn分")
            .lblSrvNo.Text = "12345678901234"
        End With

        Dim task As Threading.Tasks.Task = New Threading.Tasks.Task(
            Sub()
                Task_image()
            End Sub
            )
        task.Start()
   End Sub


    Private Const SRCCOPY As Integer = &HCC0020
    'フォームのイメージを取得する
    Public Function CaptureControl(ByVal ctrl As Control) As Bitmap
        Dim g As Graphics = ctrl.CreateGraphics()
        Dim img As New Bitmap(ctrl.ClientRectangle.Width,
            ctrl.ClientRectangle.Height, g)
        Dim memg As Graphics = Graphics.FromImage(img)
        Dim dc1 As IntPtr = g.GetHdc()
        Dim dc2 As IntPtr = memg.GetHdc()
        BitBlt(dc2, 0, 0, img.Width, img.Height, dc1, 0, 0, SRCCOPY)
        g.ReleaseHdc(dc1)
        memg.ReleaseHdc(dc2)
        memg.Dispose()
        g.Dispose()
        Return img
    End Function


    'PrintDocument1のPrintPageイベントハンドラ
    Public Sub PrintDocument1_PrintPage(ByVal sender As Object,
            ByVal e As System.Drawing.Printing.PrintPageEventArgs)
        Dim img As Bitmap = memoryImage
        e.Graphics.DrawImage(img, 0, 0, 215, 325)
        e.HasMorePages = False
        img.Dispose()
    End Sub



    Public Sub Task_image()
    
        Dim memoryImageWK As Bitmap
        memoryImage = memoryImageWK
        
        Try
           'MsgBox("1.1")
           If task1(memoryImage).Equals(False) Then
               Exit Sub
           End If
           If task2(memoryImage).Equals(False) Then
               Exit Sub
           End If
           If task3(memoryImage).Equals(False) Then
               Exit Sub
           End If
        Catch sysEx As System.Exception
           Throw sysEx
        Finally
           memoryImage = Nothing
           PrintDocument1 = Nothing
           'MsgBox("2.3")
        End Try
    End Sub
    
    Private Function task1(ByRef memoryImage As Bitmap) As Boolean
        Try
            memoryImage = CaptureControl(FrmTicket2)
            return true
        Catch sysEx As System.Exception
            return false
        End Try
    End Function
    
    Private Function task2(ByRef memoryImage As Bitmap) As Boolean
        Dim PrintDocumentWK As New System.Drawing.Printing.PrintDocument
        PrintDocument1 = PrintDocumentWK
        Try
           'MsgBox("2.1")
            AddHandler PrintDocument1.PrintPage, AddressOf PrintDocument1_PrintPage
            return true
        Catch sysEx As System.Exception
            return false
        End Try
    End Function

    Private Function task3(ByRef memoryImage As Bitmap) As Boolean
        Try
           'MsgBox("2.2")
            PrintDocument1.Print()
            return true
        Catch sysEx As System.Exception
            return false
        End Try
    End Function
    
End Module

試したこと

フォームをキャプチャする処理と印刷する処理を分け、タスクにすることで記載した順に処理が動くのではと試みました。

補足情報（FW/ツールのバージョンなど）

VisualStudio2019（Professional Edition）を使用して開発しています。

きれいに印刷できるパターンのソース

Module Com_ParkFunc
Public memoryImage As Bitmap
Public Sub PubS_PrintParkTicket(ByVal strSrvNum As String)
Dim SecName As String
Dim KeyName As String

    ''　駐車サービス票の印刷処理
    FrmTicket2.Show() '★★★★★★★★★ ←フォームは見えないようにしたい
    '' 各項目の設定
    With FrmTicket2
        .Label5.Text = "てすと"
        .lblDate.Text = VB6.Format(Now, "yyyy年mm月dd日 hh時nn分")
        .lblSrvNo.Text = "12345678901234"
    End With
    MsgBox("print")'★★★★★★★★★ ←FrmTicket2.Refresh()でも印刷できました！！
    memoryImage = CaptureControl(FrmTicket2)
    Dim PrintDocument1 As New System.Drawing.Printing.PrintDocument

    AddHandler PrintDocument1.PrintPage,
        AddressOf PrintDocument1_PrintPage

    PrintDocument1.Print()
    memoryImage.Dispose()

    '' フォームのアンロード
    FrmTicket2.Hide()
End Sub

<System.Runtime.InteropServices.DllImport("gdi32.dll")>
Public Function BitBlt(ByVal hdcDest As IntPtr,
ByVal nXDest As Integer, ByVal nYDest As Integer,
ByVal nWidth As Integer, ByVal nHeight As Integer,
ByVal hdcSrc As IntPtr,
ByVal nXSrc As Integer, ByVal nYSrc As Integer,
ByVal dwRop As Integer) As Boolean
End Function

Private Const SRCCOPY As Integer = &HCC0020
'フォームのイメージを取得する
Public Function CaptureControl(ByVal ctrl As Control) As Bitmap
    Dim g As Graphics = ctrl.CreateGraphics()
    Dim img As New Bitmap(ctrl.ClientRectangle.Width,
        ctrl.ClientRectangle.Height, g)
    Dim memg As Graphics = Graphics.FromImage(img)
    Dim dc1 As IntPtr = g.GetHdc()
    Dim dc2 As IntPtr = memg.GetHdc()
    BitBlt(dc2, 0, 0, img.Width, img.Height, dc1, 0, 0, SRCCOPY)
    g.ReleaseHdc(dc1)
    memg.ReleaseHdc(dc2)
    memg.Dispose()
    g.Dispose()
    Return img
End Function

'PrintDocument1のPrintPageイベントハンドラ
Public Sub PrintDocument1_PrintPage(ByVal sender As Object,
        ByVal e As System.Drawing.Printing.PrintPageEventArgs)
    e.Graphics.DrawImage(memoryImage, 0, 0, 215, 325)
End Sub

End Module

Comments

[YAmaGNZ]

FrmTicket2がどういったものか分かりませんが、FrmTicket2がリフレッシュされていないとかじゃないんですかね？

[sazi]

> メッセージボックスを処理途中で表示させると、きれいに印刷できる
どのメッセージボックスですか？

[Marino_Y]

YAmaGNZ 様
FrmTicket2は、任意で値を埋め込むフォームで、作ったイメージ（画面）をキャプチャして印刷しようとしております。
たしかに、描画後にリフレッシュしていないですね・・・！

sazi 様
担当者に詳細を確認したところ、FrmTicket2描画後にメッセージボックスを入れると、タスク化しなくてもきれいに印刷できるとのことでした。

数刻後に、追加情報として、きれいに印刷できたパターンのPGを掲載いたします！

[YAmaGNZ]

フォームのほうがデザインがしやすいのは分かりますので、フォームをデザインして空白のものを画像として事前に用意しておき、PrintPageイベントにてその画像の上に文字を描画するなどの方法のほうがいいのではないかと思います。
そうすればフォーム自体を使用することもないですから表示する必要もないですし。

[Marino_Y]

YAmaGNZ 様
ご提案ありがとうございます！
フォームとなると表示必須ですよね・・・しかし、掲載した以外にもフォームには画像データや印字する・しないの制御を組み込んでおりまして、少々骨が折れるので、フォームを生かしながらの方法もないものかと諦めきれずにおります・・・。
この機能を呼び出す別の画面があり、印刷するフォームを最背面に表示して印刷することはできましたので、別の画面に完全に隠れるかたちで最背面にできればいいのかな、とも考えております。
フォームをデザインする際はフォームを縮小表示し、キャプチャを元のサイズに拡大して印刷する・・・なんてことは難しいでしょうか。。

[Marino_Y]

追加ですみません！
印刷したいフォームを小さいサイズで作成しなおし、スクロールバーをつけて中身は今までどおりとすれば実現できる可能性はあるでしょうか？（試すのはこれからです）

[YAmaGNZ]

印刷ボタン→このフォームをプレビューとして表示（印刷しますか？の問い合わせも含めて）→印刷とするなど表示されても不自然ではない方法を考えてみるとか

[Marino_Y]

YAmaGNZ 様
そうですよね、そうしたい気持ちは山々なのですが・・・悪いことに、現行で運用している画面の仕様を踏襲して作り直しを依頼されていて難色を示されそうです。
どうしても無理となればご説明してお願いするしかないのですが、見た目だけでも近づけたい思いがあります・・・。

[YAmaGNZ]

＞印刷したいフォームを小さいサイズで作成しなおし、スクロールバーをつけて中身は今までどおりとすれば実現できる可能性はあるでしょうか？

画像取得の方法が実際に表示されている部分を取得するような形なので無理だと思います。

[Marino_Y]

スクロールバー案は駄目でした。印刷はできるものの、文字が見切れてしまいました。
全部表示されている状態でないときれいにキャプチャできないようです・・・。

[KOZ6.0]

FrmTicket2 は暗黙のインスタンスでしょうか？
その場合、PubS_PrintParkTicket の中で参照される FrmTicket2 と task1 で参照される FrmTicket2 は別物です。
インスタンスをモジュール変数として保存するか、Task_image に引数としてインスタンスを渡すようにしてください。
また、CaptureControl は Invoke する必要があります。

隠れている場所を印刷するには
「Control.DrawToBitmap(Bitmap, Rectangle) メソッド」
https://learn.microsoft.com/ja-jp/dotnet/api/system.windows.forms.control.drawtobitmap?view=netframework-4.8
を使ってみてください。（枠が Visual Style ではなくなってしまいますが）

[Marino_Y]

ありがとうございます。検討してみます！

Answer 1

クライアント領域を印字するサンプルを書いてみました。
実際の環境に合わせて微調整してください。

Option Strict On

Imports System.Drawing.Printing
Imports VB6 = Microsoft.VisualBasic

Module Com_ParkFunc

    Private saveForm As FrmTicket2

    Public Sub PubS_PrintParkTicket(ByVal strSrvNum As String)

        '' 各項目の設定
        With FrmTicket2
            .Label5.Text = "てすと"
            .lblDate.Text = VB6.Format(Now, "yyyy年mm月dd日 hh時nn分")
            .lblSrvNo.Text = "12345678901234"
        End With

        saveForm = FrmTicket2 'インスタンスを保存

        '表示して非表示にする(ウインドウを作成)
        saveForm.Visible = True
        saveForm.Visible = False

        Dim task As Task = New Task(AddressOf Task_image)
        task.Start()

    End Sub

    Private Sub Task_image()
        Using PrintDocument1 As New PrintDocument
            AddHandler PrintDocument1.PrintPage, AddressOf PrintDocument1_PrintPage
            PrintDocument1.Print()
        End Using
    End Sub

    Private Sub PrintDocument1_PrintPage(ByVal sender As Object, e As PrintPageEventArgs)
        Using bitmap As Bitmap = CaptureControl(saveForm)
            e.Graphics.DrawImage(bitmap, 0, 0, 215, 325)
            e.HasMorePages = False
        End Using
    End Sub

    Public Function CaptureControl(con As Control) As Bitmap
        ' スレッドが違う場合は Invoke する
        If con.InvokeRequired Then
            Dim invoker As Func(Of Control, Bitmap) = AddressOf CaptureControl
            Return DirectCast(con.Invoke(invoker, con), Bitmap)
        End If

        'ウインドウ全域(枠込み)を描画
        Using windowBitmap As New Bitmap(con.Width, con.Height)

            con.DrawToBitmap(windowBitmap, New Rectangle(Point.Empty, windowBitmap.Size))
            'windowBitmap.Save("Z:\window.bmp") '確認用

            'ウインドウ領域に対するクライアント領域の位置を算出
            Dim windowLocation As Point
            If con.Parent Is Nothing Then
                windowLocation = con.Location
            Else
                windowLocation = con.Parent.PointToScreen(con.Location)
            End If
            Dim clientLocation As Point = con.PointToScreen(Point.Empty)
            Dim windowDrawPoint As Point = windowLocation - CType(clientLocation, Size)

            'クライアント領域を切り出す
            Dim clientSize As Size = con.ClientSize
            Dim clientBitmap As New Bitmap(clientSize.Width, clientSize.Height)
            Using g As Graphics = Graphics.FromImage(clientBitmap)
                g.DrawImage(windowBitmap, windowDrawPoint)
            End Using
            'clientBitmap.Save("z:\client.bmp") '確認用

            Return clientBitmap
        End Using

    End Function

End Module