Свойство Hasmorepages терпит неудачу - PullRequest
Новая
       7

Свойство Hasmorepages терпит неудачу

0 голосов
/ 15 октября 2018

Я создал подпрограмму, предназначенную для печати переменного числа строк и / или страниц на основе ранее сохраненной информации о очереди строк.Каждая страница печатается нормально, но при печати более одной страницы две страницы печатаются поверх.Я не вижу своей логической ошибки, но она должна быть.Копия оскорбительного кода приведена ниже.Nextline.newpage - это логическое значение true для принудительного открытия новой страницы.В моем текстовом примере было шесть «Newpage», а «hasmorepages» был установлен в true шесть раз, а процедура была завершена шесть раз.Тем не менее, на выходе было четыре страницы с одной печатью правильно и три с двумя страницами, напечатанными на одном листе.Любая помощь будет принята с благодарностью.Кстати, это мой первый вопрос, так что будьте добры. 

Private Sub PrintLines(Sender As Object, e As PrintPageEventArgs) Handles PrintDoc.PrintPage
    Dim White As String = GetARGBString(PrinterDefaultBackcolor)
    Do Until Lines.Count = 0
        Dim Nextline As Lineformat = Lines.Dequeue
        If Nextline.NewPage Then
            e.HasMorePages = True
            Exit Sub
        End If
        With Nextline
            Dim LineBackColor As String = Nextline.backColor
            If LineBackColor <> White Or .Borders = True Then DrawShape(Nextline, e)
            If .Text <> "" Then DrawText(Nextline, e)
        End With
    Loop

End Sub

Private Sub DrawShape(Line As Lineformat, E As PrintPageEventArgs)
    With Line
        Dim Top As Integer = .Top * 100
        Dim Left As Integer = .Left * 100
        Dim Width As Integer = .BackGroundWidth * 100
        Dim Height As Integer = .BackGroundHeight * 100
        Dim Point As New Point(Left, Top)
        Dim Size As New Size(Width, Height)
        Dim Rect As New Rectangle(Point, Size)
        Dim TransparentFillColor As String = "00" & Strings.Right(.backColor, 6)
        Dim FillColor As FullColor = GetColorFromString(.backColor)
        Dim BorderPen As New Pen(Color.Black)
        Dim FillBrush As New SolidBrush(FillColor.Color)
        E.Graphics.FillRectangle(FillBrush, Rect)
        If Line.Borders = True Then
            E.Graphics.DrawRectangle(BorderPen, Rect)
        End If
    End With

End Sub
Private Sub DrawText(Line As Lineformat, E As PrintPageEventArgs)

    With Line
        Dim MyFont = SetFontStyle(.FontFamily, .FontPoints, .FontBold, .FontItalic, .FontUnderline)
        Dim TextColor As FullColor = GetColorFromString(.ForeColor)
        Dim MyBrush As New SolidBrush(TextColor.Color)
        Dim top As Integer = .Top * 100
        Dim Left As Integer = .Left * 100
        Dim Width As Integer = .LineWidth * 100
        Dim Height As Integer = .LineHeight * 100
        Dim point As New Point(Left, top)
        Dim Size As New Size(Width, Height)
        Dim Rect As New RectangleF(point, Size)
        Dim SF As New StringFormat()
        SF.FormatFlags = TextFormatFlags.WordEllipsis
        E.Graphics.DrawString(.Text, MyFont, MyBrush, Rect, SF)
    End With
End Sub

Конечный класс

...