Die Community zu .NET und Classic VB.

Startseite / Tipps / VB.NET-Tipp 0076: PrintForm-Methode für .NET

VB.NET-Tipp 0076: PrintForm-Methode für .NET

 von pks

Schwierigkeitsgrad:

Framework-Version(en): .NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5

.NET-Version(en): Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008

Download: Download des Beispielprojektes [12,85 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2005
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'

' ##############################################################################
' ############################## clsFormPrint.vb ###############################
' ##############################################################################
Imports System.Drawing.Printing
Imports System.Drawing.Imaging

''' <summary>
''' Druck einer Form mit Druckvorschau, alternativ ScreenShot
''' </summary>
''' <remarks></remarks>
Public Class clsPrintForm

    'Dokumentenobject zum Druck
    Private WithEvents Doc As New PrintDocument

    'Druckvorschau
    Private WithEvents PrnPreview As New PrintPreviewDialog

    Private m_Frm As Form
    Private m_LeftMargin As Single
    Private m_TopMargin As Single
    Private m_Header As String
    Private m_Zoom As Single
    Private m_AutoZoom As Boolean = True
    Private m_Preview As Boolean
    Private m_FontName As String
    Private m_FontSize As Integer
    Private m_FontBold As Boolean
    Private m_ImageHorizontalCenter As Boolean

    ''' <summary>
    ''' Instanz clsPrintForm
    ''' </summary>
    ''' <param name="mFrm">die auszuwertende Form</param>
    ''' <param name="mLeftMargin">Abstand linker Rand</param>
    ''' <param name="mTopMargin">Abstand oben</param>
    ''' <param name="mLandscape">Querformat</param>
    ''' <param name="mHeader">eine Überschrift</param>
    ''' <param name="mHeaderFontName">zur verwendender Font für Header</param>
    ''' <param name="mHeaderFontSize">zur verwendende Fontgrösse</param>
    ''' <param name="mHeaderFontBold">Fettschrift</param>
    ''' <remarks></remarks>
    Public Sub New(ByVal mFrm As Form, _
        Optional ByVal mLeftMargin As Single = 20, _
        Optional ByVal mTopMargin As Single = 30, _
        Optional ByVal mLandscape As Boolean = False, _
        Optional ByVal mHeader As String = Nothing, _
        Optional ByVal mHeaderFontName As String = "Arial", _
        Optional ByVal mHeaderFontSize As Integer = 10, _
        Optional ByVal mHeaderFontBold As Boolean = True)

        m_Frm = mFrm
        m_LeftMargin = mLeftMargin / 0.254
        m_TopMargin = mTopMargin / 0.254
        m_Header = mHeader
        m_FontName = mHeaderFontName
        m_FontSize = mHeaderFontSize
        m_FontBold = mHeaderFontBold

        Doc.DefaultPageSettings.Landscape = mLandscape
        Doc.DocumentName = "PrintForm_" & m_Frm.Name

        PrnPreview.Document = Doc
    End Sub


    ''' <summary>
    ''' Druck anstossen
    ''' </summary>
    ''' <param name="mZoom">Zoomfaktor, 100 = 1:1</param>
    ''' <param name="mZoomAutomatic">automatische Grössenanpassung bei
    ''' Überbreite oder -höhe</param>
    ''' <param name="mImageHorizontalCenter">Image horizontal centrieren</param>
    ''' <param name="AsPreview">Ausgabe als Druckvorschau</param>
    ''' <param name="PrinterName">einen (ausgewählten) Drucker vorgeben</param>
    ''' <remarks></remarks>
    Public Sub Print(Optional ByVal mZoom As Single = 100, _
        Optional ByVal mZoomAutomatic As Boolean = True, _
        Optional ByVal mImageHorizontalCenter As Boolean = True, _
        Optional ByVal AsPreview As Boolean = False, _
        Optional ByVal PrinterName As String = Nothing)

        m_Preview = AsPreview
        m_Zoom = mZoom
        m_AutoZoom = mZoomAutomatic
        m_ImageHorizontalCenter = mImageHorizontalCenter
        If Not String.IsNullOrEmpty(PrinterName) Then
            Doc.PrinterSettings.PrinterName = PrinterName
        End If

        If AsPreview Then
            PrnPreview.ShowDialog()
        Else
            Doc.Print()
        End If
    End Sub

    ''' <summary>
    ''' Form als Screenshot im JPEG Format speichern
    ''' </summary>
    ''' <param name="Filename">Zieldatei</param>
    ''' <param name="Ratio">Kompressionsrate</param>
    ''' <remarks></remarks>
    Public Sub SaveAsJpg(ByVal mFrm As Form, _
        ByVal Filename As String, _
        Optional ByVal Ratio As Integer = 85)

        Try
            Using Bmp As Bitmap = New Bitmap(m_Frm.Width, m_Frm.Height)
                Dim Rect As Rectangle
                Rect.Size = m_Frm.Size
                mFrm.DrawToBitmap(Bmp, Rect)

                Dim eps As EncoderParameters = New EncoderParameters(1)
                eps.Param(0) = New EncoderParameter(Encoder.Quality, Ratio)
                Dim ici As ImageCodecInfo = GetEncoderInfo("image/jpeg")
                Bmp.Save(Filename, ici, eps)
            End Using
        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try
    End Sub

    ''' <summary>
    ''' CodecInfo für JPEG laden
    ''' </summary>
    ''' <param name="mimeType"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function GetEncoderInfo(ByVal mimeType As String) As ImageCodecInfo
        Dim encoders As ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()

        For i As Integer = 0 To encoders.Length
            If encoders(i).MimeType = mimeType Then
                Return encoders(i)
            End If
        Next
        Return Nothing
    End Function

    ''' <summary>
    ''' Zoom 100% und Maximize
    ''' </summary>
    Private Sub PrnPreview_Load(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles PrnPreview.Load

        PrnPreview.WindowState = FormWindowState.Maximized
        PrnPreview.PrintPreviewControl.Zoom = 1.0
        PrnPreview.PrintPreviewControl.AutoZoom = False
    End Sub

    ''' <summary>
    ''' Druck der Form oder Vorschau
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub Doc_PrintPage(ByVal sender As Object, _
        ByVal e As System.Drawing.Printing.PrintPageEventArgs) _
        Handles Doc.PrintPage

        Dim Gr As Graphics = e.Graphics
        Gr.PageUnit = GraphicsUnit.Display

        ' Hardware bedingte Seitenränder
        Dim HardX As Single = Doc.DefaultPageSettings.HardMarginX
        Dim HardY As Single = Doc.DefaultPageSettings.HardMarginY
        If m_Preview Then
            HardX = 0
            HardY = 0
        End If

        ' verfügbarer Druckbereich
        Dim DocRect As Rectangle = Doc.DefaultPageSettings.Bounds

        ' Fontstyle einrichten
        Dim FtStyle As System.Drawing.FontStyle
        If m_FontBold Then
            FtStyle = FontStyle.Bold
        End If

        ' Font erstellen
        Using Ft As New Font(m_FontName, m_FontSize, FtStyle)
            Dim HeaderHeight As Single = 0
            ' wird Header benötigt
            If Not String.IsNullOrEmpty(m_Header) Then
                ' HeaderText
                Gr.DrawString(m_Header, Ft, Brushes.Black, _
                    m_LeftMargin - HardX, m_TopMargin - HardY)
                HeaderHeight = Gr.MeasureString("x", Ft).Height * 3
                ' gespiegelt Datum
                Dim Datum As String = Date.Now.ToString("dd.MM.yyyy")
                Dim X As Single = _
                    DocRect.Width - Gr.MeasureString(Datum, Ft).Width
                Gr.DrawString(Datum, Ft, Brushes.Black, _
                    X - m_LeftMargin - HardX, m_TopMargin - HardY)
            End If

            Using Bmp As Bitmap = New Bitmap(m_Frm.Width, m_Frm.Height)
                Dim Rect As Rectangle
                Rect.Size = m_Frm.Size
                m_Frm.DrawToBitmap(Bmp, Rect)

                ' Zoom berücksichtigen
                Dim W As Single = Bmp.Width * (m_Zoom / 100)
                Dim H As Single = Bmp.Height * (m_Zoom / 100)

                ' Autozoom falls Breite und/oder Höhe nicht reicht
                If m_AutoZoom Then
                    ' Zoomfaktor
                    Dim ZF As Single = 0
                    ' Breite checken
                    Dim MaxWidth As Single = DocRect.Width - (m_LeftMargin * 2)
                    If W > MaxWidth Then
                        ZF = MaxWidth / Bmp.Width
                    End If

                    ' Höhe checken
                        Dim MaxHeight As Single = _
                            DocRect.Height - m_TopMargin - HeaderHeight - 50
                        If H > MaxHeight Then
                            If (ZF = 0) Or ((MaxHeight / Bmp.Height) < ZF) Then
                                ZF = MaxHeight / Bmp.Height
                            End If
                        End If

                    ' Autozoom erforderlich
                    If ZF > 0 Then
                        ZF -= 0.02
                        W = Bmp.Width * ZF
                        H = Bmp.Height * ZF
                    End If
                End If

                ' horizontal zentrieren
                Dim X As Single = m_LeftMargin - HardX
                If m_ImageHorizontalCenter Then
                    X = (DocRect.Width - W) / 2 - HardX
                End If

                ' FormPrint
                Gr.DrawImage(Bmp, X, m_TopMargin - HardY + HeaderHeight, W, H)
            End Using
        End Using
    End Sub
End Class



' ##############################################################################
' ################################# Form1.vb ###################################
' ##############################################################################
Public Class Form1
    Private Sub Panel1_Paint(ByVal sender As System.Object, _
        ByVal e As System.Windows.Forms.PaintEventArgs) Handles Panel1.Paint

        Zeichnen(e.Graphics)
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles Button1.Click

        Dim cPrintForm As New clsPrintForm(Me, , , , "ein Header")
        If CheckBox1.Checked Then
            ' Druckvorschau
            cPrintForm.Print(, , , True)
        Else
            ' Drucken
            Dim PrinterName As String = ""
            If PrinterFind(PrinterName) Then
                cPrintForm.Print(, , , , PrinterName)
            End If
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles Button2.Click

        ' Neuzeichnen erzwingen
        Panel1.Refresh()
    End Sub

    Private Function PrinterFind(ByRef PrinterName As String) As Boolean
        PrinterName = ""
        Using PD As New PrintDialog
            Dim Result As DialogResult = PD.ShowDialog
            If Result = Windows.Forms.DialogResult.Cancel Then
                Return False
            End If
            PrinterName = PD.PrinterSettings.PrinterName
            Return True
        End Using
    End Function

    Private Sub Zeichnen(ByVal Gr As Graphics)
        Dim Ft As New Font("Arial", 20)
        Gr.DrawRectangle(Pens.Blue, 10, 10, 115, 30)
        Dim s As String = Date.Now.ToString("HH:mm:ss")
        Gr.DrawString(s, Ft, Brushes.Beige, 10, 10)
    End Sub
End Class

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.