NonSoft

画面ハードコピー印刷のサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
画面のハードコピー(画面印刷)を簡易帳票として印刷するためにサンプルソースを作ってみました。
わざわざ帳票を作るまでもないけど画面を紙に印刷したい時に有効だと思います。工数削減です。

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