解像度1280x1024での画面印刷

環境/言語:[OS ： Windows Vista Home Basic / 言語 ： Visual Basic .NET / .NET Framework ： 2.0]
分類:[.NET]

【解決したい問題】

.Net2005 で、画面イメージ印刷をご指導の様にして行いました。
只、画面解像度が 1280x1024 の時全て印刷出来ませんでした。
この場合でも全画面を印刷する方法はないものでしょうか？
参考になる事があれば教えて頂きたいのですが。
宜しくお願いいたします。
　　
　

【解決するために何をしたか】

画面を 1024X768サイズに縮小出来ないかやってみましたが、
解りませんでした。

正直、意味が良く分からないのですが、プリンタで印刷できる大きさに収まるように画像を縮小して印刷したいということでしょうか?もしそうであれば、

画像を拡大、縮小して表示する
http://dobon.net/vb/dotnet/graphics/scaling.html

を参考にしてください。

■No21548に返信(管理人さんの記事)
> 正直、意味が良く分からないのですが、プリンタで印刷できる大きさに収まるように画像を縮小して印刷したいということでしょうか?もしそうであれば、
>
> 画像を拡大、縮小して表示する
> http://dobon.net/vb/dotnet/graphics/scaling.html
>
> を参考にしてください。

メール有り難うございました。
言葉不足で申し訳ありませんでした。

1280x1024 で表示している画面を次の方法を参考にさせて頂いて、
画面全体をA4横１枚に印刷したいのです。
1024x768 の時は画面全体がA4横１枚に入りましたが、1280x1024 の時は
画面が切れてしまいます。

参考にさせて頂いたコードです。
Public Sub PrintForm(ByVal frm As Form)

'ﾌｫｰﾑのｲﾒｰｼﾞを取得する。
CaptureScreen(frm)

'ﾌｫｰﾑのｲﾒｰｼﾞを印刷する。
Dim PrintDocument1 As New System.Drawing.Printing.PrintDocument
AddHandler PrintDocument1.PrintPage, _
AddressOf PrintDocument1_PrintPage
PrintDocument1.DefaultPageSettings.Landscape = True '用紙方向横向き

PrintDocument1.Print()

End Sub
<System.Runtime.InteropServices.DllImport("gdi32.dll")> _
Private 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

'ﾌｫｰﾑのｲﾒｰｼﾞを保存する変数
Public memoryImage As Bitmap
'ﾌｫｰﾑのｲﾒｰｼﾞを取得する。
Private Sub CaptureScreen(ByVal frm As Form)
Dim myGraphics As Graphics = frm.CreateGraphics
Dim s As Size = frm.Size
memoryImage = New Bitmap(s.Width, s.Height, myGraphics)

Dim memoryGraphics As Graphics = Graphics.FromImage(memoryImage)
Dim dc1 As IntPtr = myGraphics.GetHdc()
Dim dc2 As IntPtr = memoryGraphics.GetHdc()

BitBlt(dc2, 0, 0, _
frm.ClientRectangle.Width, frm.ClientRectangle.Height, _
dc1, 0, 0, 13369376)
myGraphics.ReleaseHdc(dc1)
memoryGraphics.ReleaseHdc(dc2)

End Sub

今回、この 取得したmemoryImage を1024x768 に縮小して再度 PictureBoxに
表示して、その後Printform で印刷出来ないかをしてみました。

尚、memoryImage 共通領域に Public で宣言しています。

Private Sub CmdPrint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdPrint.Click
'画面印刷　画像を縮小して表示し、Form印刷する。

'Bitmap ｵﾌﾞｼﾞｪｸﾄの作成
Dim myGraphics As Graphics = Me.CreateGraphics
Dim s As Size = Me.Size
memoryImage = New Bitmap(s.Width, s.Height, myGraphics)

frmBitmapPrint.ShowDialog()
End Sub

'frmBitmapPrint のコードです。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim img As Bitmap = New Bitmap(" & memoryImage & ")
Dim g As Graphics = PictureBox1.CreateGraphics()

Dim rect As RectangleF = _
New RectangleF(0, 0, 0.8F * img.Width, 0.75F * img.Height)
g.DrawImage(img, rect)

End Sub

結果はだめでした。取得するBitmap は、外部のデータでないとだめなのでしょうか？
内部処理でmemoryImage を圧縮できればいいのですが・・・・
なにかよい方法があればお願い致します。

宜しくお願い致します。

PrintPageイベントで印刷用のGraphicsへ「希望サイズ内で描画」すればいけると思います。

#_Bitmap はオリジナルのビットマップ
#縦横ともにおさまるように比率の小さいほうを選択しています。

Private Sub _PrintDoc_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles _PrintDoc.PrintPage

With e
Dim RateX As Single = CSng(.MarginBounds.Width / _Bitmap.Width)
Dim RateY As Single = CSng(.MarginBounds.Height / _Bitmap.Height)

