Impression facile en évitant les bugs du framework

5/5 (5 avis)

Vue 9 793 fois - Téléchargée 1 120 fois

Télécharger le projet
Commenter

Description

Voici une classe très simple d'utilisation pour imprimer et connaitre toutes les dimensions de la page, la marge physique, et permettant de définir facilement une marge en centimètres. Pour l'utiliser, il faut créer une classe qui hérite de la classe ImpressionFacile. Trois méthodes doivent être redéfinies : le début d'impression, l'impression d'une page, et la fin de l'impression. Le corps de ces procédures est automatiquement ajouté par Visual Studio en faisant retour à la ligne à la fin de la ligne Inherits.

Dernier ajout : amélioration de l'objet OutilsTexte

Source / Exemple : 


Imports system.Drawing.Printing

''' <summary>
''' Classe permettant de gérer facilement l'impression et
''' en évitant les bugs du framework.
''' </summary>
Public MustInherit Class ImpressionFacile

    ''' <summary>
    ''' Instancie un nouvel objet d'impression. Par défaut
    ''' les marges sont de 1 cm de tous les côtés.
    ''' </summary>
    ''' <remarks></remarks>
    Sub New()
        DéfinirMargesEnCm(1, 1, 1, 1)
        AddHandler Document.BeginPrint, AddressOf GèreDébutImpression
        AddHandler Document.EndPrint, AddressOf GèreFinImpression
        AddHandler Document.PrintPage, AddressOf GèreImpressionPage
    End Sub

    ''' <summary>
    ''' Liste des imprimantes installées
    ''' </summary>
    ReadOnly Property ImprimantesInstallées() As List(Of String)
        Get
            Dim Résultat As New List(Of String)
            For Each imprimante As String In PrinterSettings.InstalledPrinters
                Résultat.Add(imprimante)
            Next
            Return Résultat
        End Get
    End Property

    ''' <summary>
    ''' Imprimante par défaut
    ''' </summary>
    Public ReadOnly ImprimanteParDéfaut As String = (New PrinterSettings).PrinterName

    Private Document As New PrintDocument

    ''' <summary>
    ''' Imprimante sélectionnée pour l'impression
    ''' </summary>
    Property ImprimanteSélectionnée() As String
        Get
            Return Document.PrinterSettings.PrinterName
        End Get
        Set(ByVal value As String)
            Document.PrinterSettings.PrinterName = value
        End Set
    End Property

    ''' <summary>
    ''' Orientations possibles
    ''' </summary>
    Enum Orientation
        Portrait
        Paysage
    End Enum

    ''' <summary>
    ''' Orientation choisie pour l'impression
    ''' </summary>
    Property OrientationChoisie() As Orientation
        Get
            If Document.DefaultPageSettings.Landscape Then
                Return Orientation.Paysage
            Else
                Return Orientation.Portrait
            End If
        End Get
        Set(ByVal value As Orientation)
            If value = Orientation.Paysage Then
                Document.DefaultPageSettings.Landscape = True
            Else
                Document.DefaultPageSettings.Landscape = False
            End If
        End Set
    End Property

    ''' <summary>
    ''' Affiche la boite de dialogue de mise en page.
    ''' </summary>
    Sub AfficherMiseEnPage(Optional ByVal ChoixMarges As Boolean = True, Optional ByVal ChoixOrientation As Boolean = True, Optional ByVal ChoixImprimanteEtPapier As Boolean = True)
        Dim dlg As New PageSetupDialog
        dlg.AllowMargins = ChoixMarges
        dlg.AllowOrientation = ChoixOrientation
        dlg.AllowPaper = ChoixImprimanteEtPapier
        dlg.AllowPrinter = ChoixImprimanteEtPapier
        dlg.Document = Document
        'En principe, Margins est exprimé en
        'centièmes de pouces. Mais la boîte
        'de dialogue récupère Margins en
        'considérant que ce sont des centièmes 
        'de centimètres
        With Document.DefaultPageSettings.Margins
            'On arrondit au millimètre
            .Left = Math.Round(.Left * 2.54 / 10) * 10
            .Top = Math.Round(.Top * 2.54 / 10) * 10
            .Right = Math.Round(.Right * 2.54 / 10) * 10
            .Bottom = Math.Round(.Bottom * 2.54 / 10) * 10
        End With
        Dim res As DialogResult = dlg.ShowDialog()
        'La boîte de dialogue stocke dans Margins
        'les nouvelles marges en centième de pouces
        If res <> DialogResult.OK Then
            'Mais si on ne clique pas sur OK,
            'Margins n'est pas changé, il faut
            'donc reconvertir en pouces
            With Document.DefaultPageSettings.Margins
                .Left = Math.Round(.Left / 2.54)
                .Top = Math.Round(.Top / 2.54)
                .Right = Math.Round(.Right / 2.54)
                .Bottom = Math.Round(.Bottom / 2.54)
            End With
        End If
        dlg.Dispose()
    End Sub

    ''' <summary>
    ''' Marges en haut et à gauche en centimètres 
    ''' </summary>
    Property MargesHautGaucheEnCm() As SizeF
        Get
            With Document.DefaultPageSettings.Margins
                Return New SizeF(Math.Round(.Left * 2.54 / 10) / 10, _
                          Math.Round(.Top * 2.54 / 10) / 10)
            End With
        End Get
        Set(ByVal value As SizeF)
            With Document.DefaultPageSettings.Margins
                .Left = Math.Round(value.Width * 100 / 2.54)
                .Top = Math.Round(value.Height * 100 / 2.54)
            End With
        End Set
    End Property

    ''' <summary>
    ''' Marges en bas et à droite en centimètres 
    ''' </summary>
    Property MargesBasDroiteEnCm() As SizeF
        Get
            With Document.DefaultPageSettings.Margins
                Return New SizeF(Math.Round(.Right * 2.54 / 10) / 10, _
                          Math.Round(.Bottom * 2.54 / 10) / 10)
            End With
        End Get
        Set(ByVal value As SizeF)
            With Document.DefaultPageSettings.Margins
                .Right = Math.Round(value.Width * 100 / 2.54)
                .Bottom = Math.Round(value.Height * 100 / 2.54)
            End With
        End Set
    End Property

    ''' <summary>
    ''' Définir l'ensemble des marges en centimètres
    ''' </summary>
    Sub DéfinirMargesEnCm(ByVal Gauche As Double, ByVal Haut As Double, ByVal Droite As Double, ByVal Bas As Double)
        MargesHautGaucheEnCm = New SizeF(Gauche, Haut)
        MargesBasDroiteEnCm = New SizeF(Droite, Bas)
    End Sub

    ''' <summary>
    ''' Précise s'il faut augmenter les marges afin que la zone d'impression
    ''' déterminée soit à l'intérieur de la zone physiquement imprimable.
    ''' </summary>
    Public AugmenterMargesSiBesoin As Boolean = True

    Private AnnulationDemandée As Boolean

    ''' <summary>
    ''' Annuler l'impression en cours.
    ''' </summary>
    Protected Sub AnnulerImpression()
        AnnulationDemandée = True
    End Sub

    ''' <summary>
    ''' Lancer une impression sans passer par une
    ''' boite de dialogue.
    ''' </summary>
    Sub ImprimerDirectement()
        Document.Print()
    End Sub

    ''' <summary>
    ''' Affiche un aperçu avant impression. L'utilisateur
    ''' peut lancer autant d'impressions qu'il le souhaite.
    ''' </summary>
    Sub AperçuAvantImpression()
        Dim dlg As New PrintPreviewDialog
        dlg.Document = Document
        dlg.ShowDialog()
        dlg.Dispose()
    End Sub

    Private TypeImpression As PrintAction
    Private NuméroPageInterne As Integer
    Private Sub GèreDébutImpression(ByVal sender As Object, ByVal e As PrintEventArgs)
        AnnulationDemandée = False
        NuméroPageInterne = 0
        TypeImpression = e.PrintAction
        QuandDébutImpression(e.PrintAction)
        e.Cancel = AnnulationDemandée
    End Sub

    Private Sub GèreFinImpression(ByVal sender As Object, ByVal e As PrintEventArgs)
        QuandFinImpression(NuméroPageInterne)
        e.Cancel = AnnulationDemandée
    End Sub

    Private Sub GèreImpressionPage(ByVal sender As Object, ByVal e As PrintPageEventArgs)
        Dim Mesure As New MesureImpression(e, TypeImpression)
        Dim CalculZone As New CalculZone(Me, Mesure)

        Dim EstDernièrePage As Boolean = True
        NuméroPageInterne += 1
        Dim Texte As New OutilsTexte(e.Graphics, Mesure)
        QuandImpressionPage(e.Graphics, CalculZone, Mesure, Texte, NuméroPageInterne, EstDernièrePage)
        e.HasMorePages = Not EstDernièrePage
        e.Cancel = AnnulationDemandée
    End Sub

    ''' <summary>
    ''' Calcule la zone d'impression en fonction des marges définies et
    ''' de l'unité de dessin utilisée.
    ''' </summary>
    Protected Class CalculZone
        Private oImpression As ImpressionFacile
        Private oMesure As MesureImpression
        Private oUnité As GraphicsUnit
        Private oZone As RectangleF
        Sub New(ByVal UneImpression As ImpressionFacile, ByVal UneMesure As MesureImpression)
            oImpression = UneImpression
            oMesure = UneMesure
            EffectueCalcul()
        End Sub

        Private Sub EffectueCalcul()
            Dim LaMargeHautGauche As SizeF = oImpression.MargesHautGaucheEnCm()
            Dim LaMargeBasDroite As SizeF = oImpression.MargesBasDroiteEnCm()
            oZone = oMesure.ConstruireRectangleAvecMargesEnCm _
             (LaMargeHautGauche.Width, LaMargeHautGauche.Height, _
              LaMargeBasDroite.Width, LaMargeBasDroite.Height, oImpression.AugmenterMargesSiBesoin)
            oUnité = oMesure.Unité
        End Sub

        ReadOnly Property Rectangle() As RectangleF
            Get
                If oMesure.Unité <> oUnité Then EffectueCalcul()
                Return New RectangleF(oZone.X, oZone.Y, oZone.Width, oZone.Height)
            End Get
        End Property

        ReadOnly Property X() As Single
            Get
                If oMesure.Unité <> oUnité Then EffectueCalcul()
                Return oZone.X
            End Get
        End Property

        ReadOnly Property Y() As Single
            Get
                If oMesure.Unité <> oUnité Then EffectueCalcul()
                Return oZone.Y
            End Get
        End Property

        ReadOnly Property Width() As Single
            Get
                If oMesure.Unité <> oUnité Then EffectueCalcul()
                Return oZone.Width
            End Get
        End Property

        ReadOnly Property Height() As Single
            Get
                If oMesure.Unité <> oUnité Then EffectueCalcul()
                Return oZone.Height
            End Get
        End Property

    End Class

    ''' <summary>
    ''' Actions à effectuer lors de l'impression d'une page
    ''' </summary>
    Protected MustOverride Sub QuandImpressionPage(ByVal Surface As Graphics, ByVal Zone As CalculZone, ByVal Mesure As MesureImpression, ByVal Texte As OutilsTexte, ByVal NuméroPage As Integer, ByRef EstDernièrePage As Boolean)

    ''' <summary>
    ''' Actions à effectuer au début d'une impression
    ''' </summary>
    Protected MustOverride Sub QuandDébutImpression(ByVal TypeImpression As PrintAction)

    ''' <summary>
    ''' Actions à effectuer à la fin d'une impression
    ''' </summary>
    Protected MustOverride Sub QuandFinImpression(ByVal NbPagesImprimées As Integer)

    ''' <summary>
    ''' Classe permettant de faire des calculs et d'effectuer des
    ''' mesures sur une page d'impression.
    ''' </summary>
    Public Class MesureImpression

        Private TypeImpression As Printing.PrintAction

        Private Declare Function GetDeviceCaps Lib "gdi32" _
         (ByVal hdc As IntPtr, ByVal CapIndex As Int32) As Int32

        Private Const Cap_LogPixelsX = 88
        Private Const Cap_LogPixelsY = 90
        Private Const Cap_PhysicalWidth = 110
        Private Const Cap_PhysicalHeight = 111
        Private Const Cap_PhysicalOffsetX = 112
        Private Const Cap_PhysicalOffsetY = 113
        Private Const Cap_HorzRes = 8
        Private Const Cap_VertRes = 10

        Private LogPixelsX As Integer
        Private LogPixelsY As Integer
        Private PhysicalWidth As Integer
        Private PhysicalHeight As Integer
        Private PhysicalOffsetX As Integer
        Private PhysicalOffsetY As Integer
        Private HorzRes As Integer
        Private VertRes As Integer

        Private Surface As Drawing.Graphics

        Public Function Convertir(ByVal UnRectangle As RectangleF, ByVal UnitéDeDépart As GraphicsUnit, ByVal UnitéDeDestination As GraphicsUnit) As RectangleF
            Dim FacteurDépartX As Single = UnitéHorizontaleEnPixels(UnitéDeDépart)
            Dim FacteurDépartY As Single = UnitéVerticaleEnPixels(UnitéDeDépart)
            Dim FacteurArrivéeX As Single = UnitéHorizontaleEnPixels(UnitéDeDestination)
            Dim FacteurArrivéeY As Single = UnitéVerticaleEnPixels(UnitéDeDestination)
            Return New RectangleF(UnRectangle.X * FacteurDépartX / FacteurArrivéeX, UnRectangle.Y * FacteurDépartY / FacteurArrivéeY, _
                UnRectangle.Width * FacteurDépartX / FacteurArrivéeX, UnRectangle.Height * FacteurDépartY / FacteurArrivéeY)
        End Function

        Public Function Convertir(ByVal Position As PointF, ByVal UnitéDeDépart As GraphicsUnit, ByVal UnitéDeDestination As GraphicsUnit) As PointF
            Dim FacteurDépartX As Single = UnitéHorizontaleEnPixels(UnitéDeDépart)
            Dim FacteurDépartY As Single = UnitéVerticaleEnPixels(UnitéDeDépart)
            Dim FacteurArrivéeX As Single = UnitéHorizontaleEnPixels(UnitéDeDestination)
            Dim FacteurArrivéeY As Single = UnitéVerticaleEnPixels(UnitéDeDestination)
            Return New PointF(Position.X * FacteurDépartX / FacteurArrivéeX, Position.Y * FacteurDépartY / FacteurArrivéeY)
        End Function

        Public Function Convertir(ByVal Taille As SizeF, ByVal UnitéDeDépart As GraphicsUnit, ByVal UnitéDeDestination As GraphicsUnit) As SizeF
            Dim FacteurDépartX As Single = UnitéHorizontaleEnPixels(UnitéDeDépart)
            Dim FacteurDépartY As Single = UnitéVerticaleEnPixels(UnitéDeDépart)
            Dim FacteurArrivéeX As Single = UnitéHorizontaleEnPixels(UnitéDeDestination)
            Dim FacteurArrivéeY As Single = UnitéVerticaleEnPixels(UnitéDeDestination)
            Return New SizeF(Taille.Width * FacteurDépartX / FacteurArrivéeX, Taille.Height * FacteurDépartY / FacteurArrivéeY)
        End Function

        Private Function ConvertirDepuisPixels(ByVal Taille As Size, ByVal UnitéDeDestination As GraphicsUnit) As SizeF
            Dim FacteurArrivéeX As Single = UnitéHorizontaleEnPixels(UnitéDeDestination)
            Dim FacteurArrivéeY As Single = UnitéVerticaleEnPixels(UnitéDeDestination)
            Return New SizeF(Taille.Width / FacteurArrivéeX, Taille.Height / FacteurArrivéeY)
        End Function

        Private Function UnitéHorizontaleEnPixels(ByVal Unité As GraphicsUnit) As Double
            Select Case Unité
                Case GraphicsUnit.Display
                    Return UnitéHorizontaleEnPixels(GraphicsUnit.Inch) / 100
                Case GraphicsUnit.Document
                    Return UnitéHorizontaleEnPixels(GraphicsUnit.Inch) / 300
                Case GraphicsUnit.Point
                    Return UnitéHorizontaleEnPixels(GraphicsUnit.Inch) / 72
                Case GraphicsUnit.Pixel
                    Return 1
                Case GraphicsUnit.Inch
                    Return LogPixelsX
                Case GraphicsUnit.Millimeter
                    Return UnitéHorizontaleEnPixels(GraphicsUnit.Inch) / 25.4
                Case GraphicsUnit.World
                    Return 1
            End Select
        End Function

        Private Function UnitéVerticaleEnPixels(ByVal Unité As GraphicsUnit) As Double
            Select Case Unité
                Case GraphicsUnit.Display
                    Return UnitéVerticaleEnPixels(GraphicsUnit.Inch) / 100
                Case GraphicsUnit.Document
                    Return UnitéVerticaleEnPixels(GraphicsUnit.Inch) / 300
                Case GraphicsUnit.Point
                    Return UnitéVerticaleEnPixels(GraphicsUnit.Inch) / 72
                Case GraphicsUnit.Pixel
                    Return 1
                Case GraphicsUnit.Inch
                    Return LogPixelsY
                Case GraphicsUnit.Millimeter
                    Return UnitéVerticaleEnPixels(GraphicsUnit.Inch) / 25.4
                Case GraphicsUnit.World
                    Return 1
            End Select
        End Function

        ''' <summary>
        ''' Résolution d'impression horizontale et verticale en pixels par pouce
        ''' </summary>
        ReadOnly Property RésolutionEnPixelsParPouces() As Size
            Get
                Return New Size(LogPixelsX, LogPixelsY)
            End Get
        End Property

        ''' <summary>
        ''' Marge physique en haut et à gauche en pixels d'impression
        ''' </summary>
        Private ReadOnly Property MargePhysiqueHautGaucheEnPixels() As Size
            Get
                Return New Size(PhysicalOffsetX, PhysicalOffsetY)
            End Get
        End Property

        ''' <summary>
        ''' Marge physique en bas et à droite en pixels d'impression
        ''' </summary>
        Private ReadOnly Property MargePhysiqueBasDroiteEnPixels() As Size
            Get
                Return New Size(PhysicalWidth - HorzRes - PhysicalOffsetX, PhysicalHeight - VertRes - PhysicalOffsetY)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la zone imprimable maximale, déterminée par les marges
        ''' physiques d'impression, en pixels d'impression
        ''' </summary>
        Private ReadOnly Property TailleZoneImprimablePhysiqueEnPixels() As Size
            Get
                Return New Size(HorzRes, VertRes)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la page en pixels d'impression (une partie n'est
        ''' pas imprimable)
        ''' </summary>
        Private ReadOnly Property TaillePageEnPixels() As Size
            Get
                Return New Size(PhysicalWidth, PhysicalHeight)
            End Get
        End Property

        ''' <summary>
        ''' Marge physique en haut et à gauche.
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé
        ''' dans l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        ReadOnly Property MargePhysiqueHautGauche() As SizeF
            Get
                Return MargePhysiqueHautGauche(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Marge physique en bas et à droite.
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé 
        ''' dans l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        ReadOnly Property MargePhysiqueBasDroite() As SizeF
            Get
                Return MargePhysiqueBasDroite(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la zone imprimable maximale, déterminée par les marges
        ''' physiques d'impression.
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé dans 
        ''' l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        ReadOnly Property TailleImprimable() As SizeF
            Get
                Return TailleImprimable(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la page (une partie n'est pas imprimable).
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé 
        ''' dans l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        ReadOnly Property TaillePage() As SizeF
            Get
                Return TaillePage(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Coordonnées du coin en haut à gauche de la zone imprimable
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé 
        ''' dans l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        Private ReadOnly Property OrigineImprimable() As PointF
            Get
                Return OrigineImprimable(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Rectangle imprimable.
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé 
        ''' dans l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        ReadOnly Property RectangleImprimable() As RectangleF
            Get
                Return RectangleImprimable(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Rectangle de la page (une partie n'est pas imprimable).
        ''' Si vous ne précisez pas d'unité, le résultat sera exprimé 
        ''' dans l'unité sélectionnée pour l'object Graphics.
        ''' </summary>
        ReadOnly Property RectanglePage() As RectangleF
            Get
                Return RectanglePage(Surface.PageUnit)
            End Get
        End Property

        ''' <summary>
        ''' Marge physique en haut et à gauche.
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        ReadOnly Property MargePhysiqueHautGauche(ByVal Unité As GraphicsUnit) As SizeF
            Get
                Return ConvertirDepuisPixels(MargePhysiqueHautGaucheEnPixels, Unité)
            End Get
        End Property

        ''' <summary>
        ''' Marge physique en bas et à droite.
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        ReadOnly Property MargePhysiqueBasDroite(ByVal Unité As GraphicsUnit) As SizeF
            Get
                Return ConvertirDepuisPixels(MargePhysiqueBasDroiteEnPixels, Unité)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la zone imprimable maximale, déterminée par les marges
        ''' physiques d'impression.
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        ReadOnly Property TailleImprimable(ByVal Unité As GraphicsUnit) As SizeF
            Get
                Return ConvertirDepuisPixels(TailleZoneImprimablePhysiqueEnPixels, Unité)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la page (une partie n'est pas imprimable).
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        ReadOnly Property TaillePage(ByVal Unité As GraphicsUnit) As SizeF
            Get
                Return ConvertirDepuisPixels(TaillePageEnPixels, Unité)
            End Get
        End Property

        ''' <summary>
        ''' Coordonnées du coin en haut à gauche de la zone imprimable
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        Private ReadOnly Property OrigineImprimable(ByVal Unité As GraphicsUnit) As PointF
            Get
                If TypeImpression = Printing.PrintAction.PrintToPrinter Then
                    Return New PointF(0, 0)
                Else
                    With MargePhysiqueHautGauche(Unité)
                        Return New PointF(.Width, .Height)
                    End With
                End If
            End Get
        End Property

        ''' <summary>
        ''' Rectangle imprimable.
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        ReadOnly Property RectangleImprimable(ByVal Unité As GraphicsUnit) As RectangleF
            Get
                Dim Origine As PointF = OrigineImprimable(Unité)
                Dim LaTailleImprimable As SizeF = TailleImprimable(Unité)
                Return New RectangleF(Origine.X, Origine.Y, LaTailleImprimable.Width, LaTailleImprimable.Height)
            End Get
        End Property

        ''' <summary>
        ''' Rectangle de la page (une partie n'est pas imprimable).
        ''' Vous pouvez préciser l'unité de mesure.
        ''' </summary>
        ReadOnly Property RectanglePage(ByVal Unité As GraphicsUnit) As RectangleF
            Get
                Dim Origine As PointF = OrigineImprimable(Unité)
                Dim LaMargeHautGauche As SizeF = MargePhysiqueHautGauche(Unité)
                Dim LaTailleDePage As SizeF = TaillePage(Unité)
                Return New RectangleF(Origine.X - LaMargeHautGauche.Width, Origine.Y - LaMargeHautGauche.Height, LaTailleDePage.Width, LaTailleDePage.Height)
            End Get
        End Property

        ''' <summary>
        ''' Unité sélectionnée. Reflète la propriété PageUnit de l'objet Graphics.
        ''' </summary>
        Property Unité() As GraphicsUnit
            Get
                Return Surface.PageUnit
            End Get
            Set(ByVal value As GraphicsUnit)
                Surface.PageUnit = value
            End Set
        End Property

        ''' <summary>
        ''' Centimètre exprimé dans l'unité de mesure sélectionnée pour l'objet Graphics.
        ''' </summary>
        ReadOnly Property Centimètre() As SizeF
            Get
                Return Convertir(New SizeF(10, 10), GraphicsUnit.Millimeter, Unité)
            End Get
        End Property

        ''' <summary>
        ''' Contruit un rectangle de zone d'impression en utilisant les 
        ''' marges spécifiées en centimètres.
        ''' </summary>
        ''' <param name="AjusterImprimable">Ajuster la zone d'impression pour 
        ''' qu'elle tienne dans la partie physiquement imprimable de la page. 
        ''' Si les marges sont trop petites elles seront augmentées.</param>
        Function ConstruireRectangleAvecMargesEnCm(ByVal MargeGaucheEnCm As Single, ByVal MargeHautEnCm As Single, _
           ByVal MargeDroiteEnCm As Single, ByVal MargeBasEnCm As Single, _
           Optional ByVal AjusterImprimable As Boolean = True) As RectangleF
            Dim LaPage As RectangleF = RectanglePage
            Dim Cm As SizeF = Centimètre
            Dim CoinHautGauche As New PointF(LaPage.X + MargeGaucheEnCm * Cm.Width, LaPage.Y + MargeHautEnCm * Cm.Height)
            Dim CoinBasDroite As New PointF(LaPage.Right - MargeDroiteEnCm * Cm.Width, _
                    LaPage.Bottom - MargeBasEnCm * Cm.Height)

            If AjusterImprimable Then
                Dim Imprimable As RectangleF = RectangleImprimable
                If CoinHautGauche.X < Imprimable.Left Then CoinHautGauche.X = Imprimable.Left
                If CoinHautGauche.Y < Imprimable.Top Then CoinHautGauche.Y = Imprimable.Top
                If CoinBasDroite.X > Imprimable.Right Then CoinBasDroite.X = Imprimable.Right
                If CoinBasDroite.Y > Imprimable.Bottom Then CoinBasDroite.Y = Imprimable.Bottom
            End If

            Dim Taille As New SizeF(CoinBasDroite.X - CoinHautGauche.X, _
                 CoinBasDroite.Y - CoinHautGauche.Y)
            If Taille.Width <= 0 Or _
               Taille.Height <= 0 Then
                Return RectangleF.Empty
            End If
            Return New RectangleF(CoinHautGauche.X, CoinHautGauche.Y, Taille.Width, Taille.Height)
        End Function

        ''' <summary>
        ''' Contruit un rectangle de zone d'impression en utilisant les 
        ''' marges spécifiées en centimètres.
        ''' </summary>
        ''' <param name="AjusterImprimable">Ajuster la zone d'impression pour 
        ''' qu'elle tienne dans la partie physiquement imprimable de la page. 
        ''' Si les marges sont trop petites elles seront augmentées.</param>
        Function ConstruireRectangleAvecMargesEnCm(ByVal MargesHautGaucheEnCm As SizeF, _
           ByVal MargesBasDroiteEnCm As SizeF, _
           Optional ByVal AjusterImprimable As Boolean = True) As RectangleF
            Return ConstruireRectangleAvecMargesEnCm(MargesHautGaucheEnCm.Width, MargesHautGaucheEnCm.Height, _
              MargesBasDroiteEnCm.Width, MargesBasDroiteEnCm.Height, AjusterImprimable)
        End Function

        ''' <summary>
        ''' Instancie une classe pour avoir des informations de mesure sur la page d'impression
        ''' </summary>
        ''' <param name="e">Evénement d'impression de page</param>
        Public Sub New(ByVal e As Printing.PrintPageEventArgs, ByVal UnTypeImpression As Printing.PrintAction)
            Surface = e.Graphics
            TypeImpression = UnTypeImpression
            Dim hDC As IntPtr = Surface.GetHdc()
            LogPixelsX = GetDeviceCaps(hDC, Cap_LogPixelsX)
            LogPixelsY = GetDeviceCaps(hDC, Cap_LogPixelsY)
            PhysicalWidth = GetDeviceCaps(hDC, Cap_PhysicalWidth)
            PhysicalHeight = GetDeviceCaps(hDC, Cap_PhysicalHeight)
            PhysicalOffsetX = GetDeviceCaps(hDC, Cap_PhysicalOffsetX)
            PhysicalOffsetY = GetDeviceCaps(hDC, Cap_PhysicalOffsetY)
            HorzRes = GetDeviceCaps(hDC, Cap_HorzRes)
            VertRes = GetDeviceCaps(hDC, Cap_VertRes)
            Surface.ReleaseHdc(hDC)
        End Sub

    End Class

    ''' <summary>
    ''' Classe permettant de dessiner du texte plus facilement et
    ''' en évitant les problèmes de mesures et les bugs du framework
    ''' quand on change d'unité. Cette classe peut être
    ''' dérivée pour ajouter des mises en forme plus élaborées.
    ''' </summary>
    Public Class OutilsTexte

        Private SurfaceInterne As Graphics
        Private LaMesure As MesureImpression
        ''' <summary>
        ''' Crée un nouvel outil de texte avec de l'Arial 12.
        ''' </summary>
        Sub New(ByVal UneSurface As Graphics, ByVal Mesure As MesureImpression)
            SurfaceInterne = UneSurface
            LaMesure = Mesure
            Police = New Font("Arial", 12)
        End Sub

        ''' <summary>
        ''' Crée un nouvel outil de texte avec la police spécifiée
        ''' </summary>
        Sub New(ByVal UneSurface As Graphics, ByVal Mesure As MesureImpression, ByVal UnePolice As Font)
            SurfaceInterne = UneSurface
            LaMesure = Mesure
            Police = UnePolice
        End Sub

        Private EstSouligné As Boolean
        Private ValeurPolice As Font
        ''' <summary>
        ''' Police de caractère à utiliser
        ''' </summary>
        Property Police() As Font
            Get
                If EstSouligné Then
                    Return New Font(ValeurPolice, ValeurPolice.Style Or FontStyle.Underline)
                Else
                    Return ValeurPolice
                End If
            End Get
            Set(ByVal value As Font)
                If (value.Style And FontStyle.Underline) <> 0 Then
                    ValeurPolice = New Font(value, value.Style - FontStyle.Underline)
                    EstSouligné = True
                Else
                    ValeurPolice = value
                    EstSouligné = False
                End If
            End Set
        End Property

        ''' <summary>
        ''' Hauteur du texte sans la marge en bas. C'est la valeur
        ''' qui est renvoyée par la fonction Mesurer. Elle est
        ''' égale à la somme de PartieHaute et de PartieBasse.
        ''' </summary>
        ReadOnly Property HauteurSansMarge() As Single
            Get
                Return HauteurAvecMarge - MargeEnBas
            End Get
        End Property

        ''' <summary>
        ''' Marge au bas du texte. Elle n'est pas incluse dans la
        ''' hauteur renvoyée par la fonction Mesurer.
        ''' </summary>
        ReadOnly Property MargeEnBas() As Single
            Get
                If SurfaceInterne Is Nothing Then Return 0
                Dim f As FontFamily = ValeurPolice.FontFamily
                Dim s As FontStyle = ValeurPolice.Style
                Dim Proportion As Single = (f.GetLineSpacing(s) - f.GetCellAscent(s) - f.GetCellDescent(s)) / f.GetLineSpacing(s)
                Return Proportion * HauteurAvecMarge
            End Get
        End Property

        ''' <summary>
        ''' Hauteur d'une ligne de texte. Elle est égale à la 
        ''' somme de PartieHaute, PartieBasse et MargeEnBas.
        ''' </summary>
        ReadOnly Property HauteurAvecMarge() As Single
            Get
                If SurfaceInterne Is Nothing Then Return 0
                Return ValeurPolice.GetHeight(SurfaceInterne)
            End Get
        End Property

        ''' <summary>
        ''' Taille de la partie haute du texte, c'est-à-dire du
        ''' haut de la ligne jusqu'à la ligne de pied, sur laquelle
        ''' sont posés les caractères.
        ''' </summary>
        ReadOnly Property PartieHaute() As Single
            Get
                With ValeurPolice.FontFamily
                    Dim Proportion As Single
                    Proportion = .GetCellAscent(ValeurPolice.Style) / .GetLineSpacing(ValeurPolice.Style)
                    Return Proportion * HauteurAvecMarge
                End With
            End Get
        End Property

        ''' <summary>
        ''' Taille de la partie basse du texte, c'est-à-dire depuis
        ''' la ligne de pied, sur laquelle sont posés les caractères,
        ''' jusqu'en bas du texte. Ne contient pas la marge en bas. 
        ''' </summary>
        ReadOnly Property PartieBasse() As Single
            Get
                With ValeurPolice.FontFamily
                    Dim Proportion As Single
                    Proportion = .GetCellDescent(ValeurPolice.Style) / .GetLineSpacing(ValeurPolice.Style)
                    Return Proportion * HauteurAvecMarge
                End With
            End Get
        End Property

        ''' <summary>
        ''' Ecrit une chaine de caractère à l'emplacement spécifié et avec le pinceau spécifié
        ''' </summary>
        Sub Ecrire(ByVal X As Single, ByVal Y As Single, ByVal Texte As String, ByVal Pinceau As Brush)
            If EstSouligné Then
                Souligné(X, Y, Texte, Pinceau)
                Return
            End If
            If SurfaceInterne Is Nothing Then Exit Sub
            SurfaceInterne.DrawString(Texte, ValeurPolice, Pinceau, X, Y, StringFormat.GenericTypographic)
        End Sub

        ''' <summary>
        ''' Ecrit et souligne une chaine de caractère à l'emplacement spécifié et avec le pinceau spécifié.
        ''' Evite le bug du framework quand on change l'unité de mesure.
        ''' </summary>
        Sub Souligné(ByVal X As Single, ByVal Y As Single, ByVal Texte As String, ByVal Pinceau As Brush)
            If SurfaceInterne Is Nothing Then Exit Sub
            SurfaceInterne.DrawString(Texte, ValeurPolice, Pinceau, X, Y, StringFormat.GenericTypographic)

            Dim Longueur As Single = Mesurer(Texte).Width
            Dim Epaisseur As Single = EpaisseurTrait
            SurfaceInterne.FillRectangle(Pinceau, _
                     X, Y + PartieHaute + Epaisseur * 1.2F, _
                     Longueur, Epaisseur)
        End Sub

        ''' <summary>
        ''' Epaisseur de trait pour le style souligné
        ''' </summary>
        ReadOnly Property EpaisseurTrait() As Single
            Get
                Return LaMesure.Convertir(New SizeF(0, ValeurPolice.SizeInPoints / 14.5), GraphicsUnit.Point, LaMesure.Unité).Height
            End Get
        End Property

        ''' <summary>
        ''' Mesure le dessin d'une chaîne de caractère
        ''' </summary>
        Function Mesurer(ByVal Texte As String) As SizeF
            If SurfaceInterne Is Nothing Then Return New SizeF(0, 0)
            Return SurfaceInterne.MeasureString(Texte, ValeurPolice, New PointF(0, 0), StringFormat.GenericTypographic)
        End Function

        ''' <summary>
        ''' Crée un nouvel objet d'écriture de texte avec les mêmes
        ''' paramètres que cet objet.
        ''' </summary>
        Function Dupliquer() As OutilsTexte
            Return New OutilsTexte(SurfaceInterne, LaMesure, Police)
        End Function

    End Class

End Class

Conclusion :


Les bugs contournés sont les suivants : problèmes d'unité des marges (Margins) avec la boite d'aperçu d'impression (PageSetupDialog), décalage des coordonnées entre l'aperçu et l'impression réelle (PageBounds), la question de la mesure des textes (MeasureString), le bug de l'écriture soulignée quand on change d'unité de mesure, et des fonctions de conversions entre millimètres, pouces et pixels.

La classe utilise la fonction GetDeviceCaps de la librairie gdi32.dll et donne toutes les mesures avec des mots en français et dans l'unité voulue, que ce soit en millimètres, en pouces ou en pixels d'impression.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Tarelaque Messages postés 3 Date d'inscription jeudi 14 avril 2011 Statut Membre Dernière intervention 3 mai 2011
18 avril 2011 à 14:06
Salut a tous et merci pour le code !!

Mais j'aurais voulu savoir si c'était possible de n'avoir qu'une seule fenêtre qui s'ouvre pour pouvoir programmer les juste le format et les marges ???

Si oui pouvez vous me donner le code svp

merci d'avance
cs_Willi Messages postés 2375 Date d'inscription jeudi 12 juillet 2001 Statut Modérateur Dernière intervention 15 décembre 2018 22
3 nov. 2009 à 20:16
J'ai aucun soucis avec ces bugs. Néanmois je note 7 pour le côté utile et simple
Tu ne sera pas être le seul à rencontré ces bugs je pense merci du partage !
Bonne continuation.
vitemassou Messages postés 12 Date d'inscription mercredi 14 avril 2004 Statut Membre Dernière intervention 7 mars 2012
3 nov. 2009 à 11:26
Pas mal du tout !
Je vais mettre ça à profit assez rapidement.

Merci pour cette source.
circular Messages postés 17 Date d'inscription vendredi 22 juin 2007 Statut Membre Dernière intervention 27 mars 2010
3 nov. 2009 à 10:39
J'en ai fait la liste dans la partie Conclusion.
cs_Willi Messages postés 2375 Date d'inscription jeudi 12 juillet 2001 Statut Modérateur Dernière intervention 15 décembre 2018 22
3 nov. 2009 à 08:31
Bonne source ! Mais quelles sont les "bugs" du framework ??
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (circular)