Rubrik: Drucker | VB-Versionen: VB4, VB5, VB6 | 31.08.05 |
PrintForm-Ersatz für Korrektes Ausdrucken einer Form Dieser Tipp umgeht die Bugs der VB-eigenen PrintForm-Anweisung. | ||
Autor: Zardoz | Bewertung: | Views: 23.922 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Der PrintForm-Befehl von VB hat einige Fehler. Er schneidet das Bild bei 640*480 Pixeln einfach ab. Außerdem werden einige Controls bei bestimmten Borderstyle-Einstellungen der Form nicht gedruckt. Daher habe schon vor Längerem nachfolgende Prozedur als Ersatz für die VB-eigene PrintForm-Anweisung geschrieben.
Zunächst wird ein Screenshot der Form erstellt. Das Bild wird dann aus der Zwischenablage geholt und über das Printer-Objekt ausgedruckt.
Option Explicit ' Benötigte API-Deklarationen Private Declare Sub keybd_event Lib "user32" ( _ ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long)
Private Sub DruckeForm() Dim Bild As Picture Dim Faktor1 As Single Dim Faktor2 As Single Dim Breite As Long Dim Höhe As Long Dim Korrektur As Long Me.MousePointer = 11 ' Zwischenablage löschen Clipboard.Clear ' Screenshot der aktuellen Form erstellen Call keybd_event(44, 0, 0, 0) DoEvents Call keybd_event(44, 0, 2, 0) ' Bild aus der Zwischenablage holen Set Bild = Clipboard.GetData(vbCFBitmap) Clipboard.Clear ' Ausdruck starten With Printer ' Papierformat .Orientation = vbPRORLandscape ' Farb-Einstellung .ColorMode = vbPRCMColor ' Maßeinheit auf Pixel festlegen .ScaleMode = vbPixels ' Breite und Höhe des Bildes in Pixel Breite = .ScaleX(Bild.Width, vbHimetric, vbPixels) Höhe = .ScaleY(Bild.Height, vbHimetric, vbPixels) ' Die Breite und die Höhe des bedruckbaren Bereiches wird zu ' groß angegeben (vermutlich Drucker und Druckertreiber abhängig) ' Deshalb der Wert Korrektur, damit das Bild vollständig gedruckt wird. Korrektur = 30 Faktor1 = (.ScaleWidth - Korrektur) / Breite Faktor2 = (.ScaleHeight - Korrektur) / Höhe If Faktor2 < Faktor1 Then Faktor1 = Faktor2 End If ' Bild an den Drucker schicken .PaintPicture Bild, 0, 0, Breite * Faktor1, Höhe * Faktor1 ' Ausdruck beenden .EndDoc End With Set Bild = Nothing Me.MousePointer = 0 End Sub