Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB6: Visual Basic 6 ja tulostaminen

juhaz [29.02.2008 13:27:56]

#

Yritin tulostaa tekstiä ja kuvan tulostimella ja se toimiikin, mutta ongelmaksi tuli se, että en keksi keinoa siirtää tekstiä haluamaani kohtaan sivua. En haluaisi, että teksti alkaisi heti sivun reunasta vaan, että siinä olisi pieni marginaali ennen kuin teksti alkaa. Miten mahdan pystyä tekemään sen marginaalin? Tietenkin voisin tulostaa ensimmäisenä merkkinä tulostimelle tyhjää eli laittaisin esimerkiksi printer.print " tämä ei ala heti reunasta", mutta sitten tulee ongelmaksi monirivinen tekstilaatikko (text4.text), jossa ensimmäisen rivin saan tulemaan, kuten pitää, mutta jo heti seuraava alkaakin heti paperin reunasta.

Printer.PaintPicture Image1.Picture, 10504, 200
Printer.FontSize = "24"
Printer.FontBold = True
Printer.Print "yrityksen_nimi"
Printer.Print ""
Printer.Print ""
Printer.FontSize = "18"
printer.fontbold = False
Printer.Print "Nimi: " & Text1.Text
Printer.Print "Osoite: " & Text2.Text
Printer.Print "Puh nro: " & Text3.Text
Printer.Print ""
Printer.Print ""
Printer.Print Text4.Text
Printer.EndDoc

EDIT:
Heh... se olikin sitten niin yksinkertainen juttu, että selvitin itse heti viestin kirjoituksen jälkeen vaikka aiemmin yritin samaa käyttää enkä saanut sillä sitä aikaiseksi. Eli vastaus oli mitä ilmeisemmin printer.currentX ja printer.currentY komennot.

Tosin ongelmana on vielä kuitenkin monirivinen tekstilaatikko, jossa ensimmäinen rivi tottelee käskyjä, mutta jo heti toinen ei tottele. Mitenköhän se pitäisi tehdä, että saisi kaikki rivit siinä sitten toimimaan, kuten täytyy?

Antti Laaksonen [29.02.2008 14:44:28]

#

Yksi ratkaisu on tulostaa rivit yksi kerrallaan oikeisiin paikkoihin:

Dim rivit() As String
rivit = Split(Text1, vbCrLf)
Dim i As Integer
For i = 0 To UBound(rivit)
    Printer.CurrentX = 1000
    Printer.CurrentY = 500 + Printer.TextHeight("") * i
    Printer.Print rivit(i)
Next
Printer.EndDoc

JoreSoft [01.03.2008 21:50:34]

#

Kerran käytin API-kutsuja normaalin VB6 käskyjen sijaan, ja tulostus nopeutui todella paljon... esimerkiksi grafiikan tulostaminen Printer.PSet-käskyllä on hidasta.

tässä hieman esimerkkiä.

   Private Const LF_FACESIZE = 32

   Private Type LOGFONT
      lfHeight As Long
      lfWidth As Long
      lfEscapement As Long
      lfOrientation As Long
      lfWeight As Long
      lfItalic As Byte
      lfUnderline As Byte
      lfStrikeOut As Byte
      lfCharSet As Byte
      lfOutPrecision As Byte
      lfClipPrecision As Byte
      lfQuality As Byte
      lfPitchAndFamily As Byte
      lfFaceName As String * LF_FACESIZE
   End Type

   Private Type DOCINFO
      cbSize As Long
      lpszDocName As String
      lpszOutput As String
      lpszDatatype As String
      fwType As Long
   End Type

   Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
   "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

   Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
   (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
   ByVal lpOutput As Long, ByVal lpInitData As Long) As Long

   Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) _
   As Long

   Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" _
   (ByVal hdc As Long, lpdi As DOCINFO) As Long

   Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) _
   As Long

   Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) _
   As Long

   Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) _
   As Long

Sub PrintBitmap_Pset()
Dim I%, L%, T As String, C&, Cc&
Dim X%, Y%

With Printer
    .ScaleMode = 3
    .DrawStyle = 2 'Dot
'For I = 14 To 0 Step -1
    X = 0
    Y = 0

    Do
        Do
            C = GetC(X, Y)
            If C = 0 Then
                If X < .Width Then
                    If Y < .Height Then
                    '.DrawMode =
                        Printer.PSet (X, Y), 0
                    End If
                End If
            End If
            X = X + .DrawWidth
        Loop Until X > Kuva.X - 1
        X = 0
        Y = Y + 1
        DoEvents
    Loop Until Y > Kuva.Y - 1
'Next I
    .ScaleMode = 1
    .EndDoc
End With
End Sub

