Dispositif d'aide à l'impression.
Soyez le premier à donner votre avis sur cette source.
Vue 5 072 fois - Téléchargée 1 007 fois
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.
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
Codes Sources
A voir également
- Gestion de dispositifs d'impression
- Originatmargins - Meilleures réponses
- Code impression visual basic - Forum - VB.NET
- Imprimer fichier texte ✓ - Forum - VB.NET
- Aperçu avant impression userform vba ✓ - Forum - Visual Basic 6
- MARGE IMPRESSION - Forum - Visual Basic
- Impression d'un formulaire dans VB express 2010 - Forum - VB.NET
Commentaire
Il est souhaitable que tu envoies le fichier ZIP
MERCI
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.