Dim Rate As Single = Math.Min(RateX, RateY)

Dim Rect As RectangleF = New RectangleF(0, 0, _Bitmap.Width * Rate, _Bitmap.Height * Rate)

.Graphics.DrawImage(_Bitmap, Rect)

.HasMorePages = False
End With

End Sub

■No21568に返信(まどかさんの記事)
> PrintPageイベントで印刷用のGraphicsへ「希望サイズ内で描画」すればいけると思います。
>
> #_Bitmap はオリジナルのビットマップ
> #縦横ともにおさまるように比率の小さいほうを選択しています。
>
> Private Sub _PrintDoc_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles _PrintDoc.PrintPage
>
> With e
> Dim RateX As Single = CSng(.MarginBounds.Width / _Bitmap.Width)
> Dim RateY As Single = CSng(.MarginBounds.Height / _Bitmap.Height)
>
> Dim Rate As Single = Math.Min(RateX, RateY)
>
> Dim Rect As RectangleF = New RectangleF(0, 0, _Bitmap.Width * Rate, _Bitmap.Height * Rate)
>
> .Graphics.DrawImage(_Bitmap, Rect)
>
> .HasMorePages = False
> End With
>
> End Sub
>

有難うございました。早速実行してみました。
ただ、オリジナルビットマップをmemoryImage
にしたせいか印刷はされませんでした。
コードは以下のとうりです。

Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim memoryImage As Bitmap

Dim RateX As Single = CSng(e.MarginBounds.Width / Me.Width)
Dim RateY As Single = CSng(e.MarginBounds.Height / Me.Height)
Dim Rate As Single = Math.Min(RateX, RateY)

'Bitmap ｵﾌﾞｼﾞｪｸﾄの作成
Dim myGraphics As Graphics = Me.CreateGraphics
Dim s As Size = Me.Size
memoryImage = New Bitmap(s.Width, s.Height, myGraphics)
Dim memoryGraphics As Graphics = Graphics.FromImage(memoryImage)

Dim Rect As RectangleF = _
New RectangleF(0, 0, Me.Width * Rate, Me.Height * Rate)

e.Graphics.DrawImage(memoryImage, Rect)
e.HasMorePages = False

End Sub

memoryImageではだめなのでしょうか？
度々すみません。もう一度お願い致します。

　　　Tosio

Framework 2.0なのでDrawToBitmapメソッドが使えるようです。
ControlをMeに置き換えてください。
http://dobon.net/vb/dotnet/graphics/invokepaint.html
#若干制限があります。

ちなみにMe.Graphicsでもできました。
ただし、(0,0)がクライアント領域の座標なのでタイトルバーなどは取得されませんでした。

Private Declare Function GetDesktopWindow Lib "user32" () As Integer
Private Declare Function GetWindowDC Lib "user32" Alias "GetWindowDC" (ByVal hwnd As Integer) As Integer
Private Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As IntPtr, ByRef lpRect As RECT) As Integer
Private Declare Function BitBlt Lib "gdi32" Alias "BitBlt" _
(ByVal hDestDC As Integer, ByVal x As Integer, _
ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Integer, ByVal hSrcDC As Integer, _
ByVal xSrc As Integer, ByVal ySrc As Integer, _
ByVal dwRop As Integer) As Integer

Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
Public Sub New(ByVal L As Integer, ByVal T As Integer, ByVal R As Integer, ByVal B As Integer)
Me.Left = L
Me.Top = T
Me.Right = R
Me.Bottom = B
End Sub
End Structure

Private Const SRCCOPY As Integer = &HCC0020

Private Function MeToBitmap() As Bitmap

Me.Cursor = Cursors.WaitCursor

Dim desktopBitmap As Bitmap = New Bitmap(Me.Width, _
Me.Height)

Dim targetGraphics As Graphics = Graphics.FromImage(desktopBitmap)
Dim targetDC As IntPtr = targetGraphics.GetHdc
Dim sourceGraphics As Graphics = Me.CreateGraphics
Dim sourceDC As IntPtr = sourceGraphics.GetHdc

BitBlt(targetDC.ToInt32, 0, 0, Me.Width, Me.Height, _
sourceDC.ToInt32, 0, 0, SRCCOPY)

targetGraphics.ReleaseHdc(targetDC)
sourceGraphics.ReleaseHdc(sourceDC)

Me.Cursor = Cursors.Default

Return desktopBitmap

End Function

デスクトップの場合


Private Function DesktopToBitmap() As Bitmap

Me.Cursor = Cursors.WaitCursor

Dim desktophWnd As IntPtr = New IntPtr(GetDesktopWindow)

Dim desktopBitmap As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, _
Screen.PrimaryScreen.Bounds.Height)

