Classe d'impression basique (génère aussi un aperçu)

Soyez le premier à donner votre avis sur cette source.

Vue 13 198 fois - Téléchargée 1 079 fois

Description

C'est une petite classe qui permet d'imprimer en toute simplicité : on spécifie quel élément va être placé à quel endroit, et on a plus qu'à lancer l'impression.
Le code n'est pas encore complet...

Source / Exemple :


Option Explicit

Private ImgApp As PictureBox
Private PrinterObj As Object
Private Doc() As ListDoc
Private DocElemCount As Long
Private PageNum As Integer

'Donnée élementaire de base
Private Type ListDoc
    T As Typ
    s As String
    x As Double
    y As Double
    X2 As Double
    Y2 As Double
    FntName As String
    fntSize As Byte
    FntU As Boolean
    FntI As Boolean
    FntB As Boolean
    CenterH As Aligne
    CenterV As AligneV
    ForeColor As Long
    BackColor As Long
End Type

'Type d'élement possibles
Private Enum Typ
    Texte = 1
    Boite = 2
    Cercle = 3
    Image = 4
    Point = 5
    Ligne = 6
    NouvellePage = 7
    OrientationPortrait = 8
    OrientationPaysage = 9
End Enum

'Alignement horizontal
Public Enum Aligne
    Gauche = 1
    Milieu = 2
    Droite = 3
End Enum

'Alignement vertical
Public Enum AligneV
    Haut = 1
    Centre = 2
    Bas = 3
End Enum

'variables locales de stockage des valeurs de propriétés
Private mvarLastTextElementWidth As Double 'copie locale
Private mvarLastTextElementHeight As Double 'copie locale

Public Property Let LastTextElementHeight(ByVal vData As Double)
    mvarLastTextElementHeight = vData
End Property
Public Property Get LastTextElementHeight() As Double
    LastTextElementHeight = mvarLastTextElementHeight
End Property
Public Property Let LastTextElementWidth(ByVal vData As Double)
    mvarLastTextElementWidth = vData
End Property
Public Property Get LastTextElementWidth() As Double
    LastTextElementWidth = mvarLastTextElementWidth
End Property

Public Function AddTextXY(ByVal Txt As String, ByVal x As Double, ByVal y As Double, Optional ByVal CentreH As Aligne = Gauche, Optional ByVal CentreV As AligneV = Haut, Optional ByVal ForeColor As Long = vbBlack, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Byte = 10, Optional ByVal BackColor As Long = vbWhite) As Long
'Ajoute un élément texte dans le buffer
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = Texte
    Doc(DocElemCount).s = Txt
    Doc(DocElemCount).x = x
    Doc(DocElemCount).y = y
    Doc(DocElemCount).CenterH = CentreH
    Doc(DocElemCount).CenterV = CentreV
    Doc(DocElemCount).ForeColor = ForeColor
    Doc(DocElemCount).BackColor = BackColor
    Doc(DocElemCount).FntB = Bold
    Doc(DocElemCount).FntU = UnderLine
    Doc(DocElemCount).FntI = Italic
    Doc(DocElemCount).fntSize = FontSize
    Printer.FontSize = IIf(FontSize <= 0, 1, FontSize)
    Printer.FontBold = Bold
    Printer.FontItalic = Italic
    Printer.FontUnderline = UnderLine
    If Me.NumberOfPrinters > 0 Then
        mvarLastTextElementWidth = Printer.TextWidth(Txt)
        mvarLastTextElementHeight = Printer.TextHeight(Txt)
    End If
    AddTextXY = DocElemCount
End Function

Public Function GetTextWidth(ByVal Txt As String, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Byte = 10) As Double
    If Me.NumberOfPrinters > 0 Then
        Printer.FontSize = FontSize
        Printer.FontBold = Bold
        Printer.FontItalic = Italic
        Printer.FontUnderline = UnderLine
        GetTextWidth = Printer.TextWidth(Txt)
    End If
End Function

