Soyez le premier à donner votre avis sur cette source.
Vue 5 360 fois - Téléchargée 1 100 fois
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
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.