Dispositif d'aide à l'impression.

Soyez le premier à donner votre avis sur cette source.

Vue 4 416 fois - Téléchargée 878 fois

Télécharger le projet
Commenter

Description

Ce code se présente comme une application composée d'un formulaire nommé Accueil et d'un module standard nommé Impression. Ce dernier possède deux propriétés publiques,
Prt As PrintDocument,
Évt As PrintPageEventArgs,
qui doivent être renseignées par l'utilisateur. Dès que cela est fait, le module Impression peut être exploité par cet utilisateur. Dans l'application, ce dernier est représenté par le formulaire.
L'interface du module Impression propose deux formes d'aide,
a) Les commandes d'impression,
b) Les procédures de dessin.
Sauf omission de ma part, les commandes d'impression forment un ensemble complet. Ce n'est par contre pas le cas des procédures de dessin, que j'ai écrites au fur et à mesure de mes propres besoins. Bien entendu je modifierais le code dès que j'en écrirais d'autres. Mais ne comptez pas trop là dessus vu mon âge avancé. Bien sûr, vous pouvez ajouter des procédures de dessin pour votre propre usage.

Nota. Dans le code qui suit, bImp et bFoc sont deux boutons de commande.

Source / Exemple : 


Imports System.Drawing.Printing
Imports System.Drawing.Color
Public Class Accueil
    Private Prt As New PrintDocument, i As Integer = 1

    Private Sub Accueil_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        AddHandler Prt.PrintPage, AddressOf Me.Prt_PrintPage
        Impression.Prt = Prt
    End Sub

    Private Sub Prt_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
        Impression.Évt = e
        Select Case i
            Case 1
                DesRctC(0, 0, 20, 20, 0.5, Color.Red)
                DesRctP(25, 25, 20, 20, Color.Yellow)
                OkPge = True : i = i + 1
            Case 2
                DesRctPC(50, 50, 20, 20, 0.5, Color.Red, Color.Yellow)
                DesTrt(0, 0, 50, 50, 3, Color.Blue)
                OkPge = True : i = i + 1
            Case 3
                Dim Stl As New FontStyle
                Stl = StyleFonte("GISB") : DesTxt(0, 80, "Toto, manges ta soupe", "Times New Roman", 10, Stl, Color.Black)
                'MsgBox(LrgTxt("Toto, manges ta soupe", "Times New Roman", 10, Stl).ToString)
                'MsgBox(HtrTxt("Toto, manges ta soupe", "Times New Roman", 10, Stl).ToString)
                OkPge = False
            Case Else
        End Select
    End Sub

    Private Sub bImp_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles bImp.Click
        OkMrg = True
        OkHrz = False
        MrgG = 20
        MrgH = 20
        RectoVerso = "DuplexV"
        Bac = Bacs(0)
        Imprimer()
        Finir()
        bFoc.Focus()
        Close()
    End Sub

End Class