Public Function GetTextHeight(ByVal Txt As String, Optional ByVal Bold As Boolean = False, Optional ByVal Italic As Boolean = False, Optional ByVal UnderLine As Boolean = False, Optional ByVal FontSize As Byte = 10) As Double
    If Me.NumberOfPrinters > 0 Then
        Printer.FontSize = IIf(FontSize <= 0, 1, FontSize)
        Printer.FontBold = Bold
        Printer.FontItalic = Italic
        Printer.FontUnderline = UnderLine
        GetTextHeight = Printer.TextHeight(Txt)
    End If
End Function

Public Function CreateDocument() As Boolean
'Efface le buffer
    DocElemCount = 0
    ReDim Doc(DocElemCount)
    CreateDocument = True
    PageNum = 1
    If Me.NumberOfPrinters > 0 Then
        Printer.ScaleMode = vbMillimeters
    End If
End Function

Public Function GenePrintOut(ByVal NombreDeCopies As Byte) As Boolean
'Lance l'impression du buffer dans l'objet correspondant
    Dim x As Double, y As Double, A As Integer
    If DocElemCount > 0 Then
    'Paramètres par défaut du style d'impression
        Printer.Copies = NombreDeCopies
        Printer.ScaleMode = vbMillimeters
        Printer.FillStyle = vbFSSolid
        
        For A = 1 To DocElemCount
            Printer.ForeColor = Doc(A).ForeColor
            Printer.FillColor = Doc(A).BackColor
            Select Case Doc(A).T
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Texte
                    'Centrage horizontal
                    x = Doc(A).x
                    If Doc(A).CenterH = Droite Then x = x - Me.GetTextWidth(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize)
                    If Doc(A).CenterH = Milieu Then x = x - Me.GetTextWidth(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize) / 2
                    Printer.CurrentX = x
                    'Centrage vertical
                    y = Doc(A).y
                    If Doc(A).CenterV = Bas Then y = y - Me.GetTextHeight(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize)
                    If Doc(A).CenterV = Centre Then y = y - Me.GetTextHeight(Doc(A).s, Doc(A).FntB, Doc(A).FntI, Doc(A).FntU, Doc(A).fntSize) / 2
                    Printer.CurrentY = y
                    'Mise en forme
                    Printer.FontBold = Doc(A).FntB
                    Printer.FontItalic = Doc(A).FntI
                    Printer.FontUnderline = Doc(A).FntU
                    Printer.FontSize = IIf(Doc(A).fntSize <= 0, 1, Doc(A).fntSize)
                    Printer.Print Doc(A).s
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Boite
                    Printer.Line (Doc(A).x, Doc(A).y)-Step(Doc(A).X2, Doc(A).Y2), , B
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Cercle
                    Printer.Circle (Doc(A).x, Doc(A).y), Doc(A).X2
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Image
                    If Doc(A).X2 > -1 Or Doc(A).Y2 > -1 Then
                        Printer.PaintPicture LoadPicture(Doc(A).s), Doc(A).x, Doc(A).y, Doc(A).X2, Doc(A).Y2
                    Else
                        Printer.PaintPicture LoadPicture(Doc(A).s), Doc(A).x, Doc(A).y
                    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Point
                    Printer.PSet (Doc(A).x, Doc(A).y), Doc(A).X2
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Ligne
                    Printer.Line (Doc(A).x, Doc(A).y)-Step(Doc(A).X2, Doc(A).Y2), Doc(A).ForeColor
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case NouvellePage
                    Printer.NewPage
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case OrientationPortrait
                    Printer.Orientation = vbPRORPortrait
                    Printer.FontTransparent = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case OrientationPaysage
                    Printer.Orientation = vbPRORLandscape
                    Printer.FontTransparent = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Else
            End Select
        Next A
        Printer.EndDoc
    End If
End Function

Public Function DrawBox(ByVal x As Double, ByVal y As Double, ByVal Width As Double, ByVal Height As Double, Optional ForeColor As Long = vbBlack, Optional BackColor As Long = vbWhite) As Long
'Ajoute une boite colorée
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = Boite
    Doc(DocElemCount).x = x
    Doc(DocElemCount).y = y
    Doc(DocElemCount).X2 = Width
    Doc(DocElemCount).Y2 = Height
    Doc(DocElemCount).ForeColor = ForeColor
    Doc(DocElemCount).BackColor = BackColor
    DrawBox = DocElemCount
End Function

