質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.42%
Windows 10

Windows 10は、マイクロソフト社がリリースしたOSです。Modern UIを標準画面にした8.1から、10では再びデスクトップ主体に戻され、UIも変更されています。PCやスマホ、タブレットなど様々なデバイスに幅広く対応していることが特徴です。

印刷

印刷とは、インキを用いて紙などの被印刷物に機械的に複製することを指します。現在は紙などの2次元の媒体だけでなく、3次元の曲面にも直接印刷する技術など様々な開発が進んでいます。

VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

.NET Framework

.NET Framework は、Microsoft Windowsのオペレーティングシステムのために開発されたソフトウェア開発環境/実行環境です。多くのプログラミング言語をサポートしています。

VB.NET

Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

Q&A

1回答

894閲覧

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

Marino_Y

総合スコア2

Windows 10

Windows 10は、マイクロソフト社がリリースしたOSです。Modern UIを標準画面にした8.1から、10では再びデスクトップ主体に戻され、UIも変更されています。PCやスマホ、タブレットなど様々なデバイスに幅広く対応していることが特徴です。

印刷

印刷とは、インキを用いて紙などの被印刷物に機械的に複製することを指します。現在は紙などの2次元の媒体だけでなく、3次元の曲面にも直接印刷する技術など様々な開発が進んでいます。

VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

.NET Framework

.NET Framework は、Microsoft Windowsのオペレーティングシステムのために開発されたソフトウェア開発環境/実行環境です。多くのプログラミング言語をサポートしています。

VB.NET

Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

0グッド

0クリップ

投稿2023/04/27 14:01

編集2023/04/28 02:56

実現したいこと

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

前提

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

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

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

該当のソースコード

VB.NET

1Module Com_ParkFunc 2 Public memoryImage As Bitmap 3 Public PrintDocument1 As System.Drawing.Printing.PrintDocument 4 5 6 Public Sub PubS_PrintParkTicket(ByVal strSrvNum As String) 7 Dim SecName As String 8 Dim KeyName As String 9 10 '' 各項目の設定 11 With FrmTicket2 12 .Label5.Text = "てすと" 13 .lblDate.Text = VB6.Format(Now, "yyyy年mm月dd日 hh時nn分") 14 .lblSrvNo.Text = "12345678901234" 15 End With 16 17 Dim task As Threading.Tasks.Task = New Threading.Tasks.Task( 18 Sub() 19 Task_image() 20 End Sub 21 ) 22 task.Start() 23 End Sub 24 25 26 Private Const SRCCOPY As Integer = &HCC0020 27 'フォームのイメージを取得する 28 Public Function CaptureControl(ByVal ctrl As Control) As Bitmap 29 Dim g As Graphics = ctrl.CreateGraphics() 30 Dim img As New Bitmap(ctrl.ClientRectangle.Width, 31 ctrl.ClientRectangle.Height, g) 32 Dim memg As Graphics = Graphics.FromImage(img) 33 Dim dc1 As IntPtr = g.GetHdc() 34 Dim dc2 As IntPtr = memg.GetHdc() 35 BitBlt(dc2, 0, 0, img.Width, img.Height, dc1, 0, 0, SRCCOPY) 36 g.ReleaseHdc(dc1) 37 memg.ReleaseHdc(dc2) 38 memg.Dispose() 39 g.Dispose() 40 Return img 41 End Function 42 43 44 'PrintDocument1のPrintPageイベントハンドラ 45 Public Sub PrintDocument1_PrintPage(ByVal sender As Object, 46 ByVal e As System.Drawing.Printing.PrintPageEventArgs) 47 Dim img As Bitmap = memoryImage 48 e.Graphics.DrawImage(img, 0, 0, 215, 325) 49 e.HasMorePages = False 50 img.Dispose() 51 End Sub 52 53 54 55 Public Sub Task_image() 56 57 Dim memoryImageWK As Bitmap 58 memoryImage = memoryImageWK 59 60 Try 61 'MsgBox("1.1") 62 If task1(memoryImage).Equals(False) Then 63 Exit Sub 64 End If 65 If task2(memoryImage).Equals(False) Then 66 Exit Sub 67 End If 68 If task3(memoryImage).Equals(False) Then 69 Exit Sub 70 End If 71 Catch sysEx As System.Exception 72 Throw sysEx 73 Finally 74 memoryImage = Nothing 75 PrintDocument1 = Nothing 76 'MsgBox("2.3") 77 End Try 78 End Sub 79 80 Private Function task1(ByRef memoryImage As Bitmap) As Boolean 81 Try 82 memoryImage = CaptureControl(FrmTicket2) 83 return true 84 Catch sysEx As System.Exception 85 return false 86 End Try 87 End Function 88 89 Private Function task2(ByRef memoryImage As Bitmap) As Boolean 90 Dim PrintDocumentWK As New System.Drawing.Printing.PrintDocument 91 PrintDocument1 = PrintDocumentWK 92 Try 93 'MsgBox("2.1") 94 AddHandler PrintDocument1.PrintPage, AddressOf PrintDocument1_PrintPage 95 return true 96 Catch sysEx As System.Exception 97 return false 98 End Try 99 End Function 100 101 Private Function task3(ByRef memoryImage As Bitmap) As Boolean 102 Try 103 'MsgBox("2.2") 104 PrintDocument1.Print() 105 return true 106 Catch sysEx As System.Exception 107 return false 108 End Try 109 End Function 110 111End 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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

