Dans le projet que je suis en train de mener à bien, je dessine des plans de baies informatiques contenant des serveurs. Ces baies sont organisée par rangée et par colonne, cet état de fait étant représenté par des onglets dans des tabpages. Bien su, le nombre de baies est variale par rangée donc, chaque onglet représentant une rangée est de taille différente par rapport à son voisin. Lorsque est venu le moment d'imprimer ces plan de baies, je me suis heurté au problème de savoir comment faire, c'est alors que m'est venu l'idée de faire une capture graphique du contenu de chaque onglet pour ensuite pouvoir l'imprimer. Le seul problème était que je désirais capturer en une seul fois tout le contenu de l'onglet y compris la partie hors écran....Ce source décris la manière dont je m'y suis prise. Tout a été récupéré sur le net et adapté à mes besoins perso.
Ce qu'il fait :
Dans l'évènement double_click de l'onglet, je lance la procédure de capture, le découpage de l'image et son impression.
En espérant que ceci pourras servir à d'autres.
Source / Exemple :
Tout d'abord la procédure permettant la capture de l'objet désiré :
Private Const WM_PRINT As Integer = &H317
Private Const PRF_CLIENT As Integer = &H4
Private Const PRF_CHILDREN As Integer = &H10
Public Function PrintControl(ByVal Ctrl As System.Windows.Forms.Control) As System.Drawing.Bitmap
Dim bmp As System.Drawing.Bitmap = Nothing
Dim gr As System.Drawing.Graphics = Nothing
Dim hdc As IntPtr = IntPtr.Zero
Dim newBounds As Rectangle
newBounds.Location() = New Point(0, 0)
newBounds.Height = Ctrl.PreferredSize.Height 'important, car PreferredSize contient la taille réelle du contrôle
newBounds.Width = Ctrl.PreferredSize.Width
Dim MaRegion As New Region(newBounds)
Try
bmp = New System.Drawing.Bitmap(Ctrl.PreferredSize.Width, Ctrl.PreferredSize.Height, Ctrl.CreateGraphics())
gr = Graphics.FromImage(bmp)
gr.FillRegion(Brushes.Silver, MaRegion) 'ici, je rempli la totaltilé de l'objet graphic avec la couleur de mon contrôle car sinon, la partie hors écran est rempli par une couleur transparente.
hdc = gr.GetHdc()
Dim wParam As IntPtr = hdc
Dim lParam As IntPtr = New IntPtr(PRF_CLIENT Or PRF_CHILDREN)
Dim msg As System.Windows.Forms.Message = System.Windows.Forms.Message.Create(Ctrl.Handle, WM_PRINT, wParam, lParam)
MyBase.WndProc(msg)
Catch
Finally
If Not gr Is Nothing Then
If hdc <> IntPtr.Zero Then gr.ReleaseHdc(hdc)
gr.Dispose()
End If
End Try
Return bmp
End Function
Maintenant, son appel (dans un double clique sur le contrôle, donc sender contient le contrôle au complet):
Dim h As Integer = sender.PreferredSize.Height
Dim w As Integer = sender.PreferredSize.Width
Dim TargetImg As New System.Drawing.Bitmap(w, h)
TargetImg = PrintControl(sender)
TargetImg va donc contenir l'image du contenu du contrôle. Il suffit de la sauvegarder, ou de l'envoyer, sur l'imprimant ou dans le clipboard, perso je la sauvegarde donc :
If Dir(MyRepUsers, vbDirectory) = "" Then
MkDir(MyRepUsers) 'si le répertoire n'existe pas je le crè (MyRepUser contient le chemin de mes documents)
End If
TargetImg.Save(MyRepUsers + "\" + sender.name + ".bmp") 'on sauve l'image
Je passe l'image à la procédure de découpage:
nbToPrint = SplitImage(MyRepUsers + "\" + sender.name + ".bmp")
Que voici :
Function SplitImage(ByVal path As String) As Integer
Dim original As New Bitmap(path)
Dim focusRectangle As New Rectangle()
Dim destination As Drawing.Bitmap
Dim w As Integer = 0
Dim i As Integer = 1
Dim OK As Boolean = False
Do While w < original.Width
focusRectangle.Y = 0
focusRectangle.Height = original.Height
focusRectangle.X = w
'pour ma part, je doit découper à des endroits précis pour ne pas couper un contrôle en 2, d'où ce test :
If Me.chkU.Checked Then
focusRectangle.Width = 924 + IIf(i = 1, 10, 0)
Else
focusRectangle.Width = 809 + IIf(i = 1, 10, 0)
End If
If focusRectangle.Width + focusRectangle.X > original.Width Then
focusRectangle.Width = original.Width - focusRectangle.X
End If
'et on découpe
destination = original.Clone(focusRectangle, Imaging.PixelFormat.DontCare) 'on définit un second BitMap Clonant une partie du 1ere BitMap avec le rectangle
'et on sauve avec un index
destination.Save(path.Substring(0, Len(path) - 4) + "_" + i.ToString() + ".bmp")
If Me.chkU.Checked Then
w += 924 + IIf(i = 1, 10, 0)
Else
w += 809 + IIf(i = 1, 10, 0)
End If
i += 1
Loop
Return i - 1 'à la sortie, je me retrouve avec i-1 image de mon image principale
End Function
Il ne reste plus qu'à les imprimer, retour dans le double click du contrôle :
For i As Integer = 1 To nbToPrint
If nbToPrint > 1 Then
PrepareAndPrint(MyRepUsers + "\" + sender.name + "_" + i.ToString + ".bmp")
Else
'il se peut que l'image n'est pas eut besoin d'être découpée, donc j'imprime l'image principale sans index
PrepareAndPrint(MyRepUsers + "\" + sender.name + ".bmp")
End If
Next
et la fonction d'impression :
Private Sub PrepareAndPrint(ByVal Path As String)
Dim doc As Printing.PrintDocument = New Printing.PrintDocument
Dim printer As PrintDialog = New PrintDialog
doc.DefaultPageSettings.Landscape = True 'rajouté pour ne pas avoir à le choisir dans le dialogue d'impression
imgBaie = New Bitmap(Path) 'définie en public car PrintPageHandler ce sert de la variable
AddHandler doc.PrintPage, AddressOf PrintPageHandler
printer.Document = doc
Dim response As Windows.Forms.DialogResult = printer.ShowDialog()
If response = Windows.Forms.DialogResult.OK Then
doc.Print()
End If
End Sub
Private Sub PrintPageHandler(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
Dim canvas As Graphics = e.Graphics
' The printer will print the image to whatever bounds are set here (in the next two lines)
Dim topLeft As Point = New Point(0, 0)
Dim bottomRight As Point = New Point(e.PageBounds.Width, e.PageBounds.Height)
' The rest of the code should not need to be modified
' This algorithm makes sure the image scales properly
Dim pageHeight As Integer = bottomRight.Y - topLeft.Y
Dim pageWidth As Integer = bottomRight.X - topLeft.X
'sur ces deux ligne, j'ai rajouté +50 car sinon, l'image était trop grande en hauteur et on n'avais pas le bas
Dim scaleHeight As Single = pageHeight / (imgBaie.Height + 50)
Dim scaleWidth As Single = pageWidth / (imgBaie.Width + 50)
' NewHeight and NewWidth determine the drawing area.
' Assume scaleHeight < scaleWidth
Dim newHeight As Integer = scaleHeight * imgBaie.Height
Dim newWidth As Integer = scaleHeight * imgBaie.Width
' Now check assumption, and correct if wrong
If scaleWidth < scaleHeight Then
newHeight = scaleWidth * imgBaie.Height
newWidth = scaleWidth * imgBaie.Width
End If
canvas.DrawImage(imgBaie, 0, 0, newWidth, newHeight)
End Sub
Et voilà, tout ce code me fait pile poil ce que je voulais.
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.