Public Function DrawCircle(ByVal x As Double, ByVal y As Double, ByVal Radius As Double, Optional ForeColor As Long = vbBlack, Optional BackColor As Long = vbWhite) As Long
'Ajoute un cercle
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = Cercle
    Doc(DocElemCount).x = x
    Doc(DocElemCount).y = y
    Doc(DocElemCount).X2 = Radius
    Doc(DocElemCount).ForeColor = ForeColor
    Doc(DocElemCount).BackColor = BackColor
    DrawCircle = DocElemCount
End Function

Public Function DrawPicture(ByVal Picture As String, ByVal x As Double, ByVal y As Double, Optional ByVal Width As Double = -1, Optional Height As Double = -1) As Long
'Ajoute une image
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = Image
    Doc(DocElemCount).s = Picture
    Doc(DocElemCount).x = x
    Doc(DocElemCount).y = y
    Doc(DocElemCount).X2 = Width
    Doc(DocElemCount).Y2 = Height
    DrawPicture = DocElemCount
End Function

Public Function DrawPoint(ByVal x As Double, ByVal y As Double, Optional ByVal Color As Long = vbBlack) As Long
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = Point
    Doc(DocElemCount).x = x
    Doc(DocElemCount).y = y
    Doc(DocElemCount).ForeColor = Color
    DrawPoint = DocElemCount
End Function

Public Function PrinterAreaWidth() As Double
    If Me.NumberOfPrinters > 0 Then
        PrinterAreaWidth = Printer.ScaleWidth
    End If
End Function

Public Function PrinterAreaHeight() As Double
    If Me.NumberOfPrinters > 0 Then
        PrinterAreaHeight = Printer.ScaleHeight
    End If
End Function

Public Function GetPageNum() As Double
    GetPageNum = PageNum
End Function

Public Function DrawLine(ByVal x As Double, ByVal y As Double, ByVal X2 As Double, ByVal Y2 As Double, Optional ForeColor As Long = vbBlack) As Long
'Ajoute une ligne colorée
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = Ligne
    Doc(DocElemCount).x = x
    Doc(DocElemCount).y = y
    Doc(DocElemCount).X2 = X2
    Doc(DocElemCount).Y2 = Y2
    Doc(DocElemCount).ForeColor = ForeColor
    DrawLine = DocElemCount
End Function

Public Function NewPage() As Double
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = NouvellePage
    PageNum = PageNum + 1
End Function

Private Sub Class_Initialize()
    Me.CreateDocument
End Sub

Public Function GetNumPages() As Integer
    GetNumPages = PageNum
End Function

Public Function SetPortrait() As Double
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = OrientationPortrait
    SetPortrait = DocElemCount
    If Me.NumberOfPrinters > 0 Then
        Printer.Orientation = vbPRORPortrait
    End If
End Function

Public Function SetPaysage() As Double
    DocElemCount = DocElemCount + 1
    ReDim Preserve Doc(DocElemCount)
    Doc(DocElemCount).T = OrientationPaysage
    SetPaysage = DocElemCount
    If Me.NumberOfPrinters > 0 Then
        Printer.Orientation = vbPRORLandscape
    End If
End Function

