Results 1 to 19 of 19

Thread: [VB6] UPrinter - Unicode Printer Class

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,036

    Post [VB6] UPrinter - Unicode Printer Class

    I looked around and didn't find many working samples of this... actually none at all but lots of questions about non-working code snippets. There may be some out there, and better than this basic one. I just didn't find any.

    This version does not deal with top/bottom margins, colors, images, drawing, paper tray or size selection, orientation, etc. It only prints in whole lines (or multiples if you have embedded newlines), long lines should wrap.


    I have attached an archive here containing a small demo Project that uses UPrinter.

    Utf8Reader is is class for reading UTF-8 encoded text files. It in turn makes use of the Utf8Codec class. For this demo a UTF-8 CSV file is read as a source of sample Unicode text to print.

    ParseCSV is here because the sample data is a CSV file and I want to split the data into fields and then print them with Tabs in between.

    Each line of text after the first (heading) line is printed twice in this demo. The only purpose of that was to test page boundary overflow detection.


    This hasn't been fully tested so it may fail with some printer drivers. As already stated it is an incomplete and minimal example but it should serve as a starting point if you want to implement more functionality.


    Name:  sshot.jpg
Views: 2681
Size:  51.2 KB


    Updates:

    New version replaces the earlier attachment here. A few small bug fixes, added properties TopMargin and BottomMargin and method KillDoc.
    Attached Files Attached Files
    Last edited by dilettante; Apr 23rd, 2014 at 08:52 PM. Reason: updates

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,036

    Re: [VB6] UPrinter - Unicode Printer Class

    I should have mentioned: the archive has the sample data file in it.

  3. #3
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by dilettante View Post
    I should have mentioned: the archive has the sample data file in it.
    I have printed A4 page on my Sharp printer. Only two lines (Korean) are auto wrapped to next line.

    Democratic People's Rep. of Korea LEE Sol-Hee 조선 민주주의 인민 공화국 이
    설희
    Democratic People's Rep. of Korea LEE Sol-Hee 조선 민주주의 인민 공화국 이
    설희

    I used a textbox to record ParseCSV for comparison,other line looks OK,only two korean line's space between segments on printed page is bigger than actual ParseCSV in textbox, thus the print line is wrapped.

    I also printed into pdf creator, it's OK. the two korean lines are ok.

    Thanks for sharing.

    Code:
    Private Sub cmdPrint_Click()
        Dim I As Long
        Dim prtItem As Printer
        Dim UPrinter As UPrinter
        Dim Utf8Reader As Utf8Reader
        Dim TextLine As String
        
        lstPrinters.Enabled = False
        cmdPrint.Enabled = False
        lblStatus.Caption = "Opening..."
        lblStatus.Refresh
        
        Set UPrinter = New UPrinter
        
        'Printers collection is not directly addressable so find the selected one:
        For Each prtItem In Printers
            If I = lstPrinters.ListIndex Then Exit For
            I = I + 1
        Next
        'Use this Printer object to get the required parameters for OpenPrinter:
        With prtItem
            If Not UPrinter.OpenPrinter(.DeviceName, .DriverName) Then
                lblStatus.Caption = "Canceled!"
                Exit Sub
            End If
        End With
        
        lblStatus.Caption = "Printing..."
        DoEvents
        
        utf8CSV.Text = ""
        
        Set Utf8Reader = New Utf8Reader
        With UPrinter
            .LeftMargin = 360
            .RightMargin = 180
            .TabLength = 16
            
            'CAUTION!
            '
            'Some printer drivers that print to a disk file may alter the current
            'directory of the process before you get here.
    
            'Get some Unicode data from a UTF-8 encoded file:
            Utf8Reader.OpenFile App.Path & "\Utf8_Uniprint.txt", vbLf
            
            'Print heading line.
            With .Font
                .Name = "Arial Unicode MS"
                .Size = 11
                .Underline = True
            End With
            TextLine = Utf8Reader.ReadLine()
            .PrintLine Join$(ParseCSV(TextLine), vbTab)
            utf8CSV.Text = utf8CSV.Text & Join$(ParseCSV(TextLine), vbTab) & vbCrLf
            .PrintLine
            utf8CSV.Text = utf8CSV.Text & vbCrLf
            'Print data.
            .Font.Underline = False
            Do Until Utf8Reader.EOF
                TextLine = Utf8Reader.ReadLine()
                'Print each line twice, we want to test page overflows:
                .PrintLine Join$(ParseCSV(TextLine), vbTab)
                utf8CSV.Text = utf8CSV.Text & Join$(ParseCSV(TextLine), vbTab) & vbCrLf
                .PrintLine Join$(ParseCSV(TextLine), vbTab)
                utf8CSV.Text = utf8CSV.Text & Join$(ParseCSV(TextLine), vbTab) & vbCrLf
            Loop
            
            Utf8Reader.CloseFile
            .ClosePrinter
        End With
        
        lblStatus.Caption = "Done"
    End Sub
    Last edited by Jonney; Apr 23rd, 2014 at 10:38 PM.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,036

    Re: [VB6] UPrinter - Unicode Printer Class

    Thanks for trying it out.

    As written it doesn't have support for right-to-left (Hebrew, Arabic) or vertical (East Asian) text directions either. All of that can probably be done with a little work, but those little things do add up.

    I might be off slightly in "measuring" (setting RECTangle structures) or printer drivers and printers might have slight differences in default paper size settings or printable area of different paper sizes. Perhaps that might account for differences in line wrapping.

  5. #5
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [VB6] UPrinter - Unicode Printer Class

    Is it possible to call any API to assign the Paper size of hDcPrinter which created by CreateDC API?
    Last edited by Jonney; Apr 13th, 2015 at 06:55 AM.

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,036

    Re: [VB6] UPrinter - Unicode Printer Class

    You can define a DEVMODE structure UDT and pass a pointer to that as the lpInitData argument to CreateDC.

    That's a messy structure to map to a UDT because it has unions in it, but this one might work:

    Code:
    Private Type DEVMODE
            dmDeviceName As String * CCHDEVICENAME
            dmSpecVersion As Integer
            dmDriverVersion As Integer
            dmSize As Integer
            dmDriverExtra As Integer
            dmFields As Long
            dmOrientation As Integer
            dmPaperSize As Integer
            dmPaperLength As Integer
            dmPaperWidth As Integer
            dmScale As Integer
            dmCopies As Integer
            dmDefaultSource As Integer
            dmPrintQuality As Integer
            dmColor As Integer
            dmDuplex As Integer
            dmYResolution As Integer
            dmTTOption As Integer
            dmCollate As Integer
            dmFormName As String * CCHFORMNAME
            dmUnusedPadding As Integer
            dmBitsPerPel As Long
            dmPelsWidth As Long
            dmPelsHeight As Long
            dmDisplayFlags As Long
            dmDisplayFrequency As Long
    End Type
    This and the two constants it uses should be available in the API Text Viewer that comes with VB6.

  7. #7
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by dilettante View Post
    You can define a DEVMODE structure UDT and pass a pointer to that as the lpInitData argument to CreateDC.

    That's a messy structure to map to a UDT because it has unions in it, but this one might work:

    Code:
    Private Type DEVMODE
            dmDeviceName As String * CCHDEVICENAME
            dmSpecVersion As Integer
            dmDriverVersion As Integer
            dmSize As Integer
            dmDriverExtra As Integer
            dmFields As Long
            dmOrientation As Integer
            dmPaperSize As Integer
            dmPaperLength As Integer
            dmPaperWidth As Integer
            dmScale As Integer
            dmCopies As Integer
            dmDefaultSource As Integer
            dmPrintQuality As Integer
            dmColor As Integer
            dmDuplex As Integer
            dmYResolution As Integer
            dmTTOption As Integer
            dmCollate As Integer
            dmFormName As String * CCHFORMNAME
            dmUnusedPadding As Integer
            dmBitsPerPel As Long
            dmPelsWidth As Long
            dmPelsHeight As Long
            dmDisplayFlags As Long
            dmDisplayFrequency As Long
    End Type
    This and the two constants it uses should be available in the API Text Viewer that comes with VB6.
    I used your class as a printing controller (OpenPrinter/NewPage/ClosePrinter). Paint is done by outside function.

    Code:
        Dim oPrintController As PrintController
        Set oPrintController = New PrintController
        If Not oPrintController.OpenPrinter(Printer.DeviceName, Printer.DriverName) Then
           Exit Sub
        End If
              
        Dim i As Long
        For i = FromPage To ToPage
            PageNo = i - 1
            PrintPage oPrintController.PrinterDC   '-->My Paint function
            If i < ToPage Then oPrintController.NewPage
        Next
        oPrintController.ClosePrinter
        Set oPrintController = Nothing
    For A4 paper, the printing is OK But the printing is out of boundary for A3 paper. Since the DC created by CreateDC is 0 size. I suspect this is cause,but I am not sure, so i want to try to create the printerDC with A3 size for verification.

    Is it possible to pass the lpDevMode and hDevMode after Printer Dialog (called by PrintDialogEx API) is close if <OK> button or <Apply> Button is pressed? But I am afraid of memory leak (Cross Classes),though we will unlock it after CreateDC used.

    In ShowPrinterDialog function, I will pass lpDevMode and hDevMode to PrintController class:
    Code:
    Public Function ShowPrinterEx(ByRef lpDevMode As Long, ByRef hDevMode As Long) As CdlPDResultConstants
     '...
     hDevMode = PDLGEX.hDevMode
     lpDevMode = GlobalLock(PDLGEX.hDevMode)
     CopyMemory DMODE, ByVal lpDevMode, LenB(DMODE)
     'GlobalUnlock PDLGEX.hDevMode 'Don't Release at this moment 
     'GlobalFree PDLGEX.hDevMode
     '...
    In PrintController OpenPrinter:
    Code:
    Public Function OpenPrinter(ByVal lpDevMode As Long, ByVal hDevMode As Long, _
        ByVal DeviceName As String, _
        ByVal DriverName As String, _
        Optional ByVal DocName As String) As Boolean
        '...
        hDcPrinter = CreateDC(StrPtr(DriverName), StrPtr(DeviceName), 0, lpDevMode)
       '...
    Code:
    'Free it after call PrintController.OpenPrinter
    GlobalUnlock hDevMode
    GlobalFree hDevMode
    Code:
    Public Property Get PrinterDC() As Long
        PrinterDC = hDcPrinter
    End Property

    Edited: Seemed it solves my problem. Now A3 paper printing is right now. Thanks for your excellent UPrinter Class.

    The ShowPrinterEX Function is here.
    Last edited by Jonney; Apr 14th, 2015 at 03:53 AM.

  8. #8
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by dilettante View Post
    I looked around and didn't find many working samples of this... actually none at all but lots of questions about non-working code snippets. There may be some out there, and better than this basic one. I just didn't find any.

    This version does not deal with top/bottom margins, colors, images, drawing, paper tray or siz

    I have attached an archive here containing a small demo Project that uses UPrinter.

    Utf8Reader is is class for reading UTF-8 encoded text files. It in turn makes use of the Utf8Codec class. For this demo a UTF-8 CSV filee selection, orientation, etc. It only prints in whole lines (or multiples if you have embedded newlines), long lines should wrap.
    is read as a source of sample Unicode text to print.

    ParseCSV is here because the sample data is a CSV file and I want to split the data into fields and then print them with Tabs in between.

    Each line of text after the first (heading) line is printed twice in this demo. The only purpose of that was to test page boundary overflow detection.


    This hasn't been fully tested so it may fail with some printer drivers. As already stated it is an incomplete and minimal example but it should serve as a starting point if you want to implement more functionality.


    Name:  sshot.jpg