Imports System.Drawing.Printing
Imports System.Drawing.Color
Imports System.String
Imports System.Media.SystemSounds
Module Impression
    Public Prt As PrintDocument
    Private Grp As Graphics
    Private Const k As Double = 0.254
    Private Crn As New Pen(Color.Black, 1)
    Private Pnc As New SolidBrush(Color.White)
    Dim Fnt As New Font("Times New Roman", 10)
    Private _Évt As PrintPageEventArgs

    Public Property Évt As PrintPageEventArgs
        Get
            Return _Évt
        End Get
        Set(ByVal nÉvt As PrintPageEventArgs)
            _Évt = nÉvt : Grp = Évt.Graphics
        End Set
    End Property

    'COMMANDES D'IMPRESSION

    ''' <summary>
    ''' Obtient la largeur du document, exprimée en millimètres.
    ''' </summary>
    Public ReadOnly Property Lrg As Double
        Get
            Return k * Prt.DefaultPageSettings.PaperSize.Width
        End Get
    End Property

    ''' <summary>
    ''' Obtient la hauteur du document, exprimée en millimètres.
    ''' </summary>
    Public ReadOnly Property Htr As Double
        Get
            Return k * Prt.DefaultPageSettings.PaperSize.Height
        End Get
    End Property

    ''' <summary>
    ''' Obtient les deux marges physiques horizontales de l'imprimante, exprimées en millimètres.
    ''' </summary>
    Public ReadOnly Property MrgX As Double
        Get
            Return k * Prt.DefaultPageSettings.HardMarginX
        End Get
    End Property

    ''' <summary>
    ''' Obtient les deux marges physiques verticales de l'imprimante, exprimées en millimètres.
    ''' </summary>
    Public ReadOnly Property MrgY As Double
        Get
            Return k * Prt.DefaultPageSettings.HardMarginY
        End Get
    End Property

    ''' <summary>
    ''' Obtient ou définit la marge-utilisateur gauche, exprimée en millimètres.
    ''' </summary>
    Public Property MrgG As Double
        Get
            Return k * Prt.DefaultPageSettings.Margins.Left
        End Get
        Set(ByVal Mrg As Double)
            Prt.DefaultPageSettings.Margins.Left = F(Mrg)
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit la marge-utilisateur droite, exprimée en millimètres.
    ''' </summary>
    Public Property MrgD As Double
        Get
            Return k * Prt.DefaultPageSettings.Margins.Right
        End Get
        Set(ByVal Mrg As Double)
            Prt.DefaultPageSettings.Margins.Right = F(Mrg)
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit la marge-utilisateur haute, exprimée en millimètres.
    ''' </summary>
    Public Property MrgH As Double
        Get
            Return k * Prt.DefaultPageSettings.Margins.Top
        End Get
        Set(ByVal Mrg As Double)
            Prt.DefaultPageSettings.Margins.Top = F(Mrg)
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit la marge-utilisateur basse, exprimée en millimètres.
    ''' </summary>
    Public Property MrgB As Double
        Get
            Return k * Prt.DefaultPageSettings.Margins.Bottom
        End Get
        Set(ByVal Mrg As Double)
            Prt.DefaultPageSettings.Margins.Bottom = F(Mrg)
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit un booléen indiquant si les marges-utilisateur sont préférées aux marges physiques.
    ''' </summary>
    Public Property OkMrg As Boolean
        Get
            Return Prt.OriginAtMargins
        End Get
        Set(ByVal Ok As Boolean)
            Prt.OriginAtMargins = Ok
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit un booléen indiquant si l'orientation paysage est préférée au portrait.
    ''' </summary>
    Public Property OkHrz As Boolean
        Get
            Return Prt.DefaultPageSettings.Landscape
        End Get
        Set(ByVal Ok As Boolean)
            Prt.DefaultPageSettings.Landscape = Ok
        End Set
    End Property

    ''' <summary>
    ''' Obtient la liste des bacs de l'imprimante.
    ''' </summary>
    Public ReadOnly Property Bacs As PaperSource()
        Get
            Dim i As Integer, n As Integer, Lst() As PaperSource
            With Prt.PrinterSettings.PaperSources
                n = .Count - 1 : ReDim Lst(n)
                For i = 0 To n
                    Lst(i) = .Item(i)
                Next i
            End With
            Return Lst
        End Get
    End Property

    ''' <summary>
    ''' Obtient ou définit le bac d'imprimante sélectionné par l'utilisateur.
    ''' </summary>
    Public Property Bac As PaperSource
        Get
            Return Prt.DefaultPageSettings.PaperSource
        End Get
        Set(ByVal nBac As PaperSource)
            Prt.DefaultPageSettings.PaperSource = nBac
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit un booléen indiquant si la couleur est préférée au noir et blanc, si toutefois le choix est possible.
    ''' Cette propriété semble inopérante.
    ''' </summary>
    Public Property OkClr As Boolean
        Get
            Return Prt.DefaultPageSettings.Color
        End Get
        Set(ByVal Ok As Boolean)
            If Prt.PrinterSettings.SupportsColor Then
                Prt.DefaultPageSettings.Color = Ok
            Else
                Prt.DefaultPageSettings.Color = False
                MessageBox.Show("Cette imprimante ne dispose pas de la couleur")
            End If
        End Set
    End Property

    ''' <summary>
    ''' Obtient ou définit un String indiquant la configuration de l'éventuel recto-verso. 
    ''' "Simplex" pour non. "DuplexV" pour oui, verticalement. "DuplexH" pour oui, horizontalement.
    ''' </summary>
    Public Property RectoVerso As String
        Get
            Dim Str As String = ""
            Select Case Prt.PrinterSettings.Duplex
                Case CType(-1, Duplex) : Str = "Pardéfaut"
                Case CType(1, Duplex) : Str = "Simplex"
                Case CType(2, Duplex) : Str = "DuplexV"
                Case CType(3, Duplex) : Str = "DuplexH"
                Case Else : Beep.Play()
            End Select
            Return Str
        End Get
        Set(ByVal Txt As String)
            If Prt.PrinterSettings.CanDuplex Then
                Select Case Txt
                    Case "Simplex" : Prt.PrinterSettings.Duplex = CType(1, Duplex)
                    Case "DuplexV" : Prt.PrinterSettings.Duplex = CType(2, Duplex)
                    Case "DuplexH" : Prt.PrinterSettings.Duplex = CType(3, Duplex)
                    Case Else : Beep.Play()
                End Select
            Else
                MessageBox.Show("Cette imprimante ne dispose pas du recto-verso")
            End If
        End Set
    End Property

    ''' <summary>
    ''' Déclenche l'impression.
    ''' </summary>
    Public Sub Imprimer()
        Prt.Print()
    End Sub

    ''' <summary>
    ''' Obtient ou définit un booléen indiquant s'il y a lieu d'ajouter une page.
    ''' </summary>
    Public Property OkPge As Boolean
        Get
            Return Évt.HasMorePages
        End Get
        Set(ByVal Ok As Boolean)
            Évt.HasMorePages = Ok
        End Set
    End Property

    ''' <summary>
    ''' Libère la ressource Prt.
    ''' </summary>
    Public Sub Finir()
        Prt.Dispose()
    End Sub

    'PROCÉDURES DE DESSIN

    ''' <summary>
    ''' Dessine un trait orienté. Toutes les cotes sont exprimées en millimètres. 
    ''' Les coordonnées du point de départ sont x et y. 
    ''' Les coordonnées du point d'arrivée sont x + dx et y + dy. 
    ''' L'épaisseur et la couleur du crayon sont Eps et ClrC.
    ''' </summary>
    Public Sub DesTrt(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal dy As Double, ByVal Eps As Double, ByVal ClrC As Color)
        With Crn
            .Width = G(Eps)
            .Color = ClrC
        End With
        Grp.DrawLine(Crn, F(x), F(y), F(x + dx), F(y + dy))
    End Sub

    ''' <summary>
    ''' Dessine un trait orienté horizontal. Toutes les cotes sont exprimées en millimètres. 
    ''' Les coordonnées du point de départ sont x et y. 
    ''' Les coordonnées du point d'arrivée sont x + dx et y. 
    ''' L'épaisseur et la couleur du crayon sont Eps et ClrC.
    ''' </summary>
    Public Sub DesTrtH(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal Eps As Double, ByVal ClrC As Color)
        With Crn
            .Width = G(Eps)
            .Color = ClrC
        End With
        Grp.DrawLine(Crn, F(x), F(y), F(x + dx), F(y))
    End Sub

    ''' <summary>
    ''' Dessine un trait orienté vertical. Toutes les cotes sont exprimées en millimètres.
    ''' Les coordonnées du point de départ sont x et y. 
    ''' Les coordonnées du point d'arrivée sont x et y + dy. 
    ''' L'épaisseur et la couleur du crayon sont Eps et ClrC.
    ''' </summary>
    Public Sub DesTrtV(ByVal x As Double, ByVal y As Double, ByVal dy As Double, ByVal Eps As Double, ByVal ClrC As Color)
        With Crn
            .Width = G(Eps)
            .Color = ClrC
        End With
        Grp.DrawLine(Crn, F(x), F(y), F(x), F(y + dy))
    End Sub

    ''' <summary>
    ''' Dessine un rectangle vide. Toutes les cotes sont exprimées en millimètres. 
    ''' Les coordonnées du coin supérieur gauche sont x et y. 
    ''' La largeur et la hauteur du rectangle sont dx et dy. 
    ''' L'épaisseur et la couleur du crayon sont Eps et ClrC.
    ''' </summary>
    Public Sub DesRctC(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal dy As Double, ByVal Eps As Double, ByVal ClrC As Color)
        With Crn
            .Width = G(Eps)
            .Color = ClrC
        End With
        Grp.DrawRectangle(Crn, F(x), F(y), F(dx), F(dy))
    End Sub

    ''' <summary>
    ''' Dessine un rectangle plein sans bord. Toutes les cotes sont exprimées en millimètres. 
    ''' Les coordonnées du coin supérieur gauche sont x et y. 
    ''' La largeur et la hauteur du rectangle sont dx et dy. 
    ''' La couleur du pinceau est ClrP.
    ''' </summary>
    Public Sub DesRctP(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal dy As Double, ByVal ClrP As Color)
        Pnc.Color = ClrP
        Grp.FillRectangle(Pnc, F(x), F(y), F(dx), F(dy))
    End Sub

    ''' <summary>
    ''' Dessine un rectangle plein avec bord. Toutes les cotes sont exprimées en millimètres. 
    ''' Les coordonnées du coin supérieur gauche sont x et y. 
    ''' La largeur et la hauteur du rectangle sont dx et dy. 
    ''' L'épaisseur et la couleur du crayon sont Eps et ClrC. 
    ''' La couleur du pinceau est ClrP.
    ''' </summary>
    Public Sub DesRctPC(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal dy As Double, ByVal Eps As Double, ByVal ClrC As Color, ByVal ClrP As Color)
        Pnc.Color = ClrP
        With Crn
            .Width = G(Eps)
            .Color = ClrC
        End With
        Grp.FillRectangle(Pnc, F(x), F(y), F(dx), F(dy))
        Grp.DrawRectangle(Crn, F(x), F(y), F(dx), F(dy))
    End Sub

    ''' <summary>
    ''' Dessine un texte Txt. Toutes les cotes sont exprimées en millimètres. La taille de la fonte est exprimée en points.
    ''' Les coordonnées du coin supérieur gauche du rectangle occupé par dessin du texte sont x et y. 
    ''' Le nom, la taille, et le style de la fonte sont Nom, Tle, et Stl. 
    ''' La couleur du pinceau est ClrP.
    ''' </summary>
    Public Sub DesTxt(ByVal x As Double, ByVal y As Double, ByVal Txt As String, ByVal Nom As String, ByVal Tle As Double, ByVal Stl As FontStyle, ByVal ClrP As Color)
        Dim Fnt As New Font(Nom, CSng(Tle), Stl)
        Pnc.Color = ClrP
        Grp.DrawString(Txt, Fnt, Pnc, F(x), F(y))
    End Sub

    ''' <summary>
    ''' Obtient la largeur du texte Txt. Toutes les cotes sont exprimées en millimètres. La taille de la fonte est exprimée en points. 
    ''' Le nom, la taille, et le style de la fonte sont Nom, Tle, et Stl.
    ''' </summary>
    Public Function LrgTxt(ByVal Txt As String, ByVal Nom As String, ByVal Tle As Double, ByVal Stl As FontStyle) As Double
        Dim Lrg As Double, Fnt As New Font(Nom, CSng(Tle), Stl)
        Lrg = Grp.MeasureString(Txt, Fnt).Width * k
        Return Lrg
    End Function

    ''' <summary>
    ''' Obtient la hauteur du texte Txt. Toutes les cotes sont exprimées en millimètres. La taille de la fonte est exprimée en points. 
    ''' Le nom, la taille, et le style de la fonte sont Nom, Tle, et Stl.
    ''' </summary>
    Public Function HtrTxt(ByVal Txt As String, ByVal Nom As String, ByVal Tle As Double, ByVal Stl As FontStyle) As Double
        Dim Htr As Double, Fnt As New Font(Nom, CSng(Tle), Stl)
        Htr = Grp.MeasureString(Txt, Fnt).Height * k
        Return Htr
    End Function

    ''' <summary>
    ''' Obtient le style d'une fonte en fonction de ses attributs Gras, Italique, Souligné, et Barré.
    ''' </summary>
    Public Function StyleFonte(ByVal Gras As Boolean, ByVal Italique As Boolean, ByVal Souligné As Boolean, ByVal Barré As Boolean) As FontStyle
        Dim Stl As FontStyle
        Stl = FontStyle.Regular
        If Gras Then Stl = Stl Or FontStyle.Bold
        If Italique Then Stl = Stl Or FontStyle.Italic
        If Souligné Then Stl = Stl Or FontStyle.Underline
        If Barré Then Stl = Stl Or FontStyle.Strikeout
        Return Stl
    End Function

    ''' <summary>
    ''' Obtient le style d'une fonte en fonction de ses attributs Gras, Italique, Souligné, et Barré. 
    ''' Chacun de ces attributs est activé par la présence de son initiale dans l'argument Code.
    ''' </summary>
    Public Function StyleFonte(ByVal Code As String) As FontStyle
        Dim Stl As FontStyle
        Stl = FontStyle.Regular
        If Code.Contains("G") Then Stl = Stl Or FontStyle.Bold
        If Code.Contains("I") Then Stl = Stl Or FontStyle.Italic
        If Code.Contains("S") Then Stl = Stl Or FontStyle.Underline
        If Code.Contains("B") Then Stl = Stl Or FontStyle.Strikeout
        Return Stl
    End Function

    Private Function F(ByVal x As Double) As Integer
        Return CInt(x / k)
    End Function

    Private Function G(ByVal x As Double) As Single
        Return CSng(x / k)
    End Function

End Module
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Commenter la réponse de LEPRINCEVB
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 (Zermelo)