Dim targetGraphics As Graphics = Graphics.FromImage(desktopBitmap)
Dim targetDC As IntPtr = targetGraphics.GetHdc
Dim sourceDC As IntPtr = New IntPtr(GetWindowDC(desktophWnd.ToInt32))

BitBlt(targetDC.ToInt32, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, _
sourceDC.ToInt32, 0, 0, SRCCOPY)

targetGraphics.ReleaseHdc(targetDC)
ReleaseDC(desktophWnd.ToInt32, sourceDC.ToInt32)

Me.Cursor = Cursors.Default

Return desktopBitmap

End Function

■No21577に返信(まどかさんの記事)
> Framework 2.0なのでDrawToBitmapメソッドが使えるようです。
> ControlをMeに置き換えてください。
> http://dobon.net/vb/dotnet/graphics/invokepaint.html
> #若干制限があります。
>
> ちなみにMe.Graphicsでもできました。
> ただし、(0,0)がクライアント領域の座標なのでタイトルバーなどは取得されませんでした。
>
> Private Declare Function GetDesktopWindow Lib "user32" () As Integer
> Private Declare Function GetWindowDC Lib "user32" Alias "GetWindowDC" (ByVal hwnd As Integer) As Integer
> Private Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
> Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As IntPtr, ByRef lpRect As RECT) As Integer
> Private Declare Function BitBlt Lib "gdi32" Alias "BitBlt" _
> (ByVal hDestDC As Integer, ByVal x As Integer, _
> ByVal y As Integer, ByVal nWidth As Integer, _
> ByVal nHeight As Integer, ByVal hSrcDC As Integer, _
> ByVal xSrc As Integer, ByVal ySrc As Integer, _
> ByVal dwRop As Integer) As Integer
>
> Private Structure RECT
> Public Left As Integer
> Public Top As Integer
> Public Right As Integer
> Public Bottom As Integer
> Public Sub New(ByVal L As Integer, ByVal T As Integer, ByVal R As Integer, ByVal B As Integer)
> Me.Left = L
> Me.Top = T
> Me.Right = R
> Me.Bottom = B
> End Sub
> End Structure
>
> Private Const SRCCOPY As Integer = &HCC0020
>
> Private Function MeToBitmap() As Bitmap
>
> Me.Cursor = Cursors.WaitCursor
>
> Dim desktopBitmap As Bitmap = New Bitmap(Me.Width, _
> Me.Height)
>
> Dim targetGraphics As Graphics = Graphics.FromImage(desktopBitmap)
> Dim targetDC As IntPtr = targetGraphics.GetHdc
> Dim sourceGraphics As Graphics = Me.CreateGraphics
> Dim sourceDC As IntPtr = sourceGraphics.GetHdc
>
> BitBlt(targetDC.ToInt32, 0, 0, Me.Width, Me.Height, _
> sourceDC.ToInt32, 0, 0, SRCCOPY)
>
> targetGraphics.ReleaseHdc(targetDC)
> sourceGraphics.ReleaseHdc(sourceDC)
>
> Me.Cursor = Cursors.Default
>
> Return desktopBitmap
>
> End Function
>
> デスクトップの場合
>
>
> Private Function DesktopToBitmap() As Bitmap
>
> Me.Cursor = Cursors.WaitCursor
>
> Dim desktophWnd As IntPtr = New IntPtr(GetDesktopWindow)
>
> Dim desktopBitmap As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, _
> Screen.PrimaryScreen.Bounds.Height)
>
> Dim targetGraphics As Graphics = Graphics.FromImage(desktopBitmap)
> Dim targetDC As IntPtr = targetGraphics.GetHdc
> Dim sourceDC As IntPtr = New IntPtr(GetWindowDC(desktophWnd.ToInt32))
>
> BitBlt(targetDC.ToInt32, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, _
> sourceDC.ToInt32, 0, 0, SRCCOPY)
>
> targetGraphics.ReleaseHdc(targetDC)
> ReleaseDC(desktophWnd.ToInt32, sourceDC.ToInt32)
>
> Me.Cursor = Cursors.Default
>
> Return desktopBitmap
>
> End Function
>
ありがとうございました。
Me.Graphics　のほうですが、縮小する方法が解りませんでした。
印刷はするのですが、やはり切れてしまいます。
コードは次のようにしました。
Private Declare Function GetDesktopWindow Lib "user32" () As Integer
Private Declare Function GetWindowDC Lib "user32" Alias "GetWindowDC" (ByVal hwnd As Integer) As Integer
Private Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As IntPtr, ByRef lpRect As RECT) As Integer
Private Declare Function BitBlt Lib "gdi32" Alias "BitBlt" _
(ByVal hDestDC As Integer, ByVal x As Integer, _
ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Integer, ByVal hSrcDC As Integer, _
ByVal xSrc As Integer, ByVal ySrc As Integer, _
ByVal dwRop As Integer) As Integer

Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
Public Sub New(ByVal L As Integer, ByVal T As Integer, ByVal R As Integer, ByVal B As Integer)
Me.Left = L
Me.Top = T
Me.Right = R
Me.Bottom = B
End Sub
End Structure