Views: 2681
Size:  51.2 KB


    Updates:

    New version replaces the earlier attachment here. A few small bug fixes, added properties TopMargin and BottomMargin and method KillDoc.
    hi dilettante ,thank you post your uprinter cls ,is very useful for me

    now i print one png picture to the printreDC.


    Name:  1.JPG
Views: 1594
Size:  35.8 KB


    Name:  2.JPG
Views: 1510
Size:  22.7 KB

    I have a question .in the form ,the picture is big ,but print to pdf,the picture is small.

    can you give me some Suggest ? how can do print text and png to pdf and printer preview WYSIWYG?

    i have find how to do

    Code:
            Dim x As Long, y As Long
           ratio=screendpi/printerDPI
            x = ucImage1.Parent.ScaleX(ucImage1.PictureWidth, vbPixels, vbTwips)
            y = ucImage1.Parent.ScaleY(ucImage1.PictureHeight, vbPixels, vbTwips)
            
            'ucImage1.PaintPicture .PrinterDC, .LeftMargin / ratio, -.TopMargin / ratio - ucImage1.PictureHeight * ratio, ucImage1.PictureWidth * ratio, ucImage1.PictureHeight * ratio, 0, 0, ucImage1.PictureWidth, ucImage1.PictureHeight
            ucImage1.PaintPicture .PrinterDC, .LeftMargin / ratio, -.TopMargin / ratio - y / ratio, x / ratio, y / ratio, 0, 0, ucImage1.PictureWidth, ucImage1.PictureHeight
    Name:  96.JPG
