Quantcast
Channel: VBForums
Viewing all articles
Browse latest Browse all 15475

Application-level "Printer banding"

$
0
0
Printers.

Sometimes you need to print Unicode text, or perhaps you want to force a file name to a virtual printer driver (e.g. Microsoft Print to PDF") so no output dialog is raised. Both of these pretty much mean leaving the Printer and DataReport objects behind as far as I can tell.

However things can get complicated if your output will have headers and/or footers and you want "detail items" printed in a "keep together" manner. I.e. you want whole "detail items" (perhaps several globs of text, maybe mixed with images) pushed to the next page as a unit as page breaks are reached.

Imagine a detail item that consists of an image and several columns of text. The text may wrap and the images might be taller or smaller than the text snippets. Some text might be in a bigger font, etc.


One hack might be to "print" such detail items to a memory DC. Then you know how tall the result is and you can determine whether to break to a new page... printing footers/headers first as need be. Finally you can print the stuff from the memory DC to the printer.

Here's a one-band demo based on a Form rather than printer:

Name:  sshot.png
Views: 57
Size:  2.9 KB


While that probably works, I wonder if it has nasty issues. For example printing a ton of these bitmaps sounds bulky, and even worse as PDF output. Plus such a PDF wouldn't have any searchable or copyable text.

So I'm thinking the answer would be to create EMFs on the fly and then instead of BitBlt() play the EMF to the printer DC instead.


Does this sound viable? What issues haven't I thought about yet?

Code:

Private Sub Form_Load()
    Dim hDCMem As Long
    Dim W As Long
    Dim H As Long
    Dim hBMMem As Long
    Dim hBMMemPrev As Long
    Dim IFont As stdole.IFont
    Dim hFontMemPrev As Long
    Dim RECT As RECT
    Dim hBrush As Long
    Dim I As Integer
    Dim Text As String
    Dim IPicture As IPicture
    Dim WP As Long
    Dim HP As Long

    'Here we use the Form's hDC & Font, but for printing we can used the Printer's instead.
    hDCMem = CreateCompatibleDC(hDC)
    'Add 5 pixels all around to help highlight our result:
    W = ScaleX(ScaleWidth, ScaleMode, vbPixels) - 10
    H = ScaleY(ScaleHeight, ScaleMode, vbPixels) - 10
    hBMMem = CreateCompatibleBitmap(hDC, W, H)
    hBMMemPrev = SelectObject(hDCMem, hBMMem)
    Set IFont = Font
    hFontMemPrev = SelectObject(hDCMem, IFont.hFont)
    With RECT
        .Right = W
        .Bottom = H
        'We also use funky colors to help things stand out:
        hBrush = CreateSolidBrush(&HA06000) 'A dark greenish blue.
        FillRect hDCMem, RECT, hBrush
        DeleteObject hBrush
        SetTextColor hDCMem, vbWhite
        SetBkColor hDCMem, &HB0& 'A dark red.
        SetBkMode hDCMem, OPAQUE
        For I = 1 To 8
            Text = MonthName(I)
            If I = 2 Then
                Text = Text & " " & Text & " " & Text & " " & Text & " " & Text & " " & Text
            ElseIf I = 3 Then
                Text = Text & vbNewLine & vbTab & "more, more, more-text!"
            End If
            .Top = .Top + DrawText(hDCMem, _
                                  StrPtr(Text), _
                                  -1, _
                                  RECT, _
                                  DT_LEFT _
                                  Or DT_TOP _
                                  Or DT_NOPREFIX _
                                  Or DT_WORDBREAK _
                                  Or DT_EXPANDTABS)
        Next
    End With
    'Throw in an image here, just for grins:
    Set IPicture = LoadPicture("Burger.gif")
    With IPicture
        WP = ScaleX(.Width, vbHimetric, vbPixels)
        HP = ScaleY(.Height, vbHimetric, vbPixels)
        .Render hDCMem, _
                W - 5 - WP, _
                RECT.Top - 5 - HP, _
                WP, _
                HP, _
                0, _
                .Height, _
                .Width, _
                -.Height, _
                ByVal 0&
    End With
    'Render the "off screen image" trimming to actual height used:
    AutoRedraw = True
    'Remember... 5 pixels all around to help highlight our result:
    BitBlt hDC, 5, 5, W, RECT.Top, hDCMem, 0, 0
    AutoRedraw = False
    Caption = Caption & ": " & CStr(RECT.Top) & " px"
    SelectObject hDCMem, hFontMemPrev
    SelectObject hDCMem, hBMMemPrev
    DeleteObject hBMMem
    DeleteDC hDCMem
End Sub

Attached Images
 
Attached Files

Viewing all articles
Browse latest Browse all 15475

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>