|
|||||
<このサンプルの概要> 画面のハードコピー(画面印刷)を簡易帳票として印刷するためにサンプルソースを作ってみました。 わざわざ帳票を作るまでもないけど画面を紙に印刷したい時に有効だと思います。工数削減です。 VB6のフォームにCommandButtonを2つ追加してお試しください。 本サンプルのキーワードは以下の通りです。 (1)Printer.PaintPicture (2)keybd_event (3)VK_SNAPSHOT (4)VK_LMENU (5)余白を考慮した拡大/縮小 (6)プリンタを指定した印刷 このサンプルは簡易版ですが、「便利ツール」コーナーの 「画面ハードコピー印刷DLL(VB6/VB.NET/C#.NET)」はもう少し便利なDLLです。 出来るだけ簡単にハードコピーを実現したい方はこのDLLをお試しください。 Option Explicit ' キーイベントAPI Private Declare Sub keybd_event Lib "user32.dll" _ (ByVal bVk As Byte, ByVal bScan As Byte, _ ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Const VK_SNAPSHOT = &H2C Private Const VK_LMENU = &HA4 Private Const KEYEVENTF_KEYUP = &H2 Private Const KEYEVENTF_EXTENDEDKEY = &H1 ' 余白サイズ(論理センチあたり567twip) Private Const lngYLeft = 567 Private Const lngYTop = 567 Private Const lngYRight = 567 Private Const lngYBottom = 567 Private Sub Command1_Click() ' 通常使うプリンタへの ' アクティブウィンドウのハードコピー HardCopy True, Printer End Sub Private Sub Command2_Click() ' 使用可能なプリンターを検索 Dim objPrinter As Printer For Each objPrinter In Printers If objPrinter.DeviceName = "My Printer" Then ' 指定のプリンタ発見 Set Printer = objPrinter Exit For End If Next ' 用紙方向を横向きに設定 Printer.Orientation = vbPRORLandscape ' 用紙サイズをA4に設定 Printer.PaperSize = vbPRPSA4 ' 指定のプリンタへの ' スクリーン全体のハードコピー HardCopy False, Printer End Sub Public Sub HardCopy(blnTargetWin As Boolean, objPrinter As Object) On Error Resume Next ' OSイベント DoEvents ' クリップボードクリア Clipboard.Clear If blnTargetWin Then ' ActiveWindowのPrintScreen Call keybd_event(VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY Or 0, 0) Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or 0, 0) ' WindowsVista(Windows7/Windows8)以降の場合はスリープが必要-- DoEvents Sleep 500 DoEvents ' ----------------------------------------------------------- Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0) Call keybd_event(VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0) Else ' FullScreenのPrintScreen Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0) Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0) End If ' OSイベント DoEvents ' ピクチャーを印刷する If Clipboard.GetFormat(vbCFBitmap) Then Dim lngHZoom As Single Dim lngWZoom As Single Dim lngHeight As Long Dim lngWidth As Long Dim objPicture As Picture Set objPicture = Clipboard.GetData ' デフォルトプリンタ設定 If objPrinter Is Nothing Then Set objPrinter = Printer End If ' 座標スケールの単位 objPicture.ScaleMode = vbTwips objPrinter.ScaleMode = vbTwips ' ピクチャーのサイズ lngHeight = objPicture.Height lngWidth = objPicture.Width ' 拡大/縮小率を元に印字サイズの計算 If lngHeight > objPrinter.Height - (lngYTop + lngYBottom) Or _ lngWidth > objPrinter.Width - (lngYLeft + lngYRight) Then ' 用紙サイズ < ピクチャーサイズ ' 拡大/縮小率を計算(余白考慮) lngHZoom = (objPrinter.Height - (lngYTop + lngYBottom)) / lngHeight lngWZoom = (objPrinter.Width - (lngYLeft + lngYRight)) / lngWidth ' 印字サイズの計算 If lngHZoom < lngWZoom Then lngHeight = lngHeight * lngHZoom lngWidth = lngWidth * lngHZoom Else lngHeight = lngHeight * lngWZoom lngWidth = lngWidth * lngWZoom End If End If ' ピクチャー印刷 objPrinter.PaintPicture _ objPicture, lngYLeft, lngYTop, lngWidth, lngHeight objPrinter.EndDoc End If End Sub |