YAmaGNZ

2023/04/27 23:01

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

2023/04/28 00:17

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

2023/04/28 02:37

YAmaGNZ 様 FrmTicket2は、任意で値を埋め込むフォームで、作ったイメージ(画面)をキャプチャして印刷しようとしております。 たしかに、描画後にリフレッシュしていないですね・・・! sazi 様 担当者に詳細を確認したところ、FrmTicket2描画後にメッセージボックスを入れると、タスク化しなくてもきれいに印刷できるとのことでした。 数刻後に、追加情報として、きれいに印刷できたパターンのPGを掲載いたします!
YAmaGNZ

2023/04/28 03:21

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

2023/04/28 03:58

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

2023/04/28 04:17

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

2023/04/28 04:21

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

2023/04/28 04:26

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

2023/04/28 04:31

>印刷したいフォームを小さいサイズで作成しなおし、スクロールバーをつけて中身は今までどおりとすれば実現できる可能性はあるでしょうか? 画像取得の方法が実際に表示されている部分を取得するような形なので無理だと思います。
Marino_Y

2023/04/28 04:31

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

2023/04/28 06:00

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

2023/04/28 06:44

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

回答1

0

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

vb

1Option Strict On 2 3Imports System.Drawing.Printing 4Imports VB6 = Microsoft.VisualBasic 5 6Module Com_ParkFunc 7 8 Private saveForm As FrmTicket2 9 10 Public Sub PubS_PrintParkTicket(ByVal strSrvNum As String) 11 12 '' 各項目の設定 13 With FrmTicket2 14 .Label5.Text = "てすと" 15 .lblDate.Text = VB6.Format(Now, "yyyy年mm月dd日 hh時nn分") 16 .lblSrvNo.Text = "12345678901234" 17 End With 18 19 saveForm = FrmTicket2 'インスタンスを保存 20 21 '表示して非表示にする(ウインドウを作成) 22 saveForm.Visible = True 23 saveForm.Visible = False 24 25 Dim task As Task = New Task(AddressOf Task_image) 26 task.Start() 27 28 End Sub 29 30 Private Sub Task_image() 31 Using PrintDocument1 As New PrintDocument 32 AddHandler PrintDocument1.PrintPage, AddressOf PrintDocument1_PrintPage 33 PrintDocument1.Print() 34 End Using 35 End Sub 36 37 Private Sub PrintDocument1_PrintPage(ByVal sender As Object, e As PrintPageEventArgs) 38 Using bitmap As Bitmap = CaptureControl(saveForm) 39 e.Graphics.DrawImage(bitmap, 0, 0, 215, 325) 40 e.HasMorePages = False 41 End Using 42 End Sub 43 44 Public Function CaptureControl(con As Control) As Bitmap 45 ' スレッドが違う場合は Invoke する 46 If con.InvokeRequired Then 47 Dim invoker As Func(Of Control, Bitmap) = AddressOf CaptureControl 48 Return DirectCast(con.Invoke(invoker, con), Bitmap) 49 End If 50 51 'ウインドウ全域(枠込み)を描画 52 Using windowBitmap As New Bitmap(con.Width, con.Height) 53 54 con.DrawToBitmap(windowBitmap, New Rectangle(Point.Empty, windowBitmap.Size)) 55 'windowBitmap.Save("Z:\window.bmp") '確認用 56 57 'ウインドウ領域に対するクライアント領域の位置を算出 58 Dim windowLocation As Point 59 If con.Parent Is Nothing Then 60 windowLocation = con.Location 61 Else 62 windowLocation = con.Parent.PointToScreen(con.Location) 63 End If 64 Dim clientLocation As Point = con.PointToScreen(Point.Empty) 65 Dim windowDrawPoint As Point = windowLocation - CType(clientLocation, Size) 66 67 'クライアント領域を切り出す 68 Dim clientSize As Size = con.ClientSize 69 Dim clientBitmap As New Bitmap(clientSize.Width, clientSize.Height) 70 Using g As Graphics = Graphics.FromImage(clientBitmap) 71 g.DrawImage(windowBitmap, windowDrawPoint) 72 End Using 73 'clientBitmap.Save("z:\client.bmp") '確認用 74 75 Return clientBitmap 76 End Using 77 78 End Function 79 80End Module

投稿2023/04/28 07:28

KOZ6.0

総合スコア2668

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.42%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問