Public Function GeneApercu(ByRef Ctrl As PictureBox, Optional Zoom As Double = 100) As Boolean
'Lance l'impression du buffer dans l'objet correspondant
    Dim x As Double, y As Double, A As Integer, Z As Double
    Z = Zoom / 100
    If DocElemCount > 0 Then
    With Ctrl
    'Paramètres par défaut du style d'impression
        '.Copies = NombreDeCopies
        .Cls
        .ScaleMode = vbMillimeters
        .FillStyle = vbFSSolid
        .FontTransparent = True
        
        For A = 1 To DocElemCount
            .ForeColor = Doc(A).ForeColor
            .FillColor = Doc(A).BackColor
            Select Case Doc(A).T
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Texte
                    'Centrage horizontal
                    x = Doc(A).x
                    If Doc(A).CenterH = Droite Then x = x - .TextWidth(Doc(A).s)
                    If Doc(A).CenterH = Milieu Then x = x - .TextWidth(Doc(A).s) / 2
                    .CurrentX = x * Z
                    'Centrage vertical
                    y = Doc(A).y
                    If Doc(A).CenterV = Bas Then y = y - .TextHeight(Doc(A).s)
                    If Doc(A).CenterV = Centre Then y = y - .TextHeight(Doc(A).s) / 2
                    .CurrentY = y * Z
                    'Mise en forme
                    .FontBold = Doc(A).FntB
                    .FontItalic = Doc(A).FntI
                    .FontUnderline = Doc(A).FntU
                    .FontSize = Doc(A).fntSize * Z
                    Ctrl.Print Doc(A).s
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Boite
                    Ctrl.Line (Doc(A).x * Z, Doc(A).y * Z)-Step(Doc(A).X2 * Z, Doc(A).Y2 * Z), , B
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Cercle
                    Ctrl.Circle (Doc(A).x * Z, Doc(A).y * Z), Doc(A).X2 * Z
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Image
                    If Doc(A).X2 > -1 Or Doc(A).Y2 > -1 Then
                        .PaintPicture LoadPicture(Doc(A).s), Doc(A).x * Z, Doc(A).y * Z, Doc(A).X2 * Z, Doc(A).Y2 * Z
                    Else
                        .PaintPicture LoadPicture(Doc(A).s), Doc(A).x * Z, Doc(A).y * Z
                    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Point
                    Ctrl.PSet (Doc(A).x * Z, Doc(A).y * Z)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Ligne
                    Ctrl.Line (Doc(A).x * Z, Doc(A).y * Z)-Step(Doc(A).X2 * Z, Doc(A).Y2 * Z), Doc(A).ForeColor
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case NouvellePage
                    'non géré ici
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case OrientationPortrait
                    'non géré ici
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case OrientationPaysage
                    'non géré ici
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                Case Else
            End Select
        Next A
    End With
    End If
End Function

Public Function NumberOfPrinters() As Integer
    NumberOfPrinters = Printers.Count
End Function

Conclusion :


Hésitez pas pour les critiques contructives...

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
153
Date d'inscription
vendredi 9 août 2002
Statut
Membre
Dernière intervention
18 septembre 2009

Ravi de savoir que cette source est utile et utilisée

Normalement, l'impression se lance en appellant la fonction

laclass.GenePrintOut(1)

qui te lance l'impression d'une copie. Si tu regarde la fin du code de cette fonction, tu y verra le printer.enddoc
:)
Messages postés
156
Date d'inscription
lundi 13 novembre 2000
Statut
Membre
Dernière intervention
18 septembre 2006

Ca y est, j'ai trouvé la soluce
Tout simplement
Printer.EndDoc
(merci jotrash ;-)
Excusez moi pour ce post imtempestif, reconnais avoir été un peu impatient sur ce coup.
Bon code à tous...
Messages postés
156
Date d'inscription
lundi 13 novembre 2000
Statut
Membre
Dernière intervention
18 septembre 2006

Bonjour/bonsoir tout le monde,
la source de maitredede m'a bien appris tout un tas de truc.
J'ai écrit ce bout de code dans mon appli (toute simple):

CommonDialog2.ShowPrinter
Printer.PaintPicture Picture2.Image, 0, 0, 13350, 15680

Cela commande une impression (document en file d'attente de l'impression) mais celle-ci ne s'effectue qu'à la fermeture de la form. Je reste pour l'instant perplexe face à ce pb. Il doit me manquer une ligne de code au moins, pour vider le buffer d'impression, mais je ne la trouve pas.

merci d'avance et merci à maitredede.
Messages postés
153
Date d'inscription
vendredi 9 août 2002
Statut
Membre
Dernière intervention
18 septembre 2009

Tu pourrais me passer les modifs que tu a fait pour intégrer les polices svp ?
Messages postés
141
Date d'inscription
lundi 3 novembre 2003
Statut
Membre
Dernière intervention
20 octobre 2005

Courrier c'est la police de base, ça devrait être bon normalement.
Mais si tu dis que ton export PDF fonctionne, alors le pb vient soir de l'imprimante, soit des pilotes, soit d'autre chose, mais y'a des chances (d'après moi) que ton code n'y soit pour rien dans ce pb...
Afficher les 18 commentaires

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.