Private Const SRCCOPY As Integer = &HCC0020
Dim desktopBitmap As Bitmap = New Bitmap(1280, 1024)

　　'esktopBitmap は、Print.Page で使用するので、共通にしました。
　　'サイズは、元のForm と思い 1280x1024 にしました。

Private Function MeToBitmap(ByVal frm As Form) As Bitmap

'Me.Cursor = Cursors.WaitCursor

'Dim desktopBitmap As Bitmap = New Bitmap(frm.Width, _
' frm.Height)

Dim targetGraphics As Graphics = Graphics.FromImage(desktopBitmap)
Dim targetDC As IntPtr = targetGraphics.GetHdc
Dim sourceGraphics As Graphics = frm.CreateGraphics
Dim sourceDC As IntPtr = sourceGraphics.GetHdc

BitBlt(targetDC.ToInt32, 0, 0, frm.Width, frm.Height, _
sourceDC.ToInt32, 0, 0, SRCCOPY)

targetGraphics.ReleaseHdc(targetDC)
sourceGraphics.ReleaseHdc(sourceDC)

'Me.Cursor = Cursors.Default

Return desktopBitmap

End Function

Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
e.Graphics.DrawImage(desktopBitmap, 0, 0)

End Sub

引用は必要な部分だけにしましょう。

#desktopBitmapって名前変えるの忘れてました。。。MyFormBitmapでした。

■No21585に返信(Tosioさんの記事)
> Me.Graphics　のほうですが、縮小する方法が解りませんでした。
> 印刷はするのですが、やはり切れてしまいます。

> Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
> e.Graphics.DrawImage(desktopBitmap, 0, 0)
>
> End Sub

縮小処理がありませんが。。。
#投稿21568


> Dim desktopBitmap As Bitmap = New Bitmap(1280, 1024)
>
> 　　'esktopBitmap は、Print.Page で使用するので、共通にしました。
> 　　'サイズは、元のForm と思い 1280x1024 にしました。

それでは解像度が変更になったりフォームのサイズが変わったりしたら意図した動きになりません。
対象がフォームであればフォームのサイズ、デスクトップであればデスクトップのサイズをその場で求めるようにしておけばよいと思いますが。

紹介したDrawToBitmapメソッドも試してみてください。一発でBitmapが出来上がります。＞API使わなくてすむし。

ちなみに「デスクトップの場合」の
Dim desktophWnd As IntPtr = New IntPtr(GetDesktopWindow)
Dim desktopBitmap As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, _
Screen.PrimaryScreen.Bounds.Height)
を
Dim hWnd As IntPtr = Me.Handle
Dim myBitmap As Bitmap = New Bitmap(Me.Width, Me.Height)
に変更すればフォーム版になります。
ということは、MeをMe.Button1とかにすればButtonだけになります。

■No21588に返信(まどかさんの記事)
> 引用は必要な部分だけにしましょう。
>
> #desktopBitmapって名前変えるの忘れてました。。。MyFormBitmapでした。
>
> ■No21585に返信(Tosioさんの記事)
>>Me.Graphics　のほうですが、縮小する方法が解りませんでした。
>>印刷はするのですが、やはり切れてしまいます。
>
>> Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
>> e.Graphics.DrawImage(desktopBitmap, 0, 0)
>>
>> End Sub
>
> 縮小処理がありませんが。。。
> #投稿21568
>
>
>> Dim desktopBitmap As Bitmap = New Bitmap(1280, 1024)
>>
>>　　'esktopBitmap は、Print.Page で使用するので、共通にしました。
>>　　'サイズは、元のForm と思い 1280x1024 にしました。
>
> それでは解像度が変更になったりフォームのサイズが変わったりしたら意図した動きになりません。
> 対象がフォームであればフォームのサイズ、デスクトップであればデスクトップのサイズをその場で求めるようにしておけばよいと思いますが。
>
> 紹介したDrawToBitmapメソッドも試してみてください。一発でBitmapが出来上がります。＞API使わなくてすむし。
>
> ちなみに「デスクトップの場合」の
> Dim desktophWnd As IntPtr = New IntPtr(GetDesktopWindow)
> Dim desktopBitmap As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, _
> Screen.PrimaryScreen.Bounds.Height)
> を
> Dim hWnd As IntPtr = Me.Handle
> Dim myBitmap As Bitmap = New Bitmap(Me.Width, Me.Height)
> に変更すればフォーム版になります。
> ということは、MeをMe.Button1とかにすればButtonだけになります。

有難うございました。解決しました。