Sub PrintBitmap() 'API
   ' Print using API calls only
      Dim OutString As String  'String to be rotated
      Dim lf As LOGFONT        'Structure for setting up rotated font
      Dim Temp As String       'Temp string var
      Dim result As Long       'Return value for calling API functions
      Dim hOldfont As Long     'Hold old font information
      Dim hPrintDc As Long     'Handle to printer dc
      Dim hFont As Long        'Handle to new Font
      Dim di As DOCINFO        'Structure for Print Document info

      di.cbSize = 20                  ' Size of DOCINFO structure
      di.lpszDocName = fTX.Caption    ' Set name of print job (Optional)
    'Create the font
      hFont = CreateFontIndirect(lf)
   ' Create a printer device context
      hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)

      result = StartDoc(hPrintDc, di) 'Start a new print document
      result = StartPage(hPrintDc)    'Start a new page
      BitBlt hPrintDc, 0, 0, Kuva.X, Kuva.Y, PL.P1.hdc, 0, 0, vbSrcCopy
            result = EndPage(hPrintDc)      'End the page
      result = EndDoc(hPrintDc)       'End the print job
      result = DeleteDC(hPrintDc)     'Delete the printer device context
      result = DeleteObject(hFont)    'Delete the font object
End Sub

Sub PrintText()
Dim X%, Y%, X1&, Y1&, L&, I%, J%, koMax&, Ch$, T$, W&, H&
    Bit.CountLoadedTextSize
    komax = Len(fTX.RTB)
    L = 1

    pBu.L3.Font.Size = fTX.RTB.Font.Size
    pBu.L3.Font.Name = fTX.RTB.Font.Name
    pBu.L3.Caption = " "
    Printer.Font.Name = fTX.RTB.Font.Name
    Printer.Font.Size = fTX.RTB.Font.Size
With fTX.RTB
    Do
        Ch = Mid$(.Text, L, 1)
        If Ch <> Chr$(13) Then
            W = Printer.TextWidth(Ch)
            H = Printer.TextHeight(Ch)
            Printer.CurrentX = X
            Printer.CurrentY = Y
            Printer.Print Ch
            X = X + W
        Else
            X = 0
            H = Printer.TextHeight(" ")
            Y = Y + H
        End If
        L = L + 1
    Loop Until L > koMax
End With

    Printer.EndDoc

End Sub


Public Sub PrintText_API()
Dim X%, Y%, L&, koMax&, W&, H&
    Bit.CountLoadedTextSize
    koMax = Len(fTX.RTB)' RichText
    L = 1

    Printer.Font.Name = fTX.RTB.Font.Name
    Printer.Font.Size = fTX.RTB.Font.Size

   ' Print using API calls only
      Dim Ch As String  'String to be rotated
      Dim lf As LOGFONT        'Structure for setting up rotated font
      Dim Temp As String       'Temp string var
      Dim result As Long       'Return value for calling API functions
      'Dim hOldfont As Long     'Hold old font information
      Dim hPrintDc As Long     'Handle to printer dc
      Dim hFont As Long        'Handle to new Font
      Dim di As DOCINFO        'Structure for Print Document info

      di.cbSize = 20                  ' Size of DOCINFO structure
      di.lpszDocName = fTX.Caption    ' Set name of print job (Optional)
    'Create the font
      hFont = CreateFontIndirect(lf)
   ' Create a printer device context
      hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)

      result = StartDoc(hPrintDc, di) 'Start a new print document
      result = StartPage(hPrintDc)    'Start a new page

With fTX.RTB 'fTX.RTB = RichText kontrolli
    Do
        Ch = Mid$(.Text, L, 1) 'Set char
        If Ch <> Chr$(13) Then
            W = Printer.TextWidth(Ch)
            H = Printer.TextHeight(Ch)
            ' Send charto printer, starting at location x, y
            result = TextOut(hPrintDc, X, Y, Ch, Len(Ch))
            X = X + W
        Else
            X = 0
            Ch = " "
            result = TextOut(hPrintDc, X, Y, Ch, Len(Ch))
            Y = Y + H
        End If
        L = L + 1
    Loop Until L > koMax
End With

      result = EndPage(hPrintDc)      'End the page
      result = EndDoc(hPrintDc)       'End the print job
      result = DeleteDC(hPrintDc)     'Delete the printer device context
      result = DeleteObject(hFont)    'Delete the font object
End Sub

EDIT:
Printterin valinta Commondialog-kontrollilla

'Print Bitmap
        Opt.EnaDis 2
        Opt.Käynnistä "Printing Text", False
        CD_Printer.CancelError = True
        CD_Printer.PrinterDefault = True
        CD_Printer.Flags = cdlPDReturnDC + cdlPDNoPageNums
        If fTX.RTB.SelLength = 0 Then
            CD_Printer.Flags = CD_Printer.Flags + cdlPDAllPages
        Else
            CD_Printer.Flags = CD_Printer.Flags + cdlPDSelection
        End If
        CD_Printer.ShowPrinter

        PrintText

'Print Bitmap
        Opt.EnaDis 2
        Opt.Käynnistä "Printing Bitmap", False
        CD_Printer.CancelError = True
        CD_Printer.PrinterDefault = True
        CD_Printer.Flags = cdlPDReturnDC + cdlPDNoPageNums + cdlPDAllPages
        CD_Printer.ShowPrinter
        PrintBitmap

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta