标签打印，多页
问题描述：
我现在面对这个问题几周了。我无法解决它。
使用附加代码可以将一个标签页固定到一个纸页。
但是我必须单独打印每个标签页。
如何在不打开每个标签页的情况下打印所有标签页？
我尝试了几件事，但我不知道如何使用hasmorepages等。
I am facing this issue for weeks now. I can´t fix it.
Using the attached code works fine for prining one tabpage to one paper-page.
But i have to print each tabpage seperate.
How can I print all tabpages without open each tabpage ?
I tried several things but I don´t know how to use "hasmorepages" etc.
Public Sub druckbefehl()
Try
Dim MyPrintPreview As New PrintPreviewDialog()
Dim Myprintdialog As New PrintDialog()
If Myprintdialog.ShowDialog = Windows.Forms.DialogResult.OK Then
Myprintdialog.PrinterSettings = Myprintdialog.PrinterSettings
Else
Exit Sub
End If
Dim MyPrintDoc As New PrintDocument()
MyPrintDoc.DocumentName = "Inspektionsliste Ausdruck"
MyPrintDoc.PrinterSettings = Myprintdialog.PrinterSettings
AddHandler MyPrintDoc.PrintPage, AddressOf Print_Page
With PageSetupDialog1
.Document = MyPrintDoc
.PageSettings = MyPrintDoc.DefaultPageSettings
.PageSettings.Landscape = False
.PageSettings.PrinterSettings = Myprintdialog.PrinterSettings
End With
If PageSetupDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
MyPrintDoc.DefaultPageSettings = PageSetupDialog1.PageSettings
Else
Exit Sub
End If
MyPrintPreview.Document = MyPrintDoc
MyPrintPreview.WindowState = FormWindowState.Maximized
MyPrintPreview.ShowDialog()
MyPrintDoc.Dispose()
Catch ex As Exception
Stop
End Try
End Sub
Private Sub Print_Page(ByVal sender As Object, ByVal MyPrintPageEvents As PrintPageEventArgs)
' TabControl1.SelectedTab.AutoScrollPosition = New Point(0, 0)
TabPage1.AutoScrollPosition = New Point(0, 0)
Dim MyParentCntrl As Control = TabControl1.SelectedTab 'Get the parent control that the print buitton resides on
' Dim MyParentCntrl As Control = TabPage1 'Get the parent control that the print buitton resides on
TabControl1.SelectedTab = MyParentCntrl
' frmPic.Show()
Dim bm As New Bitmap(MyParentCntrl.Parent.Bounds.Width, MyParentCntrl.Parent.Bounds.Height)
bm = DrawAllSubControlsToBm(MyParentCntrl)
'bm.SetResolution(600, 600)
'bm = DrawAllSubControlsToBm(Tp3bCompleteRCA)
'frmPic.PictureBox1.Image = bm
'size for image to scale to automaticaly
Dim MyScaleFactor As Decimal = 1
MyScaleFactor = MyPrintPageEvents.MarginBounds.Height / bm.Height
'If bm.Height * MyScaleFactor > MyPrintPageEvents.MarginBounds.Height Then
' MyScaleFactor = MyPrintPageEvents.MarginBounds.Height / bm.Height
'ElseIf bm.Width * MyScaleFactor > MyPrintPageEvents.MarginBounds.Width Then
' MyScaleFactor = MyPrintPageEvents.MarginBounds.Width / bm.Width
'End If
'If bm.Height * MyScaleFactor < MyPrintPageEvents.MarginBounds.Height Then
' MyScaleFactor = MyPrintPageEvents.MarginBounds.Height / bm.Height
'End If
If bm.Width * MyScaleFactor > MyPrintPageEvents.MarginBounds.Width Then
MyScaleFactor = MyPrintPageEvents.MarginBounds.Width / bm.Width
End If
'frmPic.PictureBox1.Image = bm
Dim sourceRectangle As New Rectangle(0, 0, bm.Width, bm.Height) ' Position Gesamtausdruck!
Dim destRetangle1 As New Rectangle(MyPrintPageEvents.MarginBounds.Left, MyPrintPageEvents.MarginBounds.Top, bm.Width * MyScaleFactor, bm.Height * MyScaleFactor)
MyPrintPageEvents.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
MyPrintPageEvents.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
MyPrintPageEvents.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
MyPrintPageEvents.Graphics.DrawImage(bm, destRetangle1, sourceRectangle, GraphicsUnit.Pixel)
' MyPrintPageEvents.Graphics.DrawImage(hd, destRetangle1, sourceRectangle, GraphicsUnit.Pixel) 'CWa
End Sub
'-=-=-=-=-=-
Private Function DrawAllSubControlsToBm(ByRef MyTopLevelCntrl As Control) As Bitmap
'Dim My_Top_LevelCntrl_Bm As New System.Drawing.Bitmap(MyTopLevelCntrl.Parent.ClientRectangle.Width, MyTopLevelCntrl.Parent.Bounds.Bottom)
Dim My_Top_LevelCntrl_Bm As New System.Drawing.Bitmap(4000, 4000)
Dim My_Graphics_Drawing_Board As System.Drawing.Graphics
'if the control ie tabpage has scroll bars and the page is not at 0,0 then the image gets skewed, we correct it with this
Dim MyParentScrollPositionCorrection As Point = New Point(0, 0)
Dim MyTempTabPage As TabPage
If TypeOf MyTopLevelCntrl Is TabPage Then
MyTempTabPage = DirectCast(MyTopLevelCntrl, TabPage)
MyParentScrollPositionCorrection.X = MyTempTabPage.HorizontalScroll.Value
MyParentScrollPositionCorrection.Y = MyTempTabPage.VerticalScroll.Value
MyParentScrollPositionCorrection = MyTempTabPage.AutoScrollPosition
End If
'MyTopLevelCntrl.DrawToBitmap(My_Top_LevelCntrl_Bm, MyTopLevelCntrl.ClientRectangle)
MyTopLevelCntrl.DrawToBitmap(My_Top_LevelCntrl_Bm, New Rectangle(0, 0, MyTopLevelCntrl.Bounds.Right, MyTopLevelCntrl.Bounds.Bottom))
My_Graphics_Drawing_Board = System.Drawing.Graphics.FromImage(My_Top_LevelCntrl_Bm)
My_Graphics_Drawing_Board.Clear(Color.White)
'Set various modes to higher quality
My_Graphics_Drawing_Board.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
My_Graphics_Drawing_Board.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
My_Graphics_Drawing_Board.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
Dim MySorted_CntrlList As New List(Of Control)
Dim My_Unsorted_CntrlList As New List(Of Control)
'Create Sub Cntrl List
For Each SubCntrl As Control In MyTopLevelCntrl.Controls
My_Unsorted_CntrlList.Add(SubCntrl)
Next
Do While (My_Unsorted_CntrlList.Count > 0)
Dim MyCntrl_to_Sort As Control
MyCntrl_to_Sort = GetCntrlList_Into_Correct_Z_Order(MyTopLevelCntrl, My_Unsorted_CntrlList)
MySorted_CntrlList.Add(MyCntrl_to_Sort)
My_Unsorted_CntrlList.Remove(MyCntrl_to_Sort)
Loop
'Get the maximum point to the Right and to the bottom of the drawn bit maps, I wish to clip off the white space so the image fits nicely into the print preview
Dim MaxRightPointForClip As Integer = 0
Dim MaxBottomPointForClip As Integer = 0
Dim My_CntrlList_Count As Integer = MySorted_CntrlList.Count - 1
For My_Current_Cntrl_Item_Index As Integer = My_CntrlList_Count To 0 Step -1
'Create New Bitmap the same size as current cntrl at list index
Dim My_SubItem_Image As New Bitmap(MySorted_CntrlList(My_Current_Cntrl_Item_Index).Width, MySorted_CntrlList(My_Current_Cntrl_Item_Index).Height)
'Draw The current Control at list index to the new Bitmap if the control is visible on the form
If MySorted_CntrlList(My_Current_Cntrl_Item_Index).Visible = True Then
MySorted_CntrlList(My_Current_Cntrl_Item_Index).DrawToBitmap(My_SubItem_Image, MySorted_CntrlList(My_Current_Cntrl_Item_Index).ClientRectangle)
My_Graphics_Drawing_Board.DrawImageUnscaled(My_SubItem_Image, New Point(MySorted_CntrlList(My_Current_Cntrl_Item_Index).Left - MyParentScrollPositionCorrection.X, MySorted_CntrlList(My_Current_Cntrl_Item_Index).Top - MyParentScrollPositionCorrection.Y))
End If
'Get the maximum point If visible
If MySorted_CntrlList(My_Current_Cntrl_Item_Index).Visible = True Then
If MaxRightPointForClip < MySorted_CntrlList(My_Current_Cntrl_Item_Index).Left + MySorted_CntrlList(My_Current_Cntrl_Item_Index).Width Then
MaxRightPointForClip = MySorted_CntrlList(My_Current_Cntrl_Item_Index).Left + MySorted_CntrlList(My_Current_Cntrl_Item_Index).Width
End If
If MaxBottomPointForClip < MySorted_CntrlList(My_Current_Cntrl_Item_Index).Top + MySorted_CntrlList(My_Current_Cntrl_Item_Index).Bounds.Height Then
MaxBottomPointForClip = MySorted_CntrlList(My_Current_Cntrl_Item_Index).Top + MySorted_CntrlList(My_Current_Cntrl_Item_Index).Bounds.Height
End If
End If
Next
'Crop The Image to remove white space right and bottom
'frmPic.Show()
'frmPic.PictureBox1.Image = My_Top_LevelCntrl_Bm
MaxRightPointForClip = MaxRightPointForClip + 15 'Add buffer edge
MaxBottomPointForClip = MaxBottomPointForClip + 15 'Add buffer Edge
Dim CroppedBm As Bitmap = New Bitmap(MaxRightPointForClip, MaxBottomPointForClip)
My_Graphics_Drawing_Board = System.Drawing.Graphics.FromImage(CroppedBm)
'frmPic.Show()
My_Graphics_Drawing_Board.DrawImageUnscaledAndClipped(My_Top_LevelCntrl_Bm, New Rectangle(0, 0, MaxRightPointForClip, MaxBottomPointForClip)) '.VisibleClipBounds(New Rectangle(10, 10, 100, 200))
'frmPic.PictureBox1.Image = CroppedBm
croppedBm1 = CroppedBm
'Return My_Top_LevelCntrl_Bm
Return CroppedBm ' My_Top_LevelCntrl_Bm
Return croppedBm1
End Function
Public croppedBm1 As Bitmap
Private Function GetCntrlList_Into_Correct_Z_Order(ByRef My_Item_Parental As Control, ByRef My_Item_Listings As List(Of Control)) As Control
If My_Item_Listings.Count = 0 Then Return Nothing
Dim My_Item_Controll = My_Item_Listings(0)
For Each My_Each_Controll As Control In My_Item_Listings
If My_Item_Parental.Controls.GetChildIndex(My_Each_Controll) < My_Item_Parental.Controls.GetChildIndex(My_Item_Controll) Then
My_Item_Controll = My_Each_Controll
End If
Next
Return My_Item_Controll
End Function
答
您需要在BeginPrint子项中启动一个跟踪已打印多少个选项卡的变量，如果该变量小于设置的选项卡总数e，则需要在PrintPage子项中启动。 HasMorePages = True。
这篇文章 [ ^ ]
You need to initiate a variable in the BeginPrint sub that tracks how many tabs have been printed and, in your PrintPage sub if that is less than the total number of tabs set e.HasMorePages = True.
There's an overview of the print cycle in this article[^]
非常感谢你。你指出我正确的方向。它到目前为止工作。
但是
打印标签页12后我得到一个系统。 ArgumentException参数无效。
有限制吗？内存问题等？
此错误后停止打印。我怎么能避免这个？
提前谢谢！
Thank you so much. You pointed me into the right direction. It´s working so far.
BUT
After printing Tabpage 12 I get a "System.ArgumentException" "Parameter is not valid."
Is there a limitation? Memory Problem etc. ?
It stops printing after this error. How can I avoid this ?
Thank you in advance!