begin process at 2012 02 16 10:59:21
  Trouver un code source :
 
dans
 
[ Dernières recherches ]
Accueil > 

Code

 > 

Imprimante

 > CLASSE D'IMPRESSION BASIQUE (GÉNÈRE AUSSI UN APERÇU)

CLASSE D'IMPRESSION BASIQUE (GÉNÈRE AUSSI UN APERÇU)


 Information sur la source

Note :
8 / 10 - par 1 personne
8,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Imprimante Niveau :Initié Date de création :01/07/2004 Date de mise à jour :14/01/2005 12:27:48 Vu / téléchargé :11 533 / 872
Auteur : maitredede

Ecrire un message privé
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (18)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

  • 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 
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...

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

29 août 2004 21:33:17 :
Ré-écriture du code de génération de l'impression pour supporter le format de page(portrait/paysage) et un nombre de copies
29 août 2004 21:59:35 :
Ajout d'un apercu basique
14 janvier 2005 12:27:49 :
Amélioration du code (me demandez pas quoi) :'(

 Sources du même auteur

CLASSE D'IMPRESSION DE TABLEAUX
Toutes les sources de maitredede

 Sources de la même categorie

Source avec Zip Source avec une capture Source .NET (Dotnet) PARAMETRES_IMPRIMANTE par Le Pivert
Source avec Zip Source .NET (Dotnet) IMPRESSION FACILE EN ÉVITANT LES BUGS DU FRAMEWORK par circular
Source avec Zip Source .NET (Dotnet) CLASSE POUR AJOUTER/CONNECTER/DECONNECTER UNE IMPRIMANTE RÉS... par radcur
Source avec Zip Source avec une capture IMPRESSION AU FIL DE L'EAU VERS IMPRIMANTE MATRICIELLE par rimas10
Source avec Zip Source avec une capture IMPRIMER CODE BARE par StetechCove
Toutes les sources de la catégorie Imprimante

Commentaires et avis

Commentaire de sarl_adc le 02/07/2004 08:59:31

Moi ce que je ne comprends pas c'est qu'il n'existe apparemment pas de moyen d'imprimer un formulaire complet !
J'ai cherché de partout et pas possible de trouver quoi que ce soit (miss à part l'impression de ce qui est "visible" seulement).

On est donc obligés de passer par 50000 lignes de code et un objet basique Printer pour imprimer pas grand chose.

Enfin ton prog a l'air sympa fonctionnel !

Commentaire de maitredede le 29/08/2004 22:04:33

qu'est-ce que tu apelle sortir un formulaire complet ?
Donne moi un exemple concret...

Commentaire de sarl_adc le 30/08/2004 08:35:21

Je prends un exemple type :
J'ai une résolution d'écran de 800x600 pixels
Mon formulaire fait 1200x700 pixels, ce qui fait que l'utilisateur ne voit pas ce qui dépasse de l'écran.

Avec des scrollbars c'est géré en VB, mais pour ce qui est de l'impression, l'objet Printer n'imprime que la partie visible du formulaire, et ainsi mon formulaire de 1200x700 pixels ne pourra jamais être imprimé en entier.

Il y a bien des solutions comme l'utilisation du logiciel Crystal Reports, mais j'utilise déjà et c'est pour parer un bug de Crystal Reports que je veux imprimer directement mon formulaire sans passer par cet outil.

Vala ;-)

Commentaire de maitredede le 30/08/2004 11:24:12

Tu veut mettre des scroll bars sur ta feuille ? ;-)

J'ai quasiment le même genre de problème : je remplis des infos et je doit les imprimer : listing de résumé de factures.
Mon problème : ça tiends pas en largeur...
Solution : je l'ai mis au format paysage...

Autre chose : j'utilise des classes qui fonctionne à peu près pareil, j'ai une classe listing qui me met en forme un tableau sur la page, et j'ai plus qu'à faitre une boucle pour entrer les infos. Ensuite, j'appelle sa méthode pour imprimer, et elle appelle ma classe impression. C'est ma classe listing qui me gère la mise en forme...
Je la mettrait bientôt en ligne...
Mais pour ton formulaire, il faudra à mon avis que tu trouve une autre solution...

Commentaire de sarl_adc le 30/08/2004 11:27:19

Ouep faut que je trouve une autre solution... mais je n'en ai pas...
Merci quand même !

Commentaire de maitredede le 30/08/2004 22:22:09

Ben, récupérer le contenu de chaque champ, et les mettre n forme sur ta feuille... J'en voit pas d'autre à première vue...

Commentaire de sarl_adc le 31/08/2004 08:35:52

On a eut la même idée.
Mais j'ai pas mal de mise en forme et de tableaux, et à vrai dire j'ai fait le test, mais après avoir vu la galère que c'était et la longueur du code j'ai laissé tomber, surtout que l'impression reste basique, il y a pas mal de choses qu'on ne peut pas imprimer correctement...

Commentaire de maitredede le 31/08/2004 18:36:10

comme quoi ?

Commentaire de sarl_adc le 01/09/2004 16:29:02

je pense qu'on doit pouvoir tout faire, mais y'a des pbs pour les polices de caractères par ex, les remplissages de textboxes (c'est faisable avec un carré gris derrière par ex, mais pas top) puis surtout les sauts de page, qu'on ne peut pas ou très difficilement définir au cas par cas (quand on a des tableaux pouvant contenir 1 ou plusieurs lignes) et enfin les en-têtes et pieds de page (N) de page, logo du client, etc...)

Commentaire de maitredede le 01/09/2004 16:35:38

C un problème que j'ai aussi quand j'imprime des factures. J'utilise une classe de mise en forme qui ensuite imprime avec cette classe d'impression.

Si j'ai trop de lignes, ma facture descend trop bas... Par contre les en-têtes et pieds de pages appraraissent correctement.
Ma classe de listing intègre un saut de page automatique, avec numérotation automatique des pages, et répétition des têtes de colonnes...

Commentaire de Michel_Me le 26/01/2005 16:24:22

J'ai utiler ce code en permettant l'utilisation de plusieurs police dans addtext.
Mon probleme est que sur le preview, tout est OK, en impression redirgée vers un fichier pdf idem.
Par contre, si l'impression est dirigrée sur l'imprimante, le changement de police ne se fait pas.

En connaissez vous la raison ?

Commentaire de sarl_adc le 26/01/2005 16:32:26

Peut être que ton imprimante ne reconnait pas ces polices.
Ca m'est arrivé chez certains de mes clients de voir des impressions qui sortaient de partout très bien et sur une seule imprimante, la police ou les marges changeaient.

Essaye sur une autre imprimante...

Commentaire de Michel_Me le 26/01/2005 17:05:06

En fait je veux utiliser Courier.
Je pense que l'imprimante la connait. C'est une brother1450

Commentaire de sarl_adc le 26/01/2005 17:18:17

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...

Commentaire de maitredede le 26/01/2005 19:25:54

Tu pourrais me passer les modifs que tu a fait pour intégrer les polices svp ?

Commentaire de jekifvb6 le 19/04/2005 12:06:48

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.

Commentaire de jekifvb6 le 19/04/2005 12:15:50

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...

Commentaire de maitredede le 19/04/2005 21:55:43

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
:)

 Ajouter un commentaire

Nos sponsors


Sondage...

Comparez les prix


Mio - Moov V735 - GPS Europe - Ecran 7"
Entre 305€ et 375€

Visiter le guide achat

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

Photo Beautiful woman in a bikini meditating on the beachPhoto Green Energy Solutions With Light Bulb Morphed Into Landscape
Photo Landscape of a Sunrise in Kauai Hawaii 

Visiter la photothèque
 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,312 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales
Outils Convertisseur VB/C# Snippets et scripts Outils en ligne La ToolBox
Communauté Programmation Photographie Technologie Newsgroups Emploi Forum Blogs
Guide d'achat Téléphonie mobile Image et son Informatique Bureautique Jeux vidéo
Logiciels Internet & Réseau Développement Market Android Jeux & Loisirs Graphisme Multimédia Sécurité Pilotes
Loisirs Cartes virtuelles Vidéos droles Jeux en ligne Géoguide AndroLib (Android Market)