Views: 1436
Size:  56.7 KBName:  2400.JPG
Views: 1434
Size:  58.5 KB
    'sets the unit of measure for this Graphics object from UnitDisplay to UnitPixel
    GdipSetPageUnit hGraphics, UnitPixel
    GdipSetSmoothingMode hGraphics, SmoothingModeAntiAlias
    Last edited by xxdoc123; Mar 5th, 2018 at 11:20 PM. Reason: load pic

  9. #9
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    186

    Re: [VB6] UPrinter - Unicode Printer Class

    ucImage1.PaintPicture .PrinterDC, .LeftMargin / ratio, -.TopMargin / ratio - ucImage1.PictureHeight * ratio, ucImage1.PictureWidth * 2.5, ucImage1.PictureHeight * 2.5, 0, 0, ucImage1.PictureWidth, ucImage1.PictureHeight
    You try this.

  10. #10
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    186

    Re: [VB6] UPrinter - Unicode Printer Class

    ucImage1.PaintPicture .PrinterDC, .LeftMargin / ratio, -.TopMargin / ratio - ucImage1.PictureHeight * ratio, ucImage1.PictureWidth * ratio / 2.5, ucImage1.PictureHeight * ratio / 2.5, 0, 0, ucImage1.PictureWidth, ucImage1.PictureHeight

  11. #11

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,036

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by xxdoc123 View Post
    I have a question .in the form ,the picture is big ,but print to pdf,the picture is small.

    can you give me some Suggest ? how can do print text and png to pdf and printer preview WYSIWYG?
    You might want to start a new thread in the VB6 and Earlier questions and answers forum.

  12. #12
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    I searched the forum, I think you are a printer expert, would like to use your uprinter cls better , so i want to ask you.thank you very much

  13. #13
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    why.you use 2.5?呵呵。

  14. #14
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    186

    Re: [VB6] UPrinter - Unicode Printer Class

    ucImage1.Width / ucImage1.PictureWidth - (Screen.TwipsPerPixelX / Printer.TwipsPerPixelX * 2)
    我的QQ 289778005

  15. #15

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,036

    Re: [VB6] UPrinter - Unicode Printer Class

    New version.
    Attached Files Attached Files

  16. #16
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by dilettante View Post
    New version.
    Your code is very good. Can be added to modify the paper size ,orientation,print quality(DPI) and so on!

    Note:

    when used api changing the Printer dpi, it must be before StartDoc

    my priner and Virtual printer (PDF-XChange 5.0) both can not support AlphaBlend

    but both support GdipDrawImageRectRectI to Render


    it's wired !

    can add this GdipDrawImageRectRectI function to your cls?
    Last edited by xxdoc123; Feb 8th, 2018 at 07:25 PM.

  17. #17
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by dilettante View Post
    New version.
    Code:
    'add by xxdoc'
    Private Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As Long, Height As Long) As Long
    Private Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As Long, Width As Long) As Long
    Private Type GdiplusStartupInput
        GdiplusVersion           As Long
        DebugEventCallback       As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs   As Long
    End Type
    Private Type RECTF
        nLeft                       As Single
        nTop                        As Single
        nWidth                      As Single
        nHeight                     As Single
    End Type
    Private Type COLORMATRIX
        m(0 To 4, 0 To 4)           As Single
    End Type
    
    Private Enum ColorAdjustType
        ColorAdjustTypeDefault = 0
        ColorAdjustTypeBitmap = 1
        ColorAdjustTypeBrush = 2
        ColorAdjustTypePen = 3
        ColorAdjustTypeText = 4
        ColorAdjustTypeCount = 5
        ColorAdjustTypeAny = 6
    End Enum
    Private Enum ColorMatrixFlags
        ColorMatrixFlagsDefault = 0
        ColorMatrixFlagsSkipGrays = 1
        ColorMatrixFlagsAltGray = 2
    End Enum
    Private Const UnitPixel As Long = &H2&
    Private Declare Function GdipGetImageBounds _
                    Lib "gdiplus.dll" (ByVal nImage As Long, _
                                       srcRect As RECTF, _
                                       srcUnit As Long) As Long
    Private Declare Function GdipCreateFromHDC _
                    Lib "Gdiplus" (ByVal hdc As Long, _
                                   hGraphics As Long) As Long
    Private Declare Function GdipCreateImageAttributes _
                    Lib "Gdiplus" (ByRef imageattr As Long) As Long
    Private Declare Function GdipSetImageAttributesColorMatrix _
                    Lib "Gdiplus" (ByVal imageattr As Long, _
                                   ByVal ColorAdjust As ColorAdjustType, _
                                   ByVal EnableFlag As Boolean, _
                                   ByRef MatrixColor As COLORMATRIX, _
                                   ByRef MatrixGray As COLORMATRIX, _
                                   ByVal flags As ColorMatrixFlags) As Long
    
    Private Declare Function GdipDrawImageRectRectI _
                    Lib "Gdiplus" (ByVal hGraphics As Long, _
                                   ByVal hImage As Long, _
                                   ByVal dstx As Long, _
                                   ByVal dsty As Long, _
                                   ByVal dstwidth As Long, _
                                   ByVal dstheight As Long, _
                                   ByVal srcx As Long, _
                                   ByVal srcy As Long, _
                                   ByVal srcwidth As Long, _
                                   ByVal srcheight As Long, _
                                   ByVal srcUnit As Long, _
                                   Optional ByVal imageAttributes As Long = 0, _
                                   Optional ByVal callback As Long = 0, _
                                   Optional ByVal callbackData As Long = 0) As Long
    Private Declare Function GdipDisposeImageAttributes _
                    Lib "Gdiplus" (ByVal imageattr As Long) As Long
    Private Declare Function GdipDeleteGraphics _
                    Lib "Gdiplus" (ByVal hGraphics As Long) As Long
                    
     Private Declare Function GdiplusStartup Lib "gdiplus.dll" (Token As Long, gdipInput As GdiplusStartupInput, GdiplusStartupOutput As Long) As Long
    Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal Token As Long)
    Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hbm As Long, ByVal hpal As Long, ByRef pbitmap As Long) As Long
    'Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus.dll" (ByVal hbm As Long, ByVal hpal As Long, ByRef pbitmap As Long) As Long
    
    Private Declare Function GdipCreateBitmapFromGraphics Lib "Gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal Graphics As Long, bitmap As Long) As Long
    'add by xxdoc


    Code:
    Public Function RenderTo2(ByVal lhDC As Long, _
                              ByVal dstx As Long, _
                              ByVal dsty As Long, _
                              Optional ByVal dstwidth As Long, _
                              Optional ByVal dstheight As Long, _
                              Optional ByVal Alpha As Byte = 100) As Boolean
    
        Dim PrevMM            As Long
    
        Dim hGraphics         As Long
    
        Dim hAttributes       As Long
            
        Dim dBrightness       As Double
    
        Dim dContrast         As Double
    
        Dim dAlpha            As Double
    
        Dim tMatrixColor      As COLORMATRIX
    
        Dim tMatrixGray       As COLORMATRIX
        
        Dim TR                As RECTF
    
        Dim c_lWidth          As Long
    
        Dim c_lHeight         As Long
    
        Dim printer2screenDPI As Single
        
    
        If hBmp = WIN32_NULL Then Exit Function
        printer2screenDPI = (GetDeviceCaps(lhDC, LOGPIXELSX) / GetDeviceCaps(GetDC(0), LOGPIXELSX))
        
        ' Call GdipGetImageBounds(hBmp, TR, UnitPixel)
        '    c_lWidth = TR.nWidth
        '    c_lHeight = TR.nHeight
     
        '    If dstWidth = 0 Then dstWidth = c_lWidth
        '    If dstHeight = 0 Then dstHeight = c_lHeight
        '    If srcWidth = 0 Then srcWidth = c_lWidth
        '    If srcHeight = 0 Then srcHeight = c_lHeight
        
        If dstwidth = 0 Then dstwidth = Me.Width
        If dstheight = 0 Then dstheight = Me.Height
        
        dAlpha = ValidateValue(Alpha)
    
    
        Dim bitmap As Long, bmW As Long, bmH As Long
    
    '    
        GdipCreateBitmapFromHBITMAP hBmp, 0, bitmap
    
        GdipGetImageWidth bitmap, bmW
        GdipGetImageHeight bitmap, bmH
        PrevMM = SetMapMode(lhDC, MM_TEXT)
    
        If GdipCreateFromHDC(lhDC, hGraphics) = 0 Then
            'sets the unit of measure for this Graphics object from UnitDisplay to UnitPixel
    GdipSetPageUnit hGraphics, UnitPixel
    GdipSetSmoothingMode hGraphics, SmoothingModeAntiAlias
            With tMatrixColor
                .m(0, 0) = 1
                .m(1, 1) = 1
                .m(2, 2) = 1
                .m(4, 4) = 1
         
                If Not dAlpha = 100 Then
                    .m(3, 3) = dAlpha
    
                End If
              
            End With
           
            If GdipCreateImageAttributes(hAttributes) = 0 Then
                    
                If GdipSetImageAttributesColorMatrix(hAttributes, ColorAdjustTypeDefault, True, tMatrixColor, tMatrixGray, ColorMatrixFlagsDefault) = 0 Then
                    
                    If GdipDrawImageRectRectI(hGraphics, bitmap, dstx / printer2screenDPI, dsty / printer2screenDPI, dstwidth / printer2screenDPI + 6, dstheight / printer2screenDPI + 6, 0, 0, bmW, bmH, UnitPixel, hAttributes) = 0 Then
                        RenderTo2 = True
    
                    End If
                    
                End If
                    
                Call GdipDisposeImageAttributes(hAttributes)
    
            End If
            
            Call GdipDeleteGraphics(hGraphics)
    
        End If
    
        SetMapMode lhDC, PrevMM
    
    End Function



    Not perfect,but can used in my printer and pdf printer well.
    Attached Files Attached Files
    Last edited by xxdoc123; Mar 5th, 2018 at 11:24 PM.

  18. #18
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by xxdoc123 View Post
    Code:
    'add by xxdoc'
    Private Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As Long, Height As Long) As Long
    Private Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As Long, Width As Long) As Long
    Private Type GdiplusStartupInput
        GdiplusVersion           As Long
        DebugEventCallback       As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs   As Long
    End Type
    Private Type RECTF
        nLeft                       As Single
        nTop                        As Single
        nWidth                      As Single
        nHeight                     As Single
    End Type
    Private Type COLORMATRIX
        m(0 To 4, 0 To 4)           As Single
    End Type
    
    Private Enum ColorAdjustType
        ColorAdjustTypeDefault = 0
        ColorAdjustTypeBitmap = 1
        ColorAdjustTypeBrush = 2
        ColorAdjustTypePen = 3
        ColorAdjustTypeText = 4
        ColorAdjustTypeCount = 5
        ColorAdjustTypeAny = 6
    End Enum
    Private Enum ColorMatrixFlags
        ColorMatrixFlagsDefault = 0
        ColorMatrixFlagsSkipGrays = 1
        ColorMatrixFlagsAltGray = 2
    End Enum
    Private Const UnitPixel As Long = &H2&
    Private Declare Function GdipGetImageBounds _
                    Lib "gdiplus.dll" (ByVal nImage As Long, _
                                       srcRect As RECTF, _
                                       srcUnit As Long) As Long
    Private Declare Function GdipCreateFromHDC _
                    Lib "Gdiplus" (ByVal hdc As Long, _
                                   hGraphics As Long) As Long
    Private Declare Function GdipCreateImageAttributes _
                    Lib "Gdiplus" (ByRef imageattr As Long) As Long
    Private Declare Function GdipSetImageAttributesColorMatrix _
                    Lib "Gdiplus" (ByVal imageattr As Long, _
                                   ByVal ColorAdjust As ColorAdjustType, _
                                   ByVal EnableFlag As Boolean, _
                                   ByRef MatrixColor As COLORMATRIX, _
                                   ByRef MatrixGray As COLORMATRIX, _
                                   ByVal flags As ColorMatrixFlags) As Long
    
    Private Declare Function GdipDrawImageRectRectI _
                    Lib "Gdiplus" (ByVal hGraphics As Long, _
                                   ByVal hImage As Long, _
                                   ByVal dstx As Long, _
                                   ByVal dsty As Long, _
                                   ByVal dstwidth As Long, _
                                   ByVal dstheight As Long, _
                                   ByVal srcx As Long, _
                                   ByVal srcy As Long, _
                                   ByVal srcwidth As Long, _
                                   ByVal srcheight As Long, _
                                   ByVal srcUnit As Long, _
                                   Optional ByVal imageAttributes As Long = 0, _
                                   Optional ByVal callback As Long = 0, _
                                   Optional ByVal callbackData As Long = 0) As Long
    Private Declare Function GdipDisposeImageAttributes _
                    Lib "Gdiplus" (ByVal imageattr As Long) As Long
    Private Declare Function GdipDeleteGraphics _
                    Lib "Gdiplus" (ByVal hGraphics As Long) As Long
                    
     Private Declare Function GdiplusStartup Lib "gdiplus.dll" (Token As Long, gdipInput As GdiplusStartupInput, GdiplusStartupOutput As Long) As Long
    Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal Token As Long)
    Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hbm As Long, ByVal hpal As Long, ByRef pbitmap As Long) As Long
    'Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus.dll" (ByVal hbm As Long, ByVal hpal As Long, ByRef pbitmap As Long) As Long
    
    Private Declare Function GdipCreateBitmapFromGraphics Lib "Gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal Graphics As Long, bitmap As Long) As Long
    'add by xxdoc


    Code:
    Public Function RenderTo2(ByVal lhDC As Long, _
                              ByVal dstx As Long, _
                              ByVal dsty As Long, _
                              Optional ByVal dstwidth As Long, _
                              Optional ByVal dstheight As Long, _
                              Optional ByVal Alpha As Byte = 100) As Boolean
    
        Dim PrevMM            As Long
    
        Dim hGraphics         As Long
    
        Dim hAttributes       As Long
            
        Dim dBrightness       As Double
    
        Dim dContrast         As Double
    
        Dim dAlpha            As Double
    
        Dim tMatrixColor      As COLORMATRIX
    
        Dim tMatrixGray       As COLORMATRIX
        
        Dim TR                As RECTF
    
        Dim c_lWidth          As Long
    
        Dim c_lHeight         As Long
    
        Dim printer2screenDPI As Single
        
    
        If hBmp = WIN32_NULL Then Exit Function
        printer2screenDPI = (GetDeviceCaps(lhDC, LOGPIXELSX) / GetDeviceCaps(GetDC(0), LOGPIXELSX))
        
        ' Call GdipGetImageBounds(hBmp, TR, UnitPixel)
        '    c_lWidth = TR.nWidth
        '    c_lHeight = TR.nHeight
     
        '    If dstWidth = 0 Then dstWidth = c_lWidth
        '    If dstHeight = 0 Then dstHeight = c_lHeight
        '    If srcWidth = 0 Then srcWidth = c_lWidth
        '    If srcHeight = 0 Then srcHeight = c_lHeight
        
        If dstwidth = 0 Then dstwidth = Me.Width
        If dstheight = 0 Then dstheight = Me.Height
        
        dAlpha = ValidateValue(Alpha)
    
    
        Dim bitmap As Long, bmW As Long, bmH As Long
    
    '    
        GdipCreateBitmapFromHBITMAP hBmp, 0, bitmap
    
        GdipGetImageWidth bitmap, bmW
        GdipGetImageHeight bitmap, bmH
        PrevMM = SetMapMode(lhDC, MM_TEXT)
    
        If GdipCreateFromHDC(lhDC, hGraphics) = 0 Then
            'sets the unit of measure for this Graphics object from UnitDisplay to UnitPixel
    GdipSetPageUnit hGraphics, UnitPixel
    GdipSetSmoothingMode hGraphics, SmoothingModeAntiAlias
            With tMatrixColor
                .m(0, 0) = 1
                .m(1, 1) = 1
                .m(2, 2) = 1
                .m(4, 4) = 1
         
                If Not dAlpha = 100 Then
                    .m(3, 3) = dAlpha
    
                End If
              
            End With
           
            If GdipCreateImageAttributes(hAttributes) = 0 Then
                    
                If GdipSetImageAttributesColorMatrix(hAttributes, ColorAdjustTypeDefault, True, tMatrixColor, tMatrixGray, ColorMatrixFlagsDefault) = 0 Then
                    
                    If GdipDrawImageRectRectI(hGraphics, bitmap, dstx / printer2screenDPI, dsty / printer2screenDPI, dstwidth / printer2screenDPI + 6, dstheight / printer2screenDPI + 6, 0, 0, bmW, bmH, UnitPixel, hAttributes) = 0 Then
                        RenderTo2 = True
    
                    End If
                    
                End If
                    
                Call GdipDisposeImageAttributes(hAttributes)
    
            End If
            
            Call GdipDeleteGraphics(hGraphics)
    
        End If
    
        SetMapMode lhDC, PrevMM
    
    End Function



    Not perfect,but can used in my printer and pdf printer well.
    Private Declare Function GdipSetPageUnit Lib "gdiplus" _
    (ByVal Graphics As Long, ByVal Unit As Long) As Long

    GdipSetPageUnit hGraphics, UnitPixel

    http://www.vbforums.com/showthread.p...Print-Preview)

    UPrinter3.6.zip

  19. #19
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    410

    Re: [VB6] UPrinter - Unicode Printer Class

    Quote Originally Posted by dilettante View Post
    I looked around and didn't find many working samples of this... actually none at all but lots of questions about non-working code snippets. There may be some out there, and better than this basic one. I just didn't find any.

    This version does not deal with top/bottom margins, colors, images, drawing, paper tray or size selection, orientation, etc. It only prints in whole lines (or multiples if you have embedded newlines), long lines should wrap.


    I have attached an archive here containing a small demo Project that uses UPrinter.

    Utf8Reader is is class for reading UTF-8 encoded text files. It in turn makes use of the Utf8Codec class. For this demo a UTF-8 CSV file is read as a source of sample Unicode text to print.

    ParseCSV is here because the sample data is a CSV file and I want to split the data into fields and then print them with Tabs in between.

    Each line of text after the first (heading) line is printed twice in this demo. The only purpose of that was to test page boundary overflow detection.


    This hasn't been fully tested so it may fail with some printer drivers. As already stated it is an incomplete and minimal example but it should serve as a starting point if you want to implement more functionality.


    Name:  sshot.jpg
Views: 2681
Size:  51.2 KB


    Updates:

    New version replaces the earlier attachment here. A few small bug fixes, added properties TopMargin and BottomMargin and method KillDoc.
    I have a question. If I know that the blank height below the paper is less than the height of the string I actually printed. It involves the problem of partial string page printing. So used drawtext API how do can get the maximum number of strings that can be accommodated in this blank rectangle? used your cls 。if long string used drawtext return the height > page blank height 。may change new page 。so Paper wasted

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width