1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
Imports System.Drawing.Printing
Imports System.IO
Public Class ClassPrintingAndPDF
Inherits System.Drawing.Printing.PrintDocument
Private WhatIsPrinting As String = ""
Private strPrinting As String = ""
Private oFont As System.Drawing.Font
Private cDossierBitMaps As String = ""
Private oCollBitmapsToPDF As New Collection
Private NumPage As Integer = 0
Private NbrPageCount As Integer = 1
''' <summary>
''' Imprimer une chaîne de caractères
''' </summary>
''' <param name="pStrPrinting">La chaîne</param>
''' <param name="pFont">La police</param>
Sub New(pStrPrinting As String, pFont As System.Drawing.Font)
MyBase.New()
WhatIsPrinting = "aString"
strPrinting = pStrPrinting
oFont = pFont
End Sub
''' <summary>
''' Imprimer des BitMaps
''' </summary>
''' <param name="cDossierBmp">Répertoire des Bitmaps à imprimer dans le fichier PDF</param>
''' <param name="cMasque">Masque des fichiers BitMaps</param>
''' <param name="cFilePDF">Nom du fichier PDF</param>
''' <param name="cPrinter">Nom de l'imprimante</param>
Sub New(ByVal cDossierBmp As String, ByVal cMasque As String, ByVal cFilePDF As String, _
ByVal cPrinter As String)
MyBase.New()
If ExistDirectory(cDossierBmp) Then
cDossierBitMaps = AddBS(cDossierBmp)
oCollBitmapsToPDF = ReadDirectory(cDossierBmp, cMasque)
If oCollBitmapsToPDF.Count > 0 Then
NbrPageCount = oCollBitmapsToPDF.Count
If Not String.IsNullOrEmpty(cFilePDF) Then
MyBase.PrinterSettings.PrinterName = cPrinter
End If
MyBase.DocumentName = AddBS(My.Settings.pAppDossierZip) & cFilePDF.Trim
WhatIsPrinting = "SomeBitmaps"
End If
End If
End Sub
Shadows Sub PrintPage(sender As System.Object, e As System.Drawing.Printing.PrintPageEventArgs) _
Handles MyBase.PrintPage
Try
Select Case True
Case WhatIsPrinting = "aString"
e.Graphics.DrawString(strPrinting, oFont, Brushes.Black, 150, 125)
Case WhatIsPrinting = "SomeBitmaps"
Dim nHeightPage As Integer = MyBase.DefaultPageSettings.PaperSize.Height
Dim nWidthPage As Integer = MyBase.DefaultPageSettings.PaperSize.Width
Dim rectPage As New Rectangle(0, 0, nWidthPage, nHeightPage)
NumPage = NumPage + 1
Dim NewPageBmp As Bitmap = LoadBitMaps(NumPage)
If NewPageBmp IsNot Nothing Then
e.Graphics.DrawImage(NewPageBmp, rectPage)
End If
Select Case True
Case NumPage < NbrPageCount
e.HasMorePages = True
Case NumPage >= NbrPageCount
e.HasMorePages = False
End Select
End Select
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, My.Settings.pAppEnteteBox)
End Try
End Sub
Private Function LoadBitMaps(ByVal nItem As Integer) As Bitmap
Try
If (nItem > 0 And nItem <= oCollBitmapsToPDF.Count) Then
Dim cFileBmp As String = cDossierBitMaps & oCollBitmapsToPDF.Item(nItem)
If ExistFile(cFileBmp) Then
Dim oStream As FileStream = New FileStream(cFileBmp, FileMode.Open)
Dim oNewBitMap As Bitmap = Image.FromStream(oStream)
Return oNewBitMap
Else
MsgBox("Fichier non trouvé!" & vbCrLf & cFileBmp, MsgBoxStyle.Exclamation, _
My.Settings.pAppEnteteBox)
Return Nothing
End If
Else
MsgBox("Erreur d'item: " & nItem.ToString, MsgBoxStyle.Critical, My.Settings.pAppEnteteBox)
Return Nothing
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, My.Settings.pAppEnteteBox)
Return Nothing
End Try
End